Language/LOL/Symantic/AST.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 -- | Abstract Syntax Tree.
   3 module Language.LOL.Symantic.AST where
   4
   5 import qualified Data.List as List
   6 import Data.Text (Text)
   7 import qualified Data.Text as Text
   8
   9 -- * Type 'AST'
  10 data AST
  11  =   AST Text [AST]
  12  deriving (Eq)
  13 -- | Custom 'Show' instance a little bit more readable
  14 -- than the automatically derived one.
  15 instance Show AST where
  16         showsPrec p ast@(AST f args) =
  17                 let n = Text.unpack f in
  18                 case ast of
  19                  AST _ [] -> showString n
  20                  AST "->" [a] ->
  21                                 showParen (p >= 1) $
  22                                 showString ("("++n++") ") .
  23                                 showsPrec 2 a
  24                  AST "->" [a, b] ->
  25                                 showParen (p >= 1) $
  26                                 showsPrec 2 a .
  27                                 showString (" "++n++" ") .
  28                                 showsPrec 2 b
  29                  _ ->
  30                         showString n .
  31                         showString "(" .
  32                         showString (List.intercalate ", " $ show <$> args) .
  33                         showString ")"
  34
  35 -- * Type 'Error_Read'
  36 data Error_Read
  37  =   Error_Read Text
  38  deriving (Eq, Show)
  39
  40 read_safe :: Read a => Text -> Either Error_Read a
  41 read_safe t =
  42         case reads $ Text.unpack t of
  43          [(x, "")] -> Right x
  44          _         -> Left $ Error_Read t