maralorn/nixos-config
1
0
Fork 0
Code Wiki Activity

Configure fourmolu

Browse source
This commit is contained in:
Malte Brandy 2021-01-27 15:09:28 +01:00
parent e1430c36d6
commit 9a4ae01f3b
4 changed files with 132 additions and 130 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
fourmolu.yaml Normal file
View file

@ -0,0 +1 @@
indentation: 2

25
home-manager/roles/neovim/default.nix
View file

@ -6,16 +6,15 @@ let
packages.myVimPackage = {
start = builtins.attrValues {
inherit (pkgs.vimPlugins)
# coc-tabnine (TODO: Why doesn‘t it work?)
# TODO: tabnine config in home-manager
# TODO: tabnine lsp: nix, rust, pandoc/latex lsp? was noch?
# coc-tabnine (TODO: Why doesn‘t it work?)
# TODO: tabnine config in home-manager
# TODO: tabnine lsp: nix, rust, pandoc/latex lsp? was noch?
# ===
# Basic IDE plugins
# ===
# Basic IDE plugins
coc-nvim airline
# same word highlighting when not supported by language
coc-highlight
coc-explorer
coc-highlight coc-explorer
# searches
coc-fzf fzf-vim
@ -37,8 +36,7 @@ let
# haskell syntax highlighting
haskell-vim vim-hoogle
# nix syntax highlighting
vim-nix
vim-markdown
vim-nix vim-markdown
# latex
vimtex coc-vimtex # not sure if I need two
# ledger
@ -56,7 +54,8 @@ let
# html
coc-html
# dhall
dhall-vim;
dhall-vim
;
};
};
};
@ -77,16 +76,18 @@ let
};
haskell = {
command = "haskell-language-server";
args = [ "--lsp" ];
args = [ "--lsp" "-d" "-l" "/tmp/LanguageServer.log" ];
rootPatterns = [ ".hie-bios" "cabal.project" ];
filetypes = [ "hs" "lhs" "haskell" ];
settings.languageServerHaskell.formattingProvider = "fourmolu";
};
};
explorer.icon.enableNerdfont = true;
explorer.file.child.template =
"[git | 2] [selection | clip | 1] [indent][icon | 1] [diagnosticError & 1][diagnosticWarning & 1][filename omitCenter 1][modified][readonly] [linkIcon & 1][link growRight 1 omitCenter 5][size]";
};
in {
in
{
home = {
file.".config/nvim/coc-settings.json".text = builtins.toJSON cocSettings;
packages = [ neovim pkgs.neuron-language-server ];

4
home-manager/roles/neovim/vimrc
View file

@ -69,8 +69,6 @@ let g:haskell_enable_typeroles = 1 " to enable highlighting of type roles
let g:haskell_enable_static_pointers = 1 " to enable highlighting of `static`
let g:haskell_backpack = 1 " to enable highlighting of backpack keywords
let g:formatdef_my_haskell = '"fourmolu"'
let g:formatters_haskell = ['my_haskell']
let g:formatdef_my_cabal = '"cabal-fmt"'
let g:formatters_cabal = ['my_cabal']
let g:formatdef_my_nix = '"nixfmt"'
@ -163,7 +161,7 @@ augroup end
" Remap for do codeAction of selected region, ex: `<leader>aap` for current paragraph
xmap <leader>a <Plug>(coc-codeaction-selected)
nmap <leader>a <Plug>(coc-codeaction-selected)
nmap <space>f :Autoformat<CR>
nmap <silent> <space>f :Format<CR>
nmap <space>l <Plug>(coc-codelens-action)
" Create mappings for function text object, requires document symbols feature of languageserver.

232
nixos/roles/matrix-synapse/synapse-cleanup.hs
View file

@ -1,133 +1,135 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall -Wno-missing-signatures -Wno-type-defaults -Wno-orphans #-}
import Control.Concurrent
import Data.Aeson
import Data.String.Interpolate
import Data.Time
import Data.Time.Clock.POSIX
import Database.PostgreSQL.Simple
import Network.HTTP
import Prelude ( )
import Relude
import Say
import System.IO
import Shh
import Control.Concurrent (threadDelay)
import Data.Aeson (FromJSON, decode)
import Data.String.Interpolate (i)
import Data.Time (UTCTime, addUTCTime, getCurrentTime, nominalDay)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
import Database.PostgreSQL.Simple as PSQL (
Connection,
Only (Only, fromOnly),
connectPostgreSQL,
query,
query_,
)
import Network.HTTP (
Header (Header),
HeaderName (HdrAuthorization),
Request_String,
Response (rspBody),
getRequest,
insertHeaders,
postRequest,
postRequestWithBody,
simpleHTTP,
)
import Relude
import Say (say, sayErr)
import Shh (ExecReference (Absolute), load, (|>))
import System.IO (BufferMode (LineBuffering), hSetBuffering)
load Absolute ["synapse-compress-state", "cat", "psql", "rm", "grep"]
-- Executables used.
load Absolute ["synapse-compress-state", "cat", "psql", "rm"]
newtype PurgeResult = PurgeResult
{ purge_id :: Text
}
deriving (Generic, FromJSON)
newtype Status = Status
{ status :: Text
}
deriving (Generic, FromJSON)
newtype PurgeResult = PurgeResult {purge_id :: Text} deriving (Generic, FromJSON)
newtype Status = Status {status :: Text} deriving (Generic, FromJSON)
apiUrl :: Text
apiUrl = [i|http://localhost:8008/_synapse/admin/v1|]
apiUrl = [i|http://localhost:8008/_synapse/admin/v1|] :: Text
daysOld = 30
lastMessages = 500
minUsersToPurgeRoom = 5
filename = "/var/lib/matrix-synapse/tmp-storage-compression.sql"
contentType = "application/json"
giveToken :: Text -> Request_String -> Request_String
giveToken token = insertHeaders [Header HdrAuthorization [i|Bearer #{token}|]]
getToken :: PSQL.Connection -> IO Text
getToken conn = extractFromList <$> query_ conn queryString
where
extractFromList = fromMaybe (error "No admin token in database") . viaNonEmpty head . fmap fromOnly
queryString = "SELECT token FROM access_tokens JOIN users ON user_id=name WHERE admin=1 ORDER BY id DESC LIMIT 1"
waitForPurge :: Text -> Text -> IO ()
waitForPurge token purgeId = do
result <- go 1
say [i|Purge result: #{result}|]
where
handeResponse timeout =
either
(\e -> pure [i|purge failed with error: #{e}|])
( \resp -> do
let res = maybe [i|couldn‘t parse purge response #{rspBody resp}|] status (decode . encodeUtf8 . rspBody $ resp)
if res == "active" then go (min (timeout * 2) 60) else pure res
)
go timeout = do
say [i|purge #{purgeId} is going on waiting #{timeout} seconds|]
threadDelay (timeout * 1000000)
handeResponse timeout =<< (simpleHTTP . giveToken token . getRequest) [i|#{apiUrl}/purge_history_status/#{purgeId}|]
queryLastKeptEvent :: PSQL.Connection -> Text -> IO (Maybe (Text, UTCTime))
queryLastKeptEvent conn roomId =
let process = fmap (second (posixSecondsToUTCTime . (/ 1000) . realToFrac)) . viaNonEmpty head . mapMaybe sequence
queryString = "SELECT event_id, received_ts from events WHERE type='m.room.message' AND room_id =? ORDER BY received_ts DESC LIMIT 1 offset ?"
in process <$> query conn queryString (roomId, lastMessages - 1)
purgeUpToEvent :: Text -> Text -> UTCTime -> (Text, UTCTime) -> IO ()
purgeUpToEvent token roomId upToTime (eventName, eventTime) =
handleResponse =<< simpleHTTP . giveToken token . postRequestWithBody url contentType =<< getBody
where
upToTimeStamp = floor . (* 1000) . utcTimeToPOSIXSeconds $ upToTime
timeOutBody = [i|{"delete_local_events":"true", "purge_up_to_ts":#{upToTimeStamp}}|]
url = [i|#{apiUrl}/purge_history/#{roomId}|]
getBody =
if eventTime < upToTime
then do
say [i|Deleting up to #{eventName} in #{roomId}.|]
pure [i|{"delete_local_events":"true", "purge_up_to_event_id":"#{eventName}"}|]
else do
say [i|Deleting up to last #{daysOld} days in #{roomId}.|]
pure timeOutBody
handleResponse =
either
(\e -> sayErr [i|Could not get purge status in #{roomId}. Error: #{e}|])
( \resp ->
maybe
(sayErr [i|Could not parse purge result: #{rspBody resp}|])
(\(purge_id -> purgeResult) -> say [i|Purging with id #{purgeResult} for room #{roomId}.|] >> waitForPurge token purgeResult)
(decode . encodeUtf8 . rspBody $ resp)
)
processRoom :: Text -> PSQL.Connection -> UTCTime -> Text -> IO ()
processRoom token conn upToTime roomId = do
whenJustM (queryLastKeptEvent conn roomId) (purgeUpToEvent token roomId upToTime)
say [i|Compressing state in room #{roomId} ...|]
synapse_compress_state "-o" filename "-p" "host=/run/postgresql user=matrix-synapse dbname=matrix-synapse" "-r" (toString roomId)
cat filename |> psql "matrix-synapse"
rm filename
main :: IO ()
main = do
_ <- missingExecutables
hSetBuffering stdout LineBuffering
upToTime <-
addUTCTime ((-1) * realToFrac daysOld * nominalDay) <$> getCurrentTime
conn <- connectPostgreSQL "dbname='matrix-synapse'"
(token :: Text) <-
fromMaybe (error "No admin token in database")
. viaNonEmpty head
<$> (fromOnly <<$>> query_
conn
"SELECT token FROM access_tokens JOIN users ON user_id=name WHERE admin=1 ORDER BY id DESC LIMIT 1"
)
let
upToTimeStamp = floor . (* 1000) . utcTimeToPOSIXSeconds $ upToTime
timeOutBody =
[i|{"delete_local_events":"true", "purge_up_to_ts":#{upToTimeStamp}}|]
contentType = "application/json"
setAuth = insertHeaders [Header HdrAuthorization [i|Bearer #{token}|]]
wait :: Text -> IO Text
wait purgeId = go 1
where
go timeout = do
say [i|purge #{purgeId} is going on waiting #{timeout} seconds|]
threadDelay (timeout * 1000000)
response <-
simpleHTTP
. setAuth
. getRequest
$ [i|#{apiUrl}/purge_history_status/#{purgeId}|]
case response of
Left e -> pure [i|purge failed with error: #{e}|]
Right resp -> do
let res =
maybe [i|couldn‘t parse purge response #{rspBody resp}|] status (decode . encodeUtf8 . rspBody $ resp)
if res == "active" then go (min (timeout * 2) 60) else pure res
upToTime <- addUTCTime ((-1) * realToFrac daysOld * nominalDay) <$> getCurrentTime
conn <- connectPostgreSQL "dbname='matrix-synapse'"
token <- getToken conn
let upToTimeStamp = floor . (* 1000) . utcTimeToPOSIXSeconds $ upToTime
queryString = "SELECT q.room_id FROM (select count(*) as numberofusers, room_id FROM current_state_events WHERE type ='m.room.member' GROUP BY room_id) AS q LEFT JOIN room_aliases a ON q.room_id=a.room_id WHERE q.numberofusers > ? ORDER BY numberofusers desc"
roomIds <- fromOnly @Text <<$>> query conn queryString (Only minUsersToPurgeRoom)
mapM_ (processRoom token conn upToTime) roomIds
say "Pruning remote media ..."
_ <- simpleHTTP
. setAuth
. postRequest
$ [i|#{apiUrl}/purge_media_cache/?before_ts=#{upToTimeStamp}|]
roomIds <- fromOnly @Text <<$>> query
conn
"SELECT q.room_id FROM (select count(*) as numberofusers, room_id FROM current_state_events WHERE type ='m.room.member' GROUP BY room_id) AS q LEFT JOIN room_aliases a ON q.room_id=a.room_id WHERE q.numberofusers > ? ORDER BY numberofusers desc"
(Only minUsersToPurgeRoom)
forM_ roomIds $ \roomId -> do
synapse_compress_state "-o" filename "-p" "host=/run/postgresql user=matrix-synapse dbname=matrix-synapse" "-r" (toString roomId) |> grep "-v" "DELETE\\|INSERT"
cat filename |> psql "matrix-synapse"
rm filename
eventId <-
fmap (second (posixSecondsToUTCTime . (/ 1000) . realToFrac))
. viaNonEmpty head
. mapMaybe sequence
<$> query
conn
"SELECT event_id, received_ts from events WHERE type='m.room.message' AND room_id =? ORDER BY received_ts DESC LIMIT 1 offset ?"
(roomId, lastMessages - 1)
let url = [i|#{apiUrl}/purge_history/#{roomId}|]
whenJust eventId $ \(name :: Text, timestamp) -> do
response <-
simpleHTTP
. setAuth
. postRequestWithBody url contentType
=<< if timestamp < upToTime
then
(do
say [i|Deleting up to #{name} in #{roomId}.|]
pure
[i|{"delete_local_events":"true", "purge_up_to_event_id":"#{name}"}|]
)
else do
say [i|Deleting up to last #{daysOld} days in #{roomId}.|]
pure timeOutBody
case response of
Left e ->
sayErr [i|Could not get purge status in #{roomId}. Error: #{e}|]
Right resp -> do
maybe
(sayErr [i|Could not parse purge result: #{rspBody resp}|])
(\purgeResult -> do
say
[i|Purging with id #{purge_id purgeResult} for room #{roomId}.|]
result <- wait (purge_id purgeResult)
say [i|Purge result: #{result}|]
)
(decode . encodeUtf8 . rspBody $ resp)
-- TODO: run matrix-state-optimizer
_ <- simpleHTTP . giveToken token . postRequest $ [i|#{apiUrl}/purge_media_cache/?before_ts=#{upToTimeStamp}|]
say "Finished"