{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module OCaml.BuckleScript.Internal.Module
(
OCamlModule
, OCamlSubModule
, OCamlTypeInFile
, HaskellTypeName
, EmbeddedOCamlFiles (..)
, HasOCamlType (..)
, HasEmbeddedFile (..)
) where
import Data.Monoid ((<>))
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable, typeRep, typeRepTyCon, tyConName, splitTyConApp)
import GHC.TypeLits (Nat, Symbol, KnownSymbol, symbolVal)
import Data.ByteString (ByteString)
import qualified Data.Map.Strict as Map
import Data.FileEmbed (embedFile)
import System.FilePath.Posix ((<.>))
import OCaml.Internal.Common hiding ((</>))
import OCaml.BuckleScript.Decode
import OCaml.BuckleScript.Encode
import OCaml.BuckleScript.Record
import OCaml.BuckleScript.Spec
import OCaml.BuckleScript.Types
import Servant.API ((:>), (:<|>))
import Language.Haskell.TH
import Language.Haskell.TH.Syntax (addDependentFile)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
data OCamlModule (modules :: [Symbol])
deriving Typeable
data OCamlSubModule (subModules :: Symbol)
deriving Typeable
data OCamlTypeInFile a (filePath :: Symbol)
deriving Typeable
data HaskellTypeName (name :: Symbol) a
data EmbeddedOCamlFiles =
EmbeddedOCamlFiles
{ eocDeclaration :: ByteString
, eocInterface :: Maybe ByteString
, eocSpec :: Maybe ByteString
} deriving (Show)
class HasOCamlType api where
mkType :: Proxy api -> Options -> Bool -> Map.Map String EmbeddedOCamlFiles -> [Text]
mkInterface :: Proxy api -> Options -> Map.Map String EmbeddedOCamlFiles -> [Text]
mkSpec :: Proxy api -> Options -> [Text] -> Maybe Text -> Text -> Map.Map String EmbeddedOCamlFiles -> [Text]
instance (HasOCamlTypeFlag a ~ flag, HasOCamlType' flag (a :: *)) => HasOCamlType a where
mkType = mkType' (Proxy :: Proxy flag)
mkInterface = mkInterface' (Proxy :: Proxy flag)
mkSpec = mkSpec' (Proxy :: Proxy flag)
type family (HasOCamlTypeFlag a) :: Nat where
HasOCamlTypeFlag (OCamlSubModule a :> b) = 4
HasOCamlTypeFlag (a :> b) = 3
HasOCamlTypeFlag (HaskellTypeName a (OCamlTypeInFile b c)) = 2
HasOCamlTypeFlag (OCamlTypeInFile a b) = 2
HasOCamlTypeFlag a = 1
class HasOCamlType' (flag :: Nat) api where
mkType' :: Proxy flag -> Proxy api -> Options -> Bool -> Map.Map String EmbeddedOCamlFiles -> [Text]
mkInterface' :: Proxy flag -> Proxy api -> Options -> Map.Map String EmbeddedOCamlFiles -> [Text]
mkSpec' :: Proxy flag -> Proxy api -> Options -> [Text] -> Maybe Text -> Text -> Map.Map String EmbeddedOCamlFiles -> [Text]
instance (KnownSymbol subModule, HasOCamlType b) => HasOCamlType' 4 (OCamlSubModule subModule :> b) where
mkType' _ Proxy options interface fileMap = ["module " <> (T.pack $ symbolVal (Proxy :: Proxy subModule)) <> " = struct\n"] <> (mkType (Proxy :: Proxy b) options interface fileMap) <> ["\nend"]
mkInterface' _ Proxy options fileMap = ["module " <> (T.pack $ symbolVal (Proxy :: Proxy subModule)) <> " : sig\n"] <> (mkInterface (Proxy :: Proxy b) options fileMap) <> ["\nend"]
mkSpec' _ Proxy options modules url goldendir fileMap = mkSpec (Proxy :: Proxy b) options modules url goldendir fileMap
instance (HasOCamlType a, HasOCamlType b) => HasOCamlType' 3 (a :> b) where
mkType' _ Proxy options interface fileMap = (mkType (Proxy :: Proxy a) options interface fileMap) <> (mkType (Proxy :: Proxy b) options interface fileMap)
mkInterface' _ Proxy options fileMap = (mkInterface (Proxy :: Proxy a) options fileMap) <> (mkInterface (Proxy :: Proxy b) options fileMap)
mkSpec' _ Proxy options modules url goldendir fileMap = (mkSpec (Proxy :: Proxy a) options modules url goldendir fileMap) <> (mkSpec (Proxy :: Proxy b) options modules url goldendir fileMap)
instance (HasOCamlType (OCamlTypeInFile a b)) => HasOCamlType' 2 (HaskellTypeName typSymbol (OCamlTypeInFile a b)) where
mkType' _ Proxy options interface fileMap = (mkType (Proxy :: Proxy (OCamlTypeInFile a b)) options interface fileMap)
mkInterface' _ Proxy options fileMap = (mkInterface (Proxy :: Proxy (OCamlTypeInFile a b)) options fileMap)
mkSpec' _ Proxy options modules url goldendir fileMap = (mkSpec (Proxy :: Proxy (OCamlTypeInFile a b)) options modules url goldendir fileMap)
instance (OCamlType a, Typeable a) => HasOCamlType' 2 (OCamlTypeInFile a b) where
mkType' _ Proxy _options _ fileMap = do
let typeName = tyConName . typeRepTyCon $ typeRep (Proxy :: Proxy a)
case eocDeclaration <$> Map.lookup typeName fileMap of
Just v -> [decodeUtf8 v]
_ -> fail $ "Unable to find the embedded file for " ++ typeName
mkInterface' _ Proxy _options fileMap = do
let typeName = tyConName . typeRepTyCon $ typeRep (Proxy :: Proxy a)
case eocInterface <$> Map.lookup typeName fileMap of
Just (Just v) -> [decodeUtf8 v]
_ -> fail $ "Unable to find the embedded file for " ++ typeName
mkSpec' _ Proxy _options modules url goldendir _fileMap =
[typeInFileToOCamlSpec (Proxy :: Proxy a) typeParameterRefCount modules url goldendir]
where
parameters = fmap show . snd . splitTyConApp $ typeRep (Proxy :: Proxy a)
inParameters = flip elem parameters
xs =
[ inParameters "TypeParameterRef0"
, inParameters "TypeParameterRef1"
, inParameters "TypeParameterRef2"
, inParameters "TypeParameterRef3"
, inParameters "TypeParameterRef4"
, inParameters "TypeParameterRef5"
, inParameters "TypeParameterRef6"
]
countTrues = foldl (flip ((+) . fromEnum)) 0
typeParameterRefCount = countTrues xs
instance (OCamlType a) => HasOCamlType' 1 a where
mkType' _ a options interface _ = body
where
body = [(toOCamlTypeSourceWith options a)
, (toOCamlEncoderSourceWith (options {includeOCamlInterface = interface}) a)
, (toOCamlDecoderSourceWith (options {includeOCamlInterface = interface}) a)]
mkInterface' _ a options _ = body
where
body = [(toOCamlTypeSourceWith options a)
, (toOCamlEncoderInterfaceWith options a)
, (toOCamlDecoderInterfaceWith options a)]
mkSpec' _ a _options modules url goldendir _ = [toOCamlSpec a modules url goldendir]
class HasEmbeddedFile api where
mkFiles :: Bool -> Bool -> Proxy api -> Q Exp
instance (HasEmbeddedFile' api) => HasEmbeddedFile api where
mkFiles includeInterface includeSpec Proxy = ListE <$> mkFiles' includeInterface includeSpec (Proxy :: Proxy api)
class HasEmbeddedFile' api where
mkFiles' :: Bool -> Bool -> Proxy api -> Q [Exp]
instance (HasEmbeddedFileFlag a ~ flag, HasEmbeddedFile'' flag (a :: *)) => HasEmbeddedFile' a where
mkFiles' = mkFiles'' (Proxy :: Proxy flag)
type family (HasEmbeddedFileFlag a) :: Nat where
HasEmbeddedFileFlag (a :<|> b) = 5
HasEmbeddedFileFlag (a :> b) = 4
HasEmbeddedFileFlag (HaskellTypeName a (OCamlTypeInFile b c)) = 3
HasEmbeddedFileFlag (OCamlTypeInFile b c) = 2
HasEmbeddedFileFlag a = 1
class HasEmbeddedFile'' (flag :: Nat) api where
mkFiles'' :: Proxy flag -> Bool -> Bool -> Proxy api -> Q [Exp]
instance (HasEmbeddedFile' a, HasEmbeddedFile' b) => HasEmbeddedFile'' 5 (a :<|> b) where
mkFiles'' _ includeInterface includeSpec Proxy =
(<>) <$> mkFiles' includeInterface includeSpec (Proxy :: Proxy a)
<*> mkFiles' includeInterface includeSpec (Proxy :: Proxy b)
instance (HasEmbeddedFile' a, HasEmbeddedFile' b) => HasEmbeddedFile'' 4 (a :> b) where
mkFiles'' _ includeInterface includeSpec Proxy =
(<>) <$> mkFiles' includeInterface includeSpec (Proxy :: Proxy a)
<*> mkFiles' includeInterface includeSpec (Proxy :: Proxy b)
instance (HasEmbeddedFile' (OCamlTypeInFile a b)) => HasEmbeddedFile'' 3 (HaskellTypeName typSymbol (OCamlTypeInFile a b)) where
mkFiles'' _ includeInterface includeSpec Proxy =
mkFiles' includeInterface includeSpec (Proxy :: Proxy (OCamlTypeInFile a b))
instance (Typeable a, KnownSymbol b) => HasEmbeddedFile'' 2 (OCamlTypeInFile a b) where
mkFiles'' _ includeInterface includeSpec Proxy = do
let typeFilePath = symbolVal (Proxy :: Proxy b)
let typeName = tyConName . typeRepTyCon $ typeRep (Proxy :: Proxy a)
addDependentFile (typeFilePath <.> "ml")
ml <- embedFile (typeFilePath <.> "ml")
mli <- if includeInterface
then do
addDependentFile (typeFilePath <.> "mli")
(\f -> AppE (ConE $ mkName "Just") f) <$> embedFile (typeFilePath <.> "mli")
else pure $ ConE $ mkName "Nothing"
spec <- if includeSpec
then do
addDependentFile (typeFilePath <> "_spec" <.> "ml")
(\f -> AppE (ConE $ mkName "Just") f) <$> embedFile (typeFilePath <> "_spec" <.> "ml")
else pure $ ConE $ mkName "Nothing"
pure [TupE [LitE $ StringL typeName, AppE (AppE (AppE (ConE $ mkName "EmbeddedOCamlFiles") ml) mli) spec]]
instance HasEmbeddedFile'' 1 a where
mkFiles'' _ _ _ Proxy = pure []