]> Git — Sourcephile - haskell/symantic.git/blob - symantic/Language/Symantic/Interpreting/View.hs
Change Term to be a GADT, to avoid type applications and allow TypeOf Term.
[haskell/symantic.git] / symantic / Language / Symantic / Interpreting / View.hs
1 {-# LANGUAGE UndecidableInstances #-}
2 -- | Interpreter to serialize an expression into a 'Text'.
3 module Language.Symantic.Interpreting.View where
4
5 import Data.Text (Text)
6 import qualified Data.Text as Text
7 import Prelude hiding (Integral(..))
8
9 import Language.Symantic.Grammar
10
11 -- * Type 'View'
12
13 -- | Interpreter's data.
14 newtype View a
15 = View
16 { unView -- Inherited attribuctx:
17 :: (Infix, Side)
18 -> DepthLam
19 -- Synthetised attribuctx:
20 -> Text
21 }
22 type DepthLam = Int
23 instance Show (View a) where
24 show = Text.unpack . view
25
26 -- | Interpreter.
27 view :: View a -> Text
28 view r = unView r (infixN0, SideL) 0
29
30 -- ** Constructors
31 view0 :: Text -> View a
32 view0 name = View $ \_op _v -> name
33
34 view1 :: Text -> View a1 -> View a
35 view1 name (View a1) = View $ \po v ->
36 parenInfix po op $
37 Text.intercalate " "
38 [ name
39 , a1 (op, SideL) v
40 ]
41 where op = infixN 10
42
43 view2 :: Text -> View a1 -> View a2 -> View a
44 view2 name (View a1) (View a2) =
45 View $ \po v ->
46 parenInfix po op $
47 Text.intercalate " "
48 [ name
49 , a1 (op, SideL) v
50 , a2 (op, SideL) v
51 ]
52 where op = infixN 10
53
54 view3 :: Text -> View a1 -> View a2 -> View a3 -> View a
55 view3 name (View a1) (View a2) (View a3) =
56 View $ \po v ->
57 parenInfix po op $
58 Text.intercalate " "
59 [ name
60 , a1 (op, SideL) v
61 , a2 (op, SideL) v
62 , a3 (op, SideL) v
63 ]
64 where op = infixN 10
65
66 viewInfix :: Text -> Infix -> View a1 -> View a2 -> View a
67 viewInfix name op (View a1) (View a2) =
68 View $ \po v ->
69 parenInfix po op $
70 Text.intercalate " "
71 [ a1 (op, SideL) v
72 , name
73 , a2 (op, SideR) v
74 ]