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 attributes:
  17              :: (Infix, Side)
  18              -> DepthLam
  19              -- Synthetised attributes:
  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                 pairIfNeeded pairParen 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                 pairIfNeeded pairParen 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                 pairIfNeeded pairParen 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                 pairIfNeeded pairParen po op $
  70                 Text.intercalate " "
  71                  [ a1 (op, SideL) v
  72                  , name
  73                  , a2 (op, SideR) v
  74                  ]