TH.hs

{-# LANGUAGE TemplateHaskell, KindSignatures, ViewPatterns, EmptyDataDecls #-}

{- |

Module      :  Data.Proxy.TH
Copyright   :  (c) The University of Kansas 2011
License     :  BSD3

Maintainer  :  nicolas.frisby@gmail.com
Stability   :  experimental
Portability :  see LANGUAGE pragmas (... GHC)

Quasiquoter and TH-splice generator for proxies using @type-spine@'s @k -> *@
kind wrappers.

-}
module Data.Proxy.TH (module Data.Proxy.TH, Proxy(..)) where

import Data.Proxy.TH.Aux

import Type.Spine.Stage0 (kTypeG)

import Language.Haskell.TH
import Language.Haskell.TH.Quote

import Data.Proxy




qProxy :: QuasiQuoter
qProxy = QuasiQuoter (\s -> [| Proxy :: $(typ s) |])
                     pat typ (error "Data.Proxy.TH.qProxy Dec") where
  typ s = do
    (i, k) <- parseProxy_ s
    let holder = kTypeG k
    [t| Proxy ($holder $(return i)) |]
  pat s = viewP [| id :: $(typ s) -> $(typ s) |] (conP 'Proxy [])

thProxyT :: Type -> Q Type
thProxyT ty@(unAppT -> (ConT n, length -> k)) = do
  i <- reify n
  (drop k -> ks) <- case i of
    TyConI (DataD _ _ tvbs _ _) -> return $ map tvb_kind tvbs
    TyConI (NewtypeD _ _ tvbs _ _) -> return $ map tvb_kind tvbs
    PrimTyConI _ args _ -> return (replicate args StarK)
    _ -> thProxyT_fail $ Just n
  let holder = kTypeG $ foldr ArrowK StarK ks
  [t| Proxy ($holder $(return ty)) |]
thProxyT _ = thProxyT_fail Nothing

thProxy :: Type -> Q Exp
thProxy ty = [| Proxy :: $(thProxyT ty) |]