symantic/Language/Symantic/Interpreting/Text.hs

   1 {-# LANGUAGE UndecidableInstances #-}
   2 -- | Interpreter to serialize an expression into a 'Text'.
   3 module Language.Symantic.Interpreting.Text 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 'TextI'
  12
  13 -- | Interpreter's data.
  14 newtype TextI h
  15  =      TextI
  16  {    unTextI -- Inherited attributes:
  17               :: (Infix, LR)
  18               -> TextI_Lambda_Depth
  19               -- Synthetised attributes:
  20               -> Text
  21  }
  22 type TextI_Lambda_Depth = Int
  23 instance Show (TextI h) where
  24         show = Text.unpack . text_from_term
  25
  26 -- | Interpreter.
  27 text_from_term :: TextI h -> Text
  28 text_from_term r = unTextI r (infixN0, L) 0
  29
  30 -- * Helpers
  31
  32 -- ** Helpers for lambda applications
  33 textI0 :: Text -> TextI h
  34 textI0 name = TextI $ \_op _v -> name
  35 textI1 :: Text -> TextI a1 -> TextI h
  36 textI1 name (TextI a1) = TextI $ \po v ->
  37                 infix_paren po op $
  38                 Text.intercalate " "
  39                  [ name
  40                  , a1 (op, L) v
  41                  ]
  42         where op = infixN 10
  43 textI2 :: Text -> TextI a1 -> TextI a2 -> TextI h
  44 textI2 name (TextI a1) (TextI a2) =
  45         TextI $ \po v ->
  46                 infix_paren po op $
  47                 Text.intercalate " "
  48                  [ name
  49                  , a1 (op, L) v
  50                  , a2 (op, L) v
  51                  ]
  52         where op = infixN 10
  53 textI3 :: Text -> TextI a1 -> TextI a2 -> TextI a3 -> TextI h
  54 textI3 name (TextI a1) (TextI a2) (TextI a3) =
  55         TextI $ \po v ->
  56                 infix_paren po op $
  57                 Text.intercalate " "
  58                  [ name
  59                  , a1 (op, L) v
  60                  , a2 (op, L) v
  61                  , a3 (op, L) v
  62                  ]
  63         where op = infixN 10
  64
  65 textI_infix :: Text -> Infix -> TextI a1 -> TextI a2 -> TextI h
  66 textI_infix name op (TextI a1) (TextI a2) =
  67         TextI $ \po v ->
  68                 infix_paren po op $
  69                 Text.intercalate " "
  70                  [ a1 (op, L) v
  71                  , name
  72                  , a2 (op, R) v
  73                  ]