module FP.API.TH
(cmd
) where
import FP.API.Run
import FP.API.Types
import Data.Char
import Language.Haskell.TH
cmd :: Name -> Q [Dec]
cmd name = do
DataConI _name typ _ptyp _fixity <- reify name
return [FunD funName
[Clause [] (NormalB (stripIdeCommand typ)) []]]
where funName = mkName (decapitalize (nameBase name))
stripIdeCommand = go (1 :: Int) where
go i (AppT (AppT ArrowT _x) (ConT t))
| t == ''IdeCommand =
(AppE (VarE 'runCommand)
(foldl (\inner i' -> AppE inner (VarE (gensym i')))
(ConE name)
[1..i1]))
go i (AppT _x y) = LamE [VarP (gensym i)] (go (i+1) y)
go _ _ = error "invalid IdeCommand constructor type"
gensym i = mkName ("x" ++ show i)
decapitalize :: String -> String
decapitalize [] = []
decapitalize (x:xs) = toLower x : xs