{-# LANGUAGE UndecidableInstances #-}
-- | Interpreter to serialize an expression into a 'Text'.
module Language.Symantic.Interpreting.Text where

import Data.Monoid ((<>))
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text as Text
import Prelude hiding (Integral(..))

-- * Type 'TextI'

-- | Interpreter's data.
newtype TextI h
 =      TextI
 {    unTextI -- Inherited attributes:
              :: Precedence
              -> TextI_Lambda_Depth
              -- Synthetised attributes:
              -> Text
 }
type TextI_Lambda_Depth = Int
instance Show (TextI h) where
	show = Text.unpack . text_from_term

-- | Interpreter.
text_from_term :: TextI h -> Text
text_from_term r = unTextI r precedence_Toplevel 0

-- * Helpers

-- ** Helpers for lambda applications
textI0 :: Text -> TextI h
textI0 name = TextI $ \_p _v -> name
textI1 :: Text -> TextI a1 -> TextI h
textI1 name (TextI a1) =
	TextI $ \p v ->
		let p' = precedence_App in
		paren p p' $ name
		 <> " " <> a1 p' v
textI2 :: Text -> TextI a1 -> TextI a2 -> TextI h
textI2 name (TextI a1) (TextI a2) =
	TextI $ \p v ->
		let p' = precedence_App in
		paren p p' $ name
		 <> " " <> a1 p' v
		 <> " " <> a2 p' v
textI3 :: Text -> TextI a1 -> TextI a2 -> TextI a3 -> TextI h
textI3 name (TextI a1) (TextI a2) (TextI a3) =
	TextI $ \p v ->
		let p' = precedence_App in
		paren p p' $ name
		 <> " " <> a1 p' v
		 <> " " <> a2 p' v
		 <> " " <> a3 p' v
textI_infix :: Text -> Precedence -> TextI a1 -> TextI a2 -> TextI h
textI_infix name p' (TextI a1) (TextI a2) =
	TextI $ \p v ->
		paren p p' $ a1 p' v <> " " <> name <> " " <> a2 p' v

-- ** Type 'Precedence'

newtype Precedence = Precedence Int
 deriving (Eq, Ord, Show)
precedence_pred :: Precedence -> Precedence
precedence_pred (Precedence p) = Precedence (pred p)
precedence_succ :: Precedence -> Precedence
precedence_succ (Precedence p) = Precedence (succ p)
paren :: (Monoid s, IsString s) => Precedence -> Precedence -> s -> s
paren prec prec' x =
	if prec >= prec'
	 then fromString "(" <> x <> fromString ")"
	 else x

precedence_Toplevel :: Precedence
precedence_Toplevel  = Precedence 0
precedence_App      :: Precedence
precedence_App       = Precedence 10
precedence_Atomic   :: Precedence
precedence_Atomic    = Precedence maxBound