-- | This module enables to 'showCode'
-- without requiring to be in 'IO'.
module Language.Haskell.TH.Show where

import Data.Function (($), (.))
import Data.String (String, IsString(..))
import Prelude (Integer, error, succ)
import Control.Applicative (Applicative(..))
import Control.Monad (Monad(..))
import Data.Functor (Functor)
import qualified Control.Monad as CM
import qualified Control.Monad.IO.Class as CM
import qualified Control.Monad.Trans.State as MT
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH

newtype ShowQ a = ShowQ { unShowQ :: MT.State Integer a }
  deriving (Functor, Applicative, Monad)

runShowQ :: ShowQ a -> a
runShowQ = (`MT.evalState` 0) . unShowQ

showCode :: TH.CodeQ a -> String
showCode q = runShowQ $ do
  TH.runQ (TH.examineCode q) >>= return .  TH.pprint . TH.unType

-- | The whole point of ShowQ is to remove the need for IO,
-- but GHC's 'TH.Quasi' class forces it...
instance CM.MonadIO ShowQ
instance CM.MonadFail ShowQ where
  fail = error
-- | Only 'TH.qNewName' is needed and thus implemented.
instance TH.Quasi ShowQ where
  qNewName n = ShowQ $ do
    i <- MT.get
    MT.put (succ i)
    return (TH.mkNameU n i)