ENH remove prelude from all but main
This commit is contained in:
parent
5e967ae9cb
commit
69ead7b40d
|
@ -1,3 +1,5 @@
|
|||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
|
||||
module Internal.Config
|
||||
( readConfig
|
||||
-- , readYaml
|
||||
|
|
|
@ -14,6 +14,7 @@
|
|||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
|
||||
module Internal.Database.Model where
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue