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