]> Git — Sourcephile - comptalang.git/blob - lcc/Hcompta/LCC/Load.hs
Remove cli/
[comptalang.git] / lcc / Hcompta / LCC / Load.hs
1 {-# LANGUAGE UndecidableInstances #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
3 module Main where
4
5 import Control.Monad (Monad(..), forM_, (=<<))
6 import Data.Eq (Eq)
7 import Data.Typeable (Typeable)
8 import Data.Either (Either(..))
9 import Data.Function (($))
10 import Data.Functor ((<$>))
11 import Data.List.NonEmpty (NonEmpty)
12 import System.IO (IO, stdout, stderr, print)
13 import Text.Show (Show(..))
14 import qualified Data.Strict as S
15 import qualified System.Environment as Env
16
17 import qualified Language.Symantic.Document as Doc
18 import qualified Language.Symantic as Sym
19
20 import qualified Hcompta.LCC.Sym as LCC.Sym
21 import Hcompta.LCC.Posting (SourcePos)
22 import Hcompta.LCC.Read
23 import Hcompta.LCC.Write
24 import Hcompta.LCC.Compta
25 import Hcompta.LCC.Source
26 import Hcompta.LCC.Sym.Compta ()
27
28 import Prelude (error)
29
30 type SS = LCC.Sym.SS'
31
32 main :: IO ()
33 main = do
34 args <- Env.getArgs
35 forM_ args $ \arg ->
36 readCompta @LCC.Sym.SRC @SS consTransactions arg >>= \case
37 Left (Error_Read_Syntax err) ->
38 showParseError err >>=
39 (`Doc.ansiIO` stderr)
40 Left (Error_Read_Semantic err) -> error $ show err
41 Right (r, warns) -> do
42 print warns
43 -- print r
44 (`Doc.ansiIO` stdout) $
45 write (context_write, r)
46
47 printError :: Show err => Either err a -> IO a
48 printError (Left err) = error $ show err
49 printError (Right a) = return a
50
51 printErrorS :: Show err => S.Either err a -> IO a
52 printErrorS (S.Left err) = error $ show err
53 printErrorS (S.Right a) = return a
54
55 {-
56 parseTe ::
57 forall ss src.
58 Inj_Modules src ss =>
59 Gram_Term src ss (P.ParsecT P.Dec Text (SS.StateT (Sym.Imports, Modules src ss) Identity)) =>
60 Text ->
61 Either (P.ParseError Char P.Dec) (AST_Term src ss)
62 parseTe inp =
63 let mods::Modules src ss =
64 either (error . show) id $
65 Sym.deleteDefTermInfix ([] `Mod` "$") `fmap`
66 inj_Modules in
67 let imps = importModulesAs [] mods in
68 fmap reduceTeApp $
69 runIdentity $
70 MC.evalStateStrict (imps, mods) $
71 P.runParserT g "" inp
72 where
73 g = unCF $ g_term <* eoi
74
75 readTe ::
76 forall src ss.
77 ( Gram_Term src ss (P.ParsecT P.Dec Text (SS.StateT (Sym.Imports, Modules src ss) Identity))
78 , Syms ss Eval
79 , Syms ss View
80 , Syms ss (BetaT View)
81 , Inj_Modules src ss
82 , Eq src
83 , Show src
84 , Inj_Source (TypeVT src) src
85 , Inj_Source (TypeT src '[]) src
86 , Inj_Source (KindK src) src
87 , Inj_Source (AST_Type src) src
88 , Inj_Name2Type ss
89 ) =>
90 AST_Term src ss ->
91 Either (Error_Term src) (TermVT src ss '[])
92 readTe ast =
93 let tys = inj_Name2Type (Proxy @ss) in
94 Sym.readTerm tys CtxTyZ ast
95
96 evalTe ::
97 Source src =>
98 Syms ss View =>
99 Syms ss Eval =>
100 Syms ss (BetaT View) =>
101 TermVT src ss '[] ->
102 IO ()
103 evalTe (TermVT (Term q t (TeSym te))) = do
104 putStrLn $ "Type = " <> show (q #> t)
105 case proveConstraint q of
106 Nothing -> putStrLn $ "Cannot prove Constraint: " <> show q
107 Just Dict -> do
108 Text.putStrLn $ "View = " <> view (betaT $ te CtxTeZ)
109 case proveConstraint $ Sym.tyShow t of
110 Nothing -> putStrLn $ "No Show instance for type: " <> show t
111 Just Dict -> putStrLn $ "Eval = " <> show (eval $ te CtxTeZ)
112
113 -- dbg :: Show a => String -> a -> a
114 -- dbg msg x = trace (msg ++ " = " ++ show x) x
115 -}