-- |
-- Module      : Language.Haskell.TH.Lib.Extra
-- Copyright   : 2013 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module provides extra helper functions
-- complementing "Language.Haskell.TH.Lib"
module Language.Haskell.TH.Lib.Extra (
  -- * Extra template functions
  -- $extraTemplateFunctions
  integralE, simpleValD, maybeD,

  -- * Pretty printing for 'Q' monad
  -- $prettyPrint
  pprQ,

  -- * Functions to print message or errors when compile time
  -- $compileMessage
  reportWarning, reportError,
  ) where

import Language.Haskell.TH
  (Ppr, ppr, Q, runQ,
   Name, Dec, sigD, valD, TypeQ, varP, normalB,
   ExpQ, litE, integerL)
import Language.Haskell.TH.PprLib (Doc)
import Language.Haskell.TH.Syntax (Quasi, qReport)

{- $extraTemplateFunctions
Extra functions to generate haskell templates.
-}

-- | Integer literal template from 'Integral' types.
integralE :: Integral a => a -> ExpQ
integralE :: a -> ExpQ
integralE =  Lit -> ExpQ
litE (Lit -> ExpQ) -> (a -> Lit) -> a -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Lit
integerL (Integer -> Lit) -> (a -> Integer) -> a -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a. Integral a => a -> Integer
toInteger

-- | Generate declaration template from name, type and expression.
simpleValD :: Name -> TypeQ -> ExpQ -> Q [Dec]
simpleValD :: Name -> TypeQ -> ExpQ -> Q [Dec]
simpleValD var :: Name
var typ :: TypeQ
typ expr :: ExpQ
expr =  do
  Dec
sig <- Name -> TypeQ -> DecQ
sigD Name
var TypeQ
typ
  Dec
val <- PatQ -> BodyQ -> [DecQ] -> DecQ
valD (Name -> PatQ
varP Name
var) (ExpQ -> BodyQ
normalB ExpQ
expr) []
  [Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return [Dec
sig, Dec
val]

-- | May generate declaration template.
maybeD :: (a -> Q [Dec]) -> Maybe a -> Q [Dec]
maybeD :: (a -> Q [Dec]) -> Maybe a -> Q [Dec]
maybeD =  Q [Dec] -> (a -> Q [Dec]) -> Maybe a -> Q [Dec]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return [])

{- $prettyPrint
Pretty printing for haskell templates.
-}

-- | Helper function for pretty printing 'Q' Monad.
pprQ :: (Functor m, Quasi m, Ppr a) => Q a -> m Doc
pprQ :: Q a -> m Doc
pprQ =  (a -> Doc) -> m a -> m Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Doc
forall a. Ppr a => a -> Doc
ppr (m a -> m Doc) -> (Q a -> m a) -> Q a -> m Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q a -> m a
forall (m :: * -> *) a. Quasi m => Q a -> m a
runQ

{- $compileMessage
Functions to display or to raise compile messages from codes
which generating haskell templates.

Only messages directly generated by 'Q' monad report actions
are handled by ghc loggers.

> -- Handled by ghc logger
> qReport False "Foo"

> -- Not handled by ghc logger
> runIO . runQ $ qReport False "Foo"
 -}

-- | Print compile warnings from TH code.
reportWarning :: String -> Q ()
reportWarning :: String -> Q ()
reportWarning =  Bool -> String -> Q ()
forall (m :: * -> *). Quasi m => Bool -> String -> m ()
qReport Bool
False

-- | Print compile errors from TH code.
reportError :: String -> Q ()
reportError :: String -> Q ()
reportError =  Bool -> String -> Q ()
forall (m :: * -> *). Quasi m => Bool -> String -> m ()
qReport Bool
True