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