{-# LANGUAGE OverloadedStrings #-}
-- | Abstract Syntax Tree.
module Language.LOL.Symantic.AST where

import qualified Data.List as List
import Data.Text (Text)
import qualified Data.Text as Text

-- * Type 'AST'
data AST
 =   AST Text [AST]
 deriving (Eq)
-- | Custom 'Show' instance a little bit more readable
-- than the automatically derived one.
instance Show AST where
	showsPrec p ast@(AST f args) =
		let n = Text.unpack f in
		case ast of
		 AST _ [] -> showString n
		 AST "->" [a] ->
				showParen (p >= 1) $
				showString ("("++n++") ") .
				showsPrec 2 a
		 AST "->" [a, b] ->
				showParen (p >= 1) $
				showsPrec 2 a .
				showString (" "++n++" ") .
				showsPrec 2 b
		 _ ->
			showString n .
			showString "(" .
			showString (List.intercalate ", " $ show <$> args) .
			showString ")"

-- * Type 'Error_Read'
data Error_Read
 =   Error_Read Text
 deriving (Eq, Show)

read_safe :: Read a => Text -> Either Error_Read a
read_safe t =
	case reads $ Text.unpack t of
	 [(x, "")] -> Right x
	 _         -> Left $ Error_Read t