-- |
--
-- 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.Text                      ( Text
                                                , pack
                                                )
import           Control.Monad.Except           ( MonadError )
import           Language.Haskell.Exts.Syntax   ( QName(..)
                                                , Exp
                                                , Name(..)
                                                , ModuleName(..)
                                                )
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 Haskell.Style { Haskell.lineLength, Haskell.ribbonsPerLine } =
  Egison.PageMode { Egison.lineLength
                  , Egison.ribbonsPerLine = realToFrac ribbonsPerLine
                  }

-- | Build 'PrintFixity' using 'Fixity' to print Haskell operators.
makePrintFixity :: Fixity -> PrintFixity
makePrintFixity fixity@(Egison.Fixity _ _ sym) = Egison.PrintFixity
  { Egison.fixity
  , Egison.printed = pack $ printSym sym
  }
 where
  printSym (UnQual () (Ident  () n)                ) = printIdentOp Nothing n
  printSym (UnQual () (Symbol () n)                ) = printSymbolOp Nothing n
  printSym (Qual () (ModuleName () m) (Ident  () n)) = printIdentOp (Just m) n
  printSym (Qual () (ModuleName () m) (Symbol () n)) = printSymbolOp (Just m) n
  printSym (Special () s                           ) = Haskell.prettyPrint s
  printIdentOp mModName n = '`' : maybe n (++ '.' : n) mModName ++ "`"
  printSymbolOp mModName n = maybe n (++ '.' : n) mModName

-- | 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 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

-- | 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 mode = Egison.prettyExpr (makeHaskellMode style 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 mode fixities =
  Egison.prettyExpr (makeHaskellMode style mode fixities)