diff --git a/lib/Internal/Config.hs b/lib/Internal/Config.hs index 30a07c7..db10590 100644 --- a/lib/Internal/Config.hs +++ b/lib/Internal/Config.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} + module Internal.Config ( readConfig -- , readYaml diff --git a/lib/Internal/Database/Model.hs b/lib/Internal/Database/Model.hs index da7f564..873cbf7 100644 --- a/lib/Internal/Database/Model.hs +++ b/lib/Internal/Database/Model.hs @@ -14,6 +14,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE NoImplicitPrelude #-} module Internal.Database.Model where diff --git a/lib/Internal/Database/Ops.hs b/lib/Internal/Database/Ops.hs index 889e679..2c1c3d5 100644 --- a/lib/Internal/Database/Ops.hs +++ b/lib/Internal/Database/Ops.hs @@ -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