summaryrefslogtreecommitdiff
path: root/src/Expr.hs
blob: fa17158d2c1b9ddfbd67b763f6ea58a070bbabc4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
module Expr (
    Expr(..),
    ExprContext(..),
    getContext,

    addDependency,
    collectDependencies,

    exprIO,
) where

import Data.Kind


data Expr c a where
    Pure :: a -> Expr c a
    App :: Expr c (a -> b) -> Expr c a -> Expr c b
    GetContext :: Expr c c
    AddDependency :: ExprContext c => ExprDependency c -> Expr c a -> Expr c a
    ExprIO :: IO a -> Expr c a

instance Functor (Expr c) where
    fmap f x = Pure f <*> x

instance Applicative (Expr c) where
    pure = Pure
    (<*>) = App


class Monoid (ExprDependency c) => ExprContext c where
    type ExprDependency c :: Type


getContext :: Expr c c
getContext = GetContext


addDependency :: ExprContext c => ExprDependency c -> Expr c a -> Expr c a
addDependency = AddDependency

collectDependencies :: ExprContext c => Expr c a -> ExprDependency c
collectDependencies = \case
    Pure {} -> mempty
    App f x -> collectDependencies f <> collectDependencies x
    GetContext {} -> mempty
    AddDependency d x -> d <> collectDependencies x
    ExprIO {} -> mempty


exprIO :: IO a -> Expr c a
exprIO = ExprIO