ENH remove prelude from all but main

This commit is contained in:
Nathan Dwarshuis 2023-01-28 22:58:05 -05:00
parent 5e967ae9cb
commit 69ead7b40d
3 changed files with 41 additions and 36 deletions

View File

@ -1,3 +1,5 @@
{-# LANGUAGE NoImplicitPrelude #-}
module Internal.Config
( readConfig
-- , readYaml

View File

@ -14,6 +14,7 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Internal.Database.Model where

View File

@ -4,11 +4,12 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Internal.Database.Ops
( migrate_
, nukeTables
, showBalances
-- , showBalances
, updateHashes
, getDBState
, tree2Records
@ -24,6 +25,7 @@ import Database.Esqueleto.Experimental
import Database.Persist.Sql hiding (delete, (==.), (||.))
import Database.Persist.Sqlite hiding (delete, (==.), (||.))
import Database.Sqlite hiding (Config)
import GHC.Err
import Internal.Database.Model
import Internal.Types
import Internal.Utils
@ -64,38 +66,38 @@ nukeTables = do
deleteWhere ([] :: [Filter AccountR])
deleteWhere ([] :: [Filter TransactionR])
showBalances :: MonadUnliftIO m => SqlPersistT m ()
showBalances = do
xs <- select $ do
(accounts :& splits :& txs) <-
from
$ table @AccountR
`innerJoin` table @SplitR
`on` (\(a :& s) -> a ^. AccountRId ==. s ^. SplitRAccount)
`innerJoin` table @TransactionR
`on` (\(_ :& s :& t) -> s ^. SplitRTransaction ==. t ^. TransactionRId)
where_ $
isNothing (txs ^. TransactionRBucket)
&&. ( (accounts ^. AccountRFullpath `like` val "asset" ++. (%))
||. (accounts ^. AccountRFullpath `like` val "liability" ++. (%))
)
groupBy (accounts ^. AccountRFullpath, accounts ^. AccountRName)
return
( accounts ^. AccountRFullpath
, accounts ^. AccountRName
, sum_ $ splits ^. SplitRValue
)
-- TODO super stetchy table printing thingy
liftIO $ do
putStrLn $ T.unpack $ fmt "Account" "Balance"
putStrLn $ T.unpack $ fmt (T.replicate 60 "-") (T.replicate 15 "-")
mapM_ (putStrLn . T.unpack . fmtBalance) xs
where
fmtBalance (path, name, bal) = fmt (toFullPath path name) (toBal bal)
fmt a b = T.unwords ["| ", pad 60 a, " | ", pad 15 b, " |"]
pad n xs = T.append xs $ T.replicate (n - T.length xs) " "
toFullPath path name = T.unwords [unValue @T.Text path, "/", unValue @T.Text name]
toBal = maybe "???" (fmtRational 2) . unValue
-- showBalances :: MonadUnliftIO m => SqlPersistT m ()
-- showBalances = do
-- xs <- select $ do
-- (accounts :& splits :& txs) <-
-- from
-- $ table @AccountR
-- `innerJoin` table @SplitR
-- `on` (\(a :& s) -> a ^. AccountRId ==. s ^. SplitRAccount)
-- `innerJoin` table @TransactionR
-- `on` (\(_ :& s :& t) -> s ^. SplitRTransaction ==. t ^. TransactionRId)
-- where_ $
-- isNothing (txs ^. TransactionRBucket)
-- &&. ( (accounts ^. AccountRFullpath `like` val "asset" ++. (%))
-- ||. (accounts ^. AccountRFullpath `like` val "liability" ++. (%))
-- )
-- groupBy (accounts ^. AccountRFullpath, accounts ^. AccountRName)
-- return
-- ( accounts ^. AccountRFullpath
-- , accounts ^. AccountRName
-- , sum_ $ splits ^. SplitRValue
-- )
-- -- TODO super stetchy table printing thingy
-- liftIO $ do
-- putStrLn $ T.unpack $ fmt "Account" "Balance"
-- putStrLn $ T.unpack $ fmt (T.replicate 60 "-") (T.replicate 15 "-")
-- mapM_ (putStrLn . T.unpack . fmtBalance) xs
-- where
-- fmtBalance (path, name, bal) = fmt (toFullPath path name) (toBal bal)
-- fmt a b = T.unwords ["| ", pad 60 a, " | ", pad 15 b, " |"]
-- pad n xs = T.append xs $ T.replicate (n - T.length xs) " "
-- toFullPath path name = T.unwords [unValue @T.Text path, "/", unValue @T.Text name]
-- toBal = maybe "???" (fmtRational 2) . unValue
hashConfig :: Config -> [Int]
hashConfig
@ -220,7 +222,7 @@ tree2Records t = go []
go ps (Placeholder d n cs) =
let e = tree2Entity t (fmap snd ps) n d
k = entityKey e
(as, aps, ms) = unzip3 $ fmap (go ((k, n) : ps)) cs
(as, aps, ms) = L.unzip3 $ fmap (go ((k, n) : ps)) cs
a0 = acnt k n (fmap snd ps) d
paths = expand k $ fmap fst ps
in (a0 : concat as, paths ++ concat aps, concat ms)
@ -240,7 +242,7 @@ paths2IDs :: [(AcntPath, a)] -> [(AcntID, a)]
paths2IDs =
uncurry zip
. first trimNames
. unzip
. L.unzip
. L.sortOn fst
. fmap (first pathList)
where
@ -301,7 +303,7 @@ indexAcntRoot r =
, M.fromList $ paths2IDs $ concat ms
)
where
(ars, aprs, ms) = unzip3 $ uncurry tree2Records <$> flattenAcntRoot r
(ars, aprs, ms) = L.unzip3 $ uncurry tree2Records <$> flattenAcntRoot r
getDBState
:: MonadUnliftIO m