-- |
--
-- Module:      Language.Egison.Parser.Pattern.Mode.Haskell
-- Description: Printer for Egison pattern expressions to use with Template Haskell
-- Stability:   experimental
--
-- A printer for Egison pattern expressions to use with Template Haskell.

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

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

-- | Type synonym of 'Egison.Fixity' to print 'Expr'.
type Fixity = Egison.Fixity TH.Name

-- | Type synonym of 'Egison.PrintFixity' to print 'Expr'.
type PrintFixity = Egison.PrintFixity TH.Name

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

-- | Build 'PrintMode' using the list of fixities.
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

-- | Print 'Expr'.
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 []

-- | Print 'Expr' with an explicit list of 'Fixity'.
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