Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Don't use TH for writing bindings? #6

Open
mitchellwrosen opened this issue Dec 19, 2018 · 1 comment
Open

Don't use TH for writing bindings? #6

mitchellwrosen opened this issue Dec 19, 2018 · 1 comment

Comments

@mitchellwrosen
Copy link

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 t

I suggest each function just be written by hand, and all this TH deleted. I'm happy to provide a patch if you agree!

@sbidin
Copy link
Member

sbidin commented Dec 19, 2018

@mitchellwrosen Sure, that would be great! It'd be nice to lose the template haskell dependency.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

2 participants