]> Git — Sourcephile - comptalang.git/blob - lcc/Hcompta/LCC/Sym/Journal.hs
Remove cli/
[comptalang.git] / lcc / Hcompta / LCC / Sym / Journal.hs
1 {-# LANGUAGE UndecidableInstances #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
3 -- | Symantic for 'Journal'.
4 module Hcompta.LCC.Sym.Journal where
5
6 import Data.Eq (Eq)
7 import Data.Function (($), (.))
8 import Data.Maybe (Maybe(..))
9 import Text.Show (Show(..))
10 import qualified Prelude ()
11
12 import Hcompta.LCC.IO (PathFile(..))
13 import Hcompta.LCC.Journal (Journal)
14 import Hcompta.LCC.Posting (Date)
15 import Hcompta.LCC.Sym.Date (tyDate)
16 import Hcompta.LCC.Sym.FileSystem (tyPathFile)
17 import qualified Hcompta.LCC.Journal as LCC
18
19 import Language.Symantic
20 import Language.Symantic.Lib (a0)
21
22 -- * Class 'Sym_Journal'
23 type instance Sym Journal = Sym_Journal
24 class Sym_Journal term where
25 journal :: Journal j -> term (Journal j)
26 journal_file :: term (Journal j) -> term PathFile
27 journal_last_read_time :: term (Journal j) -> term Date
28 journal_content :: term (Journal j) -> term j
29 default journal :: Sym_Journal (UnT term) => Trans term => Journal j -> term (Journal j)
30 default journal_file :: Sym_Journal (UnT term) => Trans term => term (Journal j) -> term PathFile
31 default journal_last_read_time :: Sym_Journal (UnT term) => Trans term => term (Journal j) -> term Date
32 default journal_content :: Sym_Journal (UnT term) => Trans term => term (Journal j) -> term j
33 journal = trans . journal
34 journal_file = trans1 journal_file
35 journal_last_read_time = trans1 journal_last_read_time
36 journal_content = trans1 journal_content
37
38 instance Sym_Journal Eval where
39 journal = Eval
40 journal_file = eval1 LCC.journal_file
41 journal_last_read_time = eval1 LCC.journal_last_read_time
42 journal_content = eval1 LCC.journal_content
43 instance Sym_Journal View where
44 journal _ = View $ \_v _p -> "Journal.journal"
45 journal_file = view1 "Journal.file"
46 journal_last_read_time = view1 "Journal.last_read_time"
47 journal_content = view1 "Journal.content"
48 instance (Sym_Journal r1, Sym_Journal r2) => Sym_Journal (Dup r1 r2) where
49 journal j = journal j `Dup` journal j
50 journal_file = dup1 @Sym_Journal journal_file
51 journal_last_read_time = dup1 @Sym_Journal journal_last_read_time
52 journal_content = dup1 @Sym_Journal journal_content
53 instance (Sym_Journal term, Sym_Lambda term) => Sym_Journal (BetaT term)
54
55 instance NameTyOf Journal where
56 nameTyOf _c = ["Journal"] `Mod` "Journal"
57 instance FixityOf Journal
58 instance ClassInstancesFor Journal where
59 proveConstraintFor _ (TyApp _ tq@(TyConst _ _ q) (TyApp _ c j))
60 | Just HRefl <- proj_ConstKiTy @(K Journal) @Journal c
61 = case () of
62 _ | Just Refl <- proj_Const @Eq q
63 , Just Dict <- proveConstraint (tq `tyApp` j) -> Just Dict
64 | Just Refl <- proj_Const @Show q
65 , Just Dict <- proveConstraint (tq `tyApp` j) -> Just Dict
66 _ -> Nothing
67 proveConstraintFor _c _q = Nothing
68 instance TypeInstancesFor Journal
69
70 instance Gram_Term_AtomsFor src ss g Journal
71 instance (Source src, SymInj ss Journal) => ModuleFor src ss Journal where
72 moduleFor = ["Journal"] `moduleWhere`
73 [ "file" := teJournal_file
74 , "last_read_time" := teJournal_last_read_time
75 , "content" := teJournal_content
76 ]
77
78 tyJournal :: Source src => LenInj vs => Type src vs a -> Type src vs (Journal a)
79 tyJournal a = tyConstLen @(K Journal) @Journal (lenVars a) `tyApp` a
80
81 teJournal :: Source src => SymInj ss Journal => Journal a -> Term src ss ts '[Proxy a] (() #> Journal a)
82 teJournal j = Term noConstraint (tyJournal a0) $ teSym @Journal $ journal j
83
84 teJournal_file :: Source src => SymInj ss Journal => Term src ss ts '[Proxy a] (() #> (Journal a -> PathFile))
85 teJournal_file = Term noConstraint (tyJournal a0 ~> tyPathFile) $ teSym @Journal $ lam1 journal_file
86
87 teJournal_last_read_time :: Source src => SymInj ss Journal => Term src ss ts '[Proxy a] (() #> (Journal a -> Date))
88 teJournal_last_read_time = Term noConstraint (tyJournal a0 ~> tyDate) $ teSym @Journal $ lam1 journal_last_read_time
89
90 teJournal_content :: Source src => SymInj ss Journal => Term src ss ts '[Proxy a] (() #> (Journal a -> a))
91 teJournal_content = Term noConstraint (tyJournal a0 ~> a0) $ teSym @Journal $ lam1 journal_content