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 -> PrintFixity
makePrintFixity fixity :: Fixity
fixity@(Egison.Fixity Associativity
_ Precedence
_ Name
sym) = PrintFixity :: forall n. Fixity n -> Text -> PrintFixity n
Egison.PrintFixity
{ Fixity
$sel:fixity:PrintFixity :: Fixity
fixity :: Fixity
Egison.fixity
, $sel:printed:PrintFixity :: Text
Egison.printed = Name -> Text
printSym Name
sym
}
where printSym :: Name -> Text
printSym Name
s = String -> Text
pack (String -> Text) -> (Doc -> String) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
PP.render (Doc -> String) -> (Doc -> Doc) -> Doc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
TH.to_HPJ_Doc (Doc -> Text) -> Doc -> Text
forall a b. (a -> b) -> a -> b
$ NameIs -> Name -> Doc
TH.pprName' NameIs
TH.Infix Name
s
makeTHMode :: [Fixity] -> PrintMode
makeTHMode :: [Fixity] -> PrintMode
makeTHMode [Fixity]
fixities = PrintMode :: forall n v e.
[PrintFixity n]
-> ExtPrinter v
-> ExtPrinter n
-> ExtPrinter e
-> Maybe PageMode
-> PrintMode n v e
Egison.PrintMode
{ $sel:fixities:PrintMode :: [PrintFixity]
Egison.fixities = (Fixity -> PrintFixity) -> [Fixity] -> [PrintFixity]
forall a b. (a -> b) -> [a] -> [b]
map Fixity -> PrintFixity
makePrintFixity [Fixity]
fixities
, $sel:varNamePrinter:PrintMode :: Name -> Text
Egison.varNamePrinter = Name -> Text
printName
, $sel:namePrinter:PrintMode :: Name -> Text
Egison.namePrinter = Name -> Text
printName
, $sel:valueExprPrinter:PrintMode :: ExtPrinter Exp
Egison.valueExprPrinter = ExtPrinter Exp
printValueExpr
, $sel:pageMode:PrintMode :: Maybe PageMode
Egison.pageMode = Maybe PageMode
forall a. Maybe a
Nothing
}
where
printValueExpr :: ExtPrinter Exp
printValueExpr = String -> Text
pack (String -> Text) -> (Exp -> String) -> ExtPrinter Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp -> String
forall a. Ppr a => a -> String
TH.pprint
printName :: Name -> Text
printName Name
n = String -> Text
pack (String -> Text) -> (Doc -> String) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
PP.render (Doc -> String) -> (Doc -> Doc) -> Doc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
TH.to_HPJ_Doc (Doc -> Text) -> Doc -> Text
forall a b. (a -> b) -> a -> b
$ NameIs -> Name -> Doc
TH.pprName' NameIs
TH.Applied Name
n
prettyExpr :: MonadError (Egison.Error TH.Name) m => Expr -> m Text
prettyExpr :: Expr -> m Text
prettyExpr = PrintMode -> Expr -> m Text
forall n (m :: * -> *) v e.
(MonadError (Error n) m, Ord n) =>
PrintMode n v e -> Expr n v e -> m Text
Egison.prettyExpr (PrintMode -> Expr -> m Text) -> PrintMode -> Expr -> m Text
forall a b. (a -> b) -> a -> b
$ [Fixity] -> PrintMode
makeTHMode []
prettyExprWithFixities
:: MonadError (Egison.Error TH.Name) m => [Fixity] -> Expr -> m Text
prettyExprWithFixities :: [Fixity] -> Expr -> m Text
prettyExprWithFixities = PrintMode -> Expr -> m Text
forall n (m :: * -> *) v e.
(MonadError (Error n) m, Ord n) =>
PrintMode n v e -> Expr n v e -> m Text
Egison.prettyExpr (PrintMode -> Expr -> m Text)
-> ([Fixity] -> PrintMode) -> [Fixity] -> Expr -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Fixity] -> PrintMode
makeTHMode