module Ribosome.Nvim.Api.Generate where import Data.Char (toUpper) import qualified Data.Map.Strict as Map (fromList, lookup) import Data.MessagePack (Object) import Language.Haskell.TH import Neovim.API.Parser ( NeovimAPI(functions), NeovimFunction(NeovimFunction), NeovimType(NestedType, SimpleType, Void), customTypes, parseAPI, ) camelcase :: String -> String camelcase = snd . foldr folder (False, "") where folder '_' (_, z) = (True, z) folder a (True, h : t) = (False, a : toUpper h : t) folder a (True, []) = (False, [a]) folder a (False, z) = (False, a : z) haskellTypes :: Map String TypeQ haskellTypes = Map.fromList [ ("Boolean", [t|Bool|]), ("Integer", [t|Int|]), ("Float", [t|Double|]), ("String", [t|Text|]), ("Array", [t|[Object]|]), ("Dictionary", [t|Map Text Object|]), ("void", [t|()|]) ] haskellType :: NeovimType -> Q Type haskellType at = case at of Void -> [t|()|] NestedType t Nothing -> appT listT $ haskellType t NestedType t (Just n) -> foldl appT (tupleT n) . replicate n $ haskellType t SimpleType t -> fromMaybe (conT . mkName $ t) $ Map.lookup t haskellTypes data FunctionData = FunctionData { apiName :: String, ccName :: Name, async :: Bool, names :: [Name], types :: [Type], returnType :: NeovimType } deriving (Eq, Show) functionData :: NeovimFunction -> Q FunctionData functionData (NeovimFunction name parameters _ async returnType) = do names <- traverse newName prefixedNames types <- traverse haskellType (fst <$> parameters) return (FunctionData name (mkName . camelcase $ name) async names types returnType) where prefix i n = "arg" <> show i <> "_" <> n prefixedNames = zipWith prefix [0 :: Int ..] (snd <$> parameters) generateFromApi :: (FunctionData -> Q [Dec]) -> (Name -> Int64 -> DecsQ) -> Q [Dec] generateFromApi handleFunction handleExtType = do api <- either (fail . show) return =<< runIO parseAPI funcs <- traverse functionData (functions api) funcDecs <- traverse handleFunction funcs tpeDecs <- traverse (uncurry handleExtType) $ first mkName <$> customTypes api return $ join (funcDecs <> tpeDecs)