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 (Proxy 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 FixityOf Journal
  55 instance ClassInstancesFor Journal where
  56         proveConstraintFor _ (TyApp _ tq@(TyConst _ _ q) (TyApp _ c j))
  57          | Just HRefl <- proj_ConstKiTy @(K Journal) @Journal c
  58          = case () of
  59                  _ | Just Refl <- proj_Const @Eq q
  60                    , Just Dict <- proveConstraint (tq `tyApp` j) -> Just Dict
  61                    | Just Refl <- proj_Const @Show q
  62                    , Just Dict <- proveConstraint (tq `tyApp` j) -> Just Dict
  63                  _ -> Nothing
  64         proveConstraintFor _c _q = Nothing
  65 instance TypeInstancesFor Journal
  66
  67 instance Gram_Term_AtomsFor src ss g Journal
  68 instance (Source src, Inj_Sym ss Journal) => ModuleFor src ss Journal where
  69         moduleFor = ["Journal"] `moduleWhere`
  70          [ "file"           := teJournal_file
  71          , "last_read_time" := teJournal_last_read_time
  72          , "content"        := teJournal_content
  73          ]
  74
  75 tyJournal :: Source src => Inj_Len vs => Type src vs a ->  Type src vs (Journal a)
  76 tyJournal a = tyConstLen @(K Journal) @Journal (lenVars a) `tyApp` a
  77
  78 teJournal :: Source src => Inj_Sym ss Journal => Journal a -> Term src ss ts '[Proxy a] (() #> Journal a)
  79 teJournal j = Term noConstraint (tyJournal a0) $ teSym @Journal $ journal j
  80
  81 teJournal_file :: Source src => Inj_Sym ss Journal => Term src ss ts '[Proxy a] (() #> (Journal a -> PathFile))
  82 teJournal_file = Term noConstraint (tyJournal a0 ~> tyPathFile) $ teSym @Journal $ lam1 journal_file
  83
  84 teJournal_last_read_time :: Source src => Inj_Sym ss Journal => Term src ss ts '[Proxy a] (() #> (Journal a -> Date))
  85 teJournal_last_read_time = Term noConstraint (tyJournal a0 ~> tyDate) $ teSym @Journal $ lam1 journal_last_read_time
  86
  87 teJournal_content :: Source src => Inj_Sym ss Journal => Term src ss ts '[Proxy a] (() #> (Journal a -> a))
  88 teJournal_content = Term noConstraint (tyJournal a0 ~> a0) $ teSym @Journal $ lam1 journal_content