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 :: Style -> PageMode
makePageMode Haskell.Style { Int
lineLength :: Style -> Int
lineLength :: Int
Haskell.lineLength, Float
ribbonsPerLine :: Style -> Float
ribbonsPerLine :: Float
Haskell.ribbonsPerLine } =
PageMode :: Int -> Double -> PageMode
Egison.PageMode { Int
$sel:lineLength:PageMode :: Int
lineLength :: Int
Egison.lineLength
, $sel:ribbonsPerLine:PageMode :: Double
Egison.ribbonsPerLine = Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
ribbonsPerLine
}
makePrintFixity :: Fixity -> PrintFixity
makePrintFixity :: Fixity -> PrintFixity
makePrintFixity fixity :: Fixity
fixity@(Egison.Fixity Associativity
_ Precedence
_ QName ()
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 = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName () -> String
printSym QName ()
sym
}
where
printSym :: QName () -> String
printSym q :: QName ()
q@(UnQual () Name ()
name) = QName () -> Name () -> String
printName QName ()
q Name ()
name
printSym q :: QName ()
q@(Qual () ModuleName ()
_ Name ()
name) = QName () -> Name () -> String
printName QName ()
q Name ()
name
printSym ( Special () SpecialCon ()
s ) = SpecialCon () -> String
forall a. Pretty a => a -> String
Haskell.prettyPrint SpecialCon ()
s
printName :: QName () -> Name () -> String
printName QName ()
q Name ()
name | Name () -> Bool
isCon Name ()
name = QOp () -> String
forall a. Pretty a => a -> String
Haskell.prettyPrint (QOp () -> String) -> QOp () -> String
forall a b. (a -> b) -> a -> b
$ () -> QName () -> QOp ()
forall l. l -> QName l -> QOp l
QConOp () QName ()
q
| Bool
otherwise = QOp () -> String
forall a. Pretty a => a -> String
Haskell.prettyPrint (QOp () -> String) -> QOp () -> String
forall a b. (a -> b) -> a -> b
$ () -> QName () -> QOp ()
forall l. l -> QName l -> QOp l
QVarOp () QName ()
q
isCon :: Name () -> Bool
isCon (Ident () (Char
c : String
_)) = Char -> Bool
isUpper Char
c
isCon (Symbol () (Char
':' : String
_)) = Bool
True
isCon Name ()
_ = Bool
False
makeHaskellMode :: Haskell.Style -> Haskell.PPHsMode -> [Fixity] -> PrintMode
makeHaskellMode :: Style -> PPHsMode -> [Fixity] -> PrintMode
makeHaskellMode Style
style PPHsMode
mode [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 :: ExtPrinter (Name ())
Egison.varNamePrinter = ExtPrinter (Name ())
forall a. Pretty a => a -> Text
pprint
, $sel:namePrinter:PrintMode :: ExtPrinter (QName ())
Egison.namePrinter = ExtPrinter (QName ())
forall a. Pretty a => a -> Text
pprint
, $sel:valueExprPrinter:PrintMode :: ExtPrinter (Exp ())
Egison.valueExprPrinter = ExtPrinter (Exp ())
forall a. Pretty a => a -> Text
pprint
, $sel:pageMode:PrintMode :: Maybe PageMode
Egison.pageMode = PageMode -> Maybe PageMode
forall a. a -> Maybe a
Just (PageMode -> Maybe PageMode) -> PageMode -> Maybe PageMode
forall a b. (a -> b) -> a -> b
$ Style -> PageMode
makePageMode Style
style
}
where
pprint :: Haskell.Pretty a => a -> Text
pprint :: a -> Text
pprint = String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> PPHsMode -> a -> String
forall a. Pretty a => Style -> PPHsMode -> a -> String
Haskell.prettyPrintStyleMode Style
style PPHsMode
mode
prettyExpr
:: MonadError (Error (QName ())) m
=> Haskell.Style
-> Haskell.PPHsMode
-> Expr
-> m Text
prettyExpr :: Style -> PPHsMode -> Expr -> m Text
prettyExpr Style
style PPHsMode
mode = 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 (Style -> PPHsMode -> [Fixity] -> PrintMode
makeHaskellMode Style
style PPHsMode
mode [])
prettyExprWithFixities
:: MonadError (Error (QName ())) m
=> Haskell.Style
-> Haskell.PPHsMode
-> [Fixity]
-> Expr
-> m Text
prettyExprWithFixities :: Style -> PPHsMode -> [Fixity] -> Expr -> m Text
prettyExprWithFixities Style
style PPHsMode
mode [Fixity]
fixities =
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 (Style -> PPHsMode -> [Fixity] -> PrintMode
makeHaskellMode Style
style PPHsMode
mode [Fixity]
fixities)