module Language.Egison.Pretty.Pattern.Mode.Haskell.TH
(
Expr
, prettyExpr
, prettyExprWithFixities
, PrintMode
, PrintFixity
, Fixity
, makeTHMode
, makePrintFixity
)
where
import Data.Text ( Text
, pack
)
import Control.Monad.Except ( MonadError )
import qualified Text.PrettyPrint as PP
( render )
import qualified Language.Haskell.TH.Syntax as TH
( Name
, Exp
, NameIs(..)
)
import qualified Language.Haskell.TH.PprLib as TH
( to_HPJ_Doc
, pprName'
)
import qualified Language.Haskell.TH.Ppr as TH
( pprint )
import qualified Language.Egison.Syntax.Pattern
as Egison
( Expr )
import qualified Language.Egison.Pretty.Pattern
as Egison
( PrintMode(..)
, Fixity(..)
, PrintFixity(..)
, Error
, prettyExpr
)
type Expr = Egison.Expr TH.Name TH.Name TH.Exp
type PrintMode = Egison.PrintMode TH.Name TH.Name TH.Exp
type Fixity = Egison.Fixity TH.Name
type PrintFixity = Egison.PrintFixity TH.Name
makePrintFixity :: Fixity -> PrintFixity
makePrintFixity fixity@(Egison.Fixity _ _ sym) = Egison.PrintFixity
{ Egison.fixity
, Egison.printed = printSym sym
}
where printSym s = pack . PP.render . TH.to_HPJ_Doc $ TH.pprName' TH.Infix s
makeTHMode :: [Fixity] -> PrintMode
makeTHMode fixities = Egison.PrintMode
{ Egison.fixities = map makePrintFixity fixities
, Egison.varNamePrinter = printName
, Egison.namePrinter = printName
, Egison.valueExprPrinter = printValueExpr
, Egison.pageMode = Nothing
}
where
printValueExpr = pack . TH.pprint
printName n = pack . PP.render . TH.to_HPJ_Doc $ TH.pprName' TH.Applied n
prettyExpr :: MonadError (Egison.Error TH.Name) m => Expr -> m Text
prettyExpr = Egison.prettyExpr $ makeTHMode []
prettyExprWithFixities
:: MonadError (Egison.Error TH.Name) m => [Fixity] -> Expr -> m Text
prettyExprWithFixities = Egison.prettyExpr . makeTHMode