-- |
--
-- Module:      Language.Egison.Pretty.Pattern.Mode.Haskell
-- Description: Printer for Egison pattern expressions in Haskell source code
-- Stability:   experimental
--
-- A printer for Egison pattern expressions in Haskell source code.

module Language.Egison.Pretty.Pattern.Mode.Haskell
  (
  -- * Printers
    Expr
  , prettyExpr
  , prettyExprWithFixities
  -- * Converting @haskell-src-exts@'s entities
  , 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 synonym of 'Egison.Expr' to be printed with Haskell's source code.
type Expr = Egison.Expr (QName ()) (Name ()) (Exp ())

-- | Type synonym of 'Egison.PrintMode' to print 'Expr'.
type PrintMode = Egison.PrintMode (QName ()) (Name ()) (Exp ())

-- | Type synonym of 'Egison.Fixity' to print 'Expr'.
type Fixity = Egison.Fixity (QName ())

-- | Type synonym of 'Egison.PrintFixity' to print 'Expr'.
type PrintFixity = Egison.PrintFixity (QName ())

-- | Build 'Egison.PageMode' using 'Haskell.Style' from @haskell-src-exts@.
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
                  }

-- | Build 'PrintFixity' using 'Fixity' to print Haskell operators.
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

-- | Build 'PrintMode' using 'Haskell.Style' and 'Haskell.PPHsMode' from @haskell-src-exts@, and the list of fixities.
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

-- | Print 'Expr' using 'Haskell.Style' and 'Haskell.PPHsMode' from @haskell-src-exts@.
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 [])

-- | Print 'Expr' using 'Haskell.Style' and 'Haskell.PPHsMode' from @haskell-src-exts@, while supplying an explicit list of 'Fixity'.
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)