module Language.Egison.Pretty.Pattern.Mode.Haskell
(
Expr
, prettyExpr
, prettyExprWithFixities
, PrintMode
, PrintFixity
, Fixity
, makePageMode
, makeHaskellMode
, makePrintFixity
)
where
import Data.Char ( isUpper )
import Data.Text ( Text
, pack
)
import Control.Monad.Except ( MonadError )
import Language.Haskell.Exts.Syntax ( QName(..)
, QOp(..)
, Exp
, Name(..)
)
import qualified Language.Haskell.Exts.Pretty as Haskell
( Style(..)
, PPHsMode
, Pretty
, prettyPrint
, prettyPrintStyleMode
)
import qualified Language.Egison.Syntax.Pattern
as Egison
( Expr )
import qualified Language.Egison.Pretty.Pattern
as Egison
( PrintMode(..)
, PrintFixity(..)
, Fixity(..)
, PageMode(..)
, prettyExpr
)
import Language.Egison.Pretty.Pattern ( Error )
type Expr = Egison.Expr (QName ()) (Name ()) (Exp ())
type PrintMode = Egison.PrintMode (QName ()) (Name ()) (Exp ())
type Fixity = Egison.Fixity (QName ())
type PrintFixity = Egison.PrintFixity (QName ())
makePageMode :: Haskell.Style -> Egison.PageMode
makePageMode Haskell.Style { Haskell.lineLength, Haskell.ribbonsPerLine } =
Egison.PageMode { Egison.lineLength
, Egison.ribbonsPerLine = realToFrac ribbonsPerLine
}
makePrintFixity :: Fixity -> PrintFixity
makePrintFixity fixity@(Egison.Fixity _ _ sym) = Egison.PrintFixity
{ Egison.fixity
, Egison.printed = pack $ printSym sym
}
where
printSym q@(UnQual () name) = printName q name
printSym q@(Qual () _ name) = printName q name
printSym ( Special () s ) = Haskell.prettyPrint s
printName q name | isCon name = Haskell.prettyPrint $ QConOp () q
| otherwise = Haskell.prettyPrint $ QVarOp () q
isCon (Ident () (c : _)) = isUpper c
isCon (Symbol () (':' : _)) = True
isCon _ = False
makeHaskellMode :: Haskell.Style -> Haskell.PPHsMode -> [Fixity] -> PrintMode
makeHaskellMode style mode fixities = Egison.PrintMode
{ Egison.fixities = map makePrintFixity fixities
, Egison.varNamePrinter = pprint
, Egison.namePrinter = pprint
, Egison.valueExprPrinter = pprint
, Egison.pageMode = Just $ makePageMode style
}
where
pprint :: Haskell.Pretty a => a -> Text
pprint = pack . Haskell.prettyPrintStyleMode style mode
prettyExpr
:: MonadError (Error (QName ())) m
=> Haskell.Style
-> Haskell.PPHsMode
-> Expr
-> m Text
prettyExpr style mode = Egison.prettyExpr (makeHaskellMode style mode [])
prettyExprWithFixities
:: MonadError (Error (QName ())) m
=> Haskell.Style
-> Haskell.PPHsMode
-> [Fixity]
-> Expr
-> m Text
prettyExprWithFixities style mode fixities =
Egison.prettyExpr (makeHaskellMode style mode fixities)