Don't use TH for writing bindings?Β #6
Description
There is a Helper.hs module that I feel is obfuscating what could be straightforward/simple bindings:
-- | Given a name @fname@, a name of a C function @cname@ and the desired
-- Haskell type @ftype@, this function generates:
--
-- * A foreign import of @cname@, named as @fname'@.
-- * An always-inline MonadIO version of @fname'@, named @fname@.
liftF :: String -> String -> Q Type -> Q [Dec]
liftF fname cname ftype = do
let f' = mkName $ fname ++ "'" -- Direct binding.
let f = mkName fname -- Lifted.
t' <- ftype -- Type of direct binding.
-- The generated function accepts n arguments.
args <- replicateM (countArgs t') $ newName "x"
-- If the function has no arguments, then we just liftIO it directly.
-- However, this fails to typecheck without an explicit type signature.
-- Therefore, we include one. TODO: Can we get rid of this?
sigd <- case args of
[] -> ((:[]) . SigD f) `fmap` liftType t'
_ -> return []
return $ concat
[
[ ForeignD $ ImportF CCall Safe cname f' t'
, PragmaD $ InlineP f Inline FunLike AllPhases
]
, sigd
, [ FunD f
[ Clause
(map VarP args)
(NormalB $ 'liftIO `applyTo` [f' `applyTo` map VarE args])
[]
]
]
]
-- | How many arguments does a function of a given type take?
countArgs :: Type -> Int
countArgs = count 0
where
count !n = \case
(AppT (AppT ArrowT _) t) -> count (n+1) t
(ForallT _ _ t) -> count n t
(SigT t _) -> count n t
_ -> n
-- | An expression where f is applied to n arguments.
applyTo :: Name -> [Exp] -> Exp
applyTo f [] = VarE f
applyTo f es = loop (tail es) . AppE (VarE f) $ head es
where
loop as e = foldl AppE e as
-- | Fuzzily speaking, converts a given IO type into a MonadIO m one.
liftType :: Type -> Q Type
liftType = \case
AppT _ t -> do
m <- newName "m"
return $
ForallT
[PlainTV m]
[AppT (ConT ''MonadIO) $ VarT m]
(AppT (VarT m) t)
t -> return tI suggest each function just be written by hand, and all this TH deleted. I'm happy to provide a patch if you agree!