]> Git — Sourcephile - comptalang.git/blob - cli/Hcompta/Repr/Meta.hs
Cleanup hcompta-lib.
[comptalang.git] / cli / Hcompta / Repr / Meta.hs
1 {-# LANGUAGE DataKinds #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE FlexibleInstances #-}
4 {-# LANGUAGE InstanceSigs #-}
5 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
6 {-# LANGUAGE MultiParamTypeClasses #-}
7 {-# LANGUAGE NamedFieldPuns #-}
8 {-# LANGUAGE NoIncoherentInstances #-}
9 {-# LANGUAGE NoMonomorphismRestriction #-}
10 {-# LANGUAGE OverloadedLists #-}
11 {-# LANGUAGE OverloadedStrings #-}
12 {-# LANGUAGE ScopedTypeVariables #-}
13 {-# LANGUAGE TupleSections #-}
14 {-# LANGUAGE TypeFamilies #-}
15 {-# LANGUAGE NoUndecidableInstances #-}
16 {-# OPTIONS_GHC -fno-warn-tabs #-}
17
18 module Hcompta.Repr.Meta where
19
20 import Control.Applicative (Applicative(..))
21 -- import Control.Exception.Safe (MonadThrow, MonadCatch, MonadMask)
22 -- import qualified Control.Exception.Safe as Exn
23 import Control.Monad (Monad(..))
24 -- import qualified Control.Monad.Classes as MC
25 -- import qualified Control.Monad.Classes.Write as MC
26 import Control.Monad.IO.Class (MonadIO(..))
27 -- import Control.Monad.Trans.Class
28 -- import Control.Monad.Trans.State.Strict as ST
29 import Data.Bool
30 -- import Data.Either (Either(..))
31 import Data.Eq (Eq(..))
32 -- import Data.Foldable (asum)
33 import Data.Function (($), (.))
34 import Data.Functor (Functor(..))
35 -- import Data.Int (Int)
36 -- import qualified Data.List as List
37 -- import Data.Maybe (Maybe(..), fromMaybe)
38 -- import Data.Monoid ((<>))
39 -- import Data.Ord (Ord(..))
40 -- import Data.Text (Text)
41 -- import qualified Data.Text as Text
42 -- import Data.Text.Buildable (Buildable(..))
43 -- import qualified Data.Text.Lazy.Builder as TL (Builder)
44 -- import Prelude (pred, succ)
45 -- import Text.Show (Show(..))
46
47 import Hcompta.Expr
48 import Hcompta.Lib.Control.Monad
49 -- import Hcompta.Lib.Data.Monoid (Monoid1)
50 -- import Hcompta.Lib.Data.Text as Text
51
52 -- * Type 'Write'
53
54 -- | Meta-circular /tagless-final interpreter/,
55 -- producing an Haskell term of type @h@.
56 newtype Meta m h
57 = Meta
58 { unMeta :: m h }
59 deriving (Applicative, Functor, Monad, MonadIO)
60
61 run :: Meta m h -> m h
62 run = unMeta
63
64 instance Monad m => Expr_Lit (Meta m) where
65 lit = Meta . return
66 instance Monad m => Expr_Bool (Meta m) where
67 and = liftM2Join $ \x y -> Meta $ return $ x && y
68 or = liftM2Join $ \x y -> Meta $ return $ x || y
69 neg = liftMJoin $ \x -> Meta $ return $ not x
70 instance Monad m => Expr_Eq (Meta m) where
71 eq = liftM2Join $ \x y -> Meta $ return $ x == y
72 instance MonadIO m => Expr_Fun (Meta m)