src/Language/Haskell/TH/Show.hs

   1 {-# OPTIONS_GHC -Wno-missing-methods #-} -- For TH.Quasi
   2 -- | This module enables to 'showCode'
   3 -- without requiring to be in 'IO'.
   4 module Language.Haskell.TH.Show where
   5
   6 import Data.Function (($), (.))
   7 import Data.String (String)
   8 import Prelude (Integer, error, succ)
   9 import Control.Applicative (Applicative(..))
  10 import Control.Monad (Monad(..))
  11 import Data.Functor (Functor)
  12 import qualified Control.Monad as CM
  13 import qualified Control.Monad.IO.Class as CM
  14 import qualified Control.Monad.Trans.State as MT
  15 import qualified Language.Haskell.TH as TH
  16 import qualified Language.Haskell.TH.Syntax as TH
  17 import qualified Language.Haskell.TH.Ppr as TH
  18 import qualified Language.Haskell.TH.PprLib as TH
  19 import qualified Text.PrettyPrint as Doc
  20
  21 newtype ShowQ a = ShowQ { unShowQ :: MT.State Integer a }
  22   deriving (Functor, Applicative, Monad)
  23
  24 runShowQ :: ShowQ a -> a
  25 runShowQ = (`MT.evalState` 0) . unShowQ
  26
  27 showCode :: TH.Precedence -> TH.CodeQ a -> String
  28 showCode p q = runShowQ $ do
  29   texp <- TH.runQ (TH.examineCode q)
  30   return $ Doc.render $ TH.to_HPJ_Doc $ TH.pprExp p $ TH.unType texp
  31
  32 -- | The whole point of ShowQ is to remove the need for IO,
  33 -- but GHC's 'TH.Quasi' class forces it...
  34 instance CM.MonadIO ShowQ
  35 instance CM.MonadFail ShowQ where
  36   fail = error
  37 -- | Only 'TH.qNewName' is needed and thus implemented.
  38 instance TH.Quasi ShowQ where
  39   qNewName n = ShowQ $ do
  40     i <- MT.get
  41     MT.put (succ i)
  42     return (TH.mkNameU n i)