{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
module OCaml.BuckleScript.Types
( OCamlDatatype (..)
, OCamlPrimitive (..)
, OCamlConstructor (..)
, ValueConstructor (..)
, EnumeratorConstructor (..)
, OCamlValue (..)
, OCamlType (..)
, HaskellTypeMetaData (..)
, OCamlTypeMetaData (..)
, typeableToOCamlType
, TypeParameterRef0(..)
, TypeParameterRef1(..)
, TypeParameterRef2(..)
, TypeParameterRef3(..)
, TypeParameterRef4(..)
, TypeParameterRef5(..)
, getTypeParameterRefNames
, getOCamlValues
, getTypeParameters
, isTypeParameterRef
, mkModulePrefix
, oCamlValueIsFloat
, typeRepToHaskellTypeMetaData
, tyConToHaskellTypeMetaData
) where
import Data.Int (Int16, Int32, Int64, Int8)
import Data.List (nub)
import Data.Maybe (catMaybes)
import Data.Monoid ((<>))
import Data.Proxy
import Data.Time
import Data.Typeable
import Data.Word (Word, Word8, Word16, Word32, Word64)
import GHC.Generics
import GHC.TypeLits (symbolVal, KnownSymbol)
import Prelude
import qualified Data.Map as Map
import Data.Aeson (ToJSON, FromJSON)
import Data.ByteString (ByteString)
import Data.Text (Text)
import qualified Data.Text as T
import Test.QuickCheck
import Test.QuickCheck.Arbitrary.ADT
data OCamlDatatype
= OCamlDatatype HaskellTypeMetaData Text OCamlConstructor
| OCamlPrimitive OCamlPrimitive
deriving (Show, Eq)
data HaskellTypeMetaData =
HaskellTypeMetaData
Text
Text
Text
deriving (Show, Eq, Ord)
data OCamlTypeMetaData =
OCamlTypeMetaData
Text
[Text]
[Text]
deriving (Show, Eq, Ord)
data OCamlPrimitive
= OBool
| OChar
| ODate
| OFloat
| OInt
| OInt32
| OString
| OUnit
| OList OCamlDatatype
| OOption OCamlDatatype
| OEither OCamlDatatype OCamlDatatype
| OTuple2 OCamlDatatype OCamlDatatype
| OTuple3 OCamlDatatype OCamlDatatype OCamlDatatype
| OTuple4 OCamlDatatype OCamlDatatype OCamlDatatype OCamlDatatype
| OTuple5 OCamlDatatype OCamlDatatype OCamlDatatype OCamlDatatype OCamlDatatype
| OTuple6 OCamlDatatype OCamlDatatype OCamlDatatype OCamlDatatype OCamlDatatype OCamlDatatype
deriving (Show, Eq)
data OCamlConstructor
= OCamlValueConstructor ValueConstructor
| OCamlEnumeratorConstructor [EnumeratorConstructor]
| OCamlSumOfRecordConstructor Text ValueConstructor
deriving (Show, Eq)
data ValueConstructor
= NamedConstructor Text OCamlValue
| RecordConstructor Text OCamlValue
| MultipleConstructors [ValueConstructor]
deriving (Show, Eq)
data EnumeratorConstructor
= EnumeratorConstructor Text
deriving (Show, Eq)
data OCamlValue
= OCamlRef HaskellTypeMetaData Text
| OCamlRefApp TypeRep OCamlValue
| OCamlTypeParameterRef Text
| OCamlEmpty
| OCamlPrimitiveRef OCamlPrimitive
| OCamlField Text OCamlValue
| Values OCamlValue OCamlValue
| OCamlRefAppValues OCamlValue OCamlValue
deriving (Show, Eq)
class OCamlType a where
toOCamlType :: a -> OCamlDatatype
toOCamlType = genericToOCamlDatatype . from
default toOCamlType :: (Generic a, GenericOCamlDatatype (Rep a)) =>
a -> OCamlDatatype
class GenericOCamlDatatype f where
genericToOCamlDatatype :: f a -> OCamlDatatype
instance (KnownSymbol typ, KnownSymbol package, KnownSymbol modul, GenericValueConstructor f) => GenericOCamlDatatype (M1 D ('MetaData typ modul package 'False) f) where
genericToOCamlDatatype datatype =
OCamlDatatype
(HaskellTypeMetaData
(T.pack $ symbolVal (Proxy :: Proxy typ))
(T.pack $ symbolVal (Proxy :: Proxy modul))
(T.pack $ symbolVal (Proxy :: Proxy package)))
(T.pack (datatypeName datatype))
(transform (OCamlValueConstructor (genericToValueConstructor (unM1 datatype))))
where
transform ocamlConstructor =
if isEnumeration ocamlConstructor
then transformToEnumeration ocamlConstructor
else
if isSumWithRecord ocamlConstructor
then transformToSumOfRecord (T.pack (datatypeName datatype)) ocamlConstructor
else ocamlConstructor
instance (KnownSymbol typ, KnownSymbol package, KnownSymbol modul, GenericValueConstructor f) => GenericOCamlDatatype (M1 D ('MetaData typ modul package 'True) f) where
genericToOCamlDatatype datatype =
OCamlDatatype
(HaskellTypeMetaData
(T.pack $ symbolVal (Proxy :: Proxy typ))
(T.pack $ symbolVal (Proxy :: Proxy modul))
(T.pack $ symbolVal (Proxy :: Proxy package)))
(T.pack (datatypeName datatype))
(transform (OCamlValueConstructor (genericToValueConstructor (unM1 datatype))))
where
transform ocamlConstructor =
if isEnumeration ocamlConstructor
then transformToEnumeration ocamlConstructor
else
if isSumWithRecord ocamlConstructor
then transformToSumOfRecord (T.pack (datatypeName datatype)) ocamlConstructor
else ocamlConstructor
class GenericValueConstructor f where
genericToValueConstructor :: f a -> ValueConstructor
instance (Constructor c, GenericOCamlValue f) => GenericValueConstructor (C1 c f) where
genericToValueConstructor constructor =
if conIsRecord constructor
then RecordConstructor name (genericToOCamlValue (unM1 constructor))
else NamedConstructor name (genericToOCamlValue (unM1 constructor))
where
name = T.pack $ conName constructor
instance (GenericValueConstructor f, GenericValueConstructor g) =>
GenericValueConstructor (f :+: g) where
genericToValueConstructor _ =
MultipleConstructors
[ genericToValueConstructor (undefined :: f p)
, genericToValueConstructor (undefined :: g p)
]
class GenericOCamlValue f where
genericToOCamlValue :: f a -> OCamlValue
instance (Selector s, GenericOCamlValue a) =>
GenericOCamlValue (S1 s a) where
genericToOCamlValue selector =
case selName selector of
"" -> genericToOCamlValue (undefined :: a p)
name -> OCamlField (T.pack name) (genericToOCamlValue (undefined :: a p))
instance (GenericOCamlValue f, GenericOCamlValue g) =>
GenericOCamlValue (f :*: g) where
genericToOCamlValue _ =
Values
(genericToOCamlValue (undefined :: f p))
(genericToOCamlValue (undefined :: g p))
instance GenericOCamlValue U1 where
genericToOCamlValue _ = OCamlEmpty
instance Typeable a => GenericOCamlValue (Rec0 a) where
genericToOCamlValue _ = typeRepToOCamlValue $ typeRep (Proxy :: Proxy a)
typeRepToOCamlValue :: TypeRep -> OCamlValue
typeRepToOCamlValue t =
case Map.lookup hd typeParameterRefTyConToOCamlTypeText of
Just p -> OCamlTypeParameterRef p
Nothing ->
case primitiveTypeRepToOCamlPrimitive t of
Just primitive -> OCamlPrimitiveRef primitive
Nothing ->
if length typeParams == 0
then mkRef (tyConToHaskellTypeMetaData hd) (T.pack . show $ hd)
else OCamlRefApp t (mkValues)
where
(hd, typeParams) = splitTyConApp t
typeParameterRefs = (T.append) <$> ["a"] <*> (T.pack . show <$> ([0..5] :: [Int]))
mkRef haskellTypeMetaData n =
if n `elem` typeParameterRefs
then OCamlTypeParameterRef n
else OCamlRef haskellTypeMetaData n
mkValues =
if length typeParams == 0
then OCamlEmpty
else
if length typeParams == 1
then typeRepToOCamlValue $ head typeParams
else
if length typeParams == 2
then OCamlRefAppValues (typeRepToOCamlValue $ head typeParams) (typeRepToOCamlValue $ head $ tail typeParams)
else OCamlRefAppValues (typeRepToOCamlValue $ head typeParams) (foldl (\b a -> OCamlRefAppValues b (typeRepToOCamlValue a)) (typeRepToOCamlValue $ head $ tail typeParams) (tail $ tail typeParams))
primitiveTypeRepToOCamlPrimitive :: TypeRep -> Maybe OCamlPrimitive
primitiveTypeRepToOCamlPrimitive t =
mkOCamlPrimitive $ length typeParams
where
(hd, typeParams) = splitTyConApp t
mkOCamlPrimitive l
| l == 0 = Map.lookup hd zero
| l == 1 = one hd (typeParams !! 0)
| l == 2 = two hd (typeParams !! 0) (typeParams !! 1)
| l == 3 = three hd (typeParams !! 0) (typeParams !! 1) (typeParams !! 2)
| l == 4 = four hd (typeParams !! 0) (typeParams !! 1) (typeParams !! 2) (typeParams !! 3)
| l == 5 = five hd (typeParams !! 0) (typeParams !! 1) (typeParams !! 2) (typeParams !! 3) (typeParams !! 4)
| l == 6 = six hd (typeParams !! 0) (typeParams !! 1) (typeParams !! 2) (typeParams !! 3) (typeParams !! 4) (typeParams !! 5)
| otherwise = Nothing
zero :: Map.Map TyCon OCamlPrimitive
zero = Map.fromList
[ ( typeRepTyCon $ typeRep (Proxy :: Proxy Int), OInt)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy Int8), OInt)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy Int16), OInt)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy Int32), OInt32)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy Int64), OInt)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy Integer), OInt)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy Word), OInt)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy Word8), OInt)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy Word16), OInt)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy Word32), OInt)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy Word64), OInt)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy Bool), OBool)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy Char), OChar)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy UTCTime), ODate)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy Float), OFloat)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy Double), OFloat)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy Text), OString)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy ByteString), OString)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy String), OString)
, ( typeRepTyCon $ typeRep (Proxy :: Proxy ()), OUnit)
]
one :: TyCon -> TypeRep -> Maybe OCamlPrimitive
one tyCon t0 =
if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy []))
then Just $ OList $ mkOCamlDatatype t0
else
if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy Maybe))
then Just $ OOption $ mkOCamlDatatype t0
else Nothing
two :: TyCon -> TypeRep -> TypeRep -> Maybe OCamlPrimitive
two tyCon t0 t1 =
if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy Either))
then Just $ OEither (mkOCamlDatatype t0) (mkOCamlDatatype t1)
else
if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy (,)))
then Just $ OTuple2 (mkOCamlDatatype t0) (mkOCamlDatatype t1)
else Nothing
three :: TyCon -> TypeRep -> TypeRep -> TypeRep -> Maybe OCamlPrimitive
three tyCon t0 t1 t2 =
if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy (,,)))
then Just $ OTuple3 (mkOCamlDatatype t0) (mkOCamlDatatype t1) (mkOCamlDatatype t2)
else Nothing
four :: TyCon -> TypeRep -> TypeRep -> TypeRep -> TypeRep -> Maybe OCamlPrimitive
four tyCon t0 t1 t2 t3 =
if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy (,,,)))
then Just $ OTuple4 (mkOCamlDatatype t0) (mkOCamlDatatype t1) (mkOCamlDatatype t2) (mkOCamlDatatype t3)
else Nothing
five :: TyCon -> TypeRep -> TypeRep -> TypeRep -> TypeRep -> TypeRep -> Maybe OCamlPrimitive
five tyCon t0 t1 t2 t3 t4 =
if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy (,,,,)))
then Just $ OTuple5 (mkOCamlDatatype t0) (mkOCamlDatatype t1) (mkOCamlDatatype t2) (mkOCamlDatatype t3) (mkOCamlDatatype t4)
else Nothing
six :: TyCon -> TypeRep -> TypeRep -> TypeRep -> TypeRep -> TypeRep -> TypeRep -> Maybe OCamlPrimitive
six tyCon t0 t1 t2 t3 t4 t5 =
if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy (,,,,,)))
then Just $ OTuple6 (mkOCamlDatatype t0) (mkOCamlDatatype t1) (mkOCamlDatatype t2) (mkOCamlDatatype t3) (mkOCamlDatatype t4) (mkOCamlDatatype t5)
else Nothing
typeParameterRefMap = Map.fromList
[ ("TypeParameterRef0", toOCamlType (Proxy :: Proxy TypeParameterRef0))
, ("TypeParameterRef1", toOCamlType (Proxy :: Proxy TypeParameterRef1))
, ("TypeParameterRef2", toOCamlType (Proxy :: Proxy TypeParameterRef2))
, ("TypeParameterRef3", toOCamlType (Proxy :: Proxy TypeParameterRef3))
, ("TypeParameterRef4", toOCamlType (Proxy :: Proxy TypeParameterRef4))
, ("TypeParameterRef5", toOCamlType (Proxy :: Proxy TypeParameterRef5))
]
mkOCamlDatatype x =
case primitiveTypeRepToOCamlPrimitive x of
Just primitive -> OCamlPrimitive primitive
Nothing ->
case Map.lookup aTyConName typeParameterRefMap of
Just tref -> tref
Nothing ->
OCamlDatatype
(tyConToHaskellTypeMetaData tyc)
aTyConName
(OCamlValueConstructor . NamedConstructor aTyConName $ typeRepToOCamlValue x)
where
tyc = typeRepTyCon x
aTyConName = T.pack . show $ tyc
instance OCamlType a => OCamlType [a] where
toOCamlType _ = OCamlPrimitive (OList (toOCamlType (Proxy :: Proxy a)))
instance OCamlType a => OCamlType (Maybe a) where
toOCamlType _ = OCamlPrimitive (OOption (toOCamlType (Proxy :: Proxy a)))
instance (OCamlType l, OCamlType r) => OCamlType (Either l r) where
toOCamlType _ = OCamlPrimitive (OEither (toOCamlType (Proxy :: Proxy l)) (toOCamlType (Proxy :: Proxy r)))
instance OCamlType () where
toOCamlType _ = OCamlPrimitive OUnit
instance OCamlType Text where
toOCamlType _ = OCamlPrimitive OString
instance OCamlType ByteString where
toOCamlType _ = OCamlPrimitive OString
instance OCamlType Day where
toOCamlType _ = OCamlPrimitive ODate
instance OCamlType UTCTime where
toOCamlType _ = OCamlPrimitive ODate
instance OCamlType Float where
toOCamlType _ = OCamlPrimitive OFloat
instance OCamlType Double where
toOCamlType _ = OCamlPrimitive OFloat
instance OCamlType Int8 where
toOCamlType _ = OCamlPrimitive OInt
instance OCamlType Int16 where
toOCamlType _ = OCamlPrimitive OInt
instance OCamlType Int32 where
toOCamlType _ = OCamlPrimitive OInt32
instance OCamlType Int64 where
toOCamlType _ = OCamlPrimitive OInt
instance OCamlType Word where
toOCamlType _ = OCamlPrimitive OInt
instance OCamlType Word8 where
toOCamlType _ = OCamlPrimitive OInt
instance OCamlType Word16 where
toOCamlType _ = OCamlPrimitive OInt
instance OCamlType Word32 where
toOCamlType _ = OCamlPrimitive OInt
instance OCamlType Word64 where
toOCamlType _ = OCamlPrimitive OInt
instance OCamlType Int where
toOCamlType _ = OCamlPrimitive OInt
instance OCamlType Integer where
toOCamlType _ = OCamlPrimitive OInt
instance OCamlType Char where
toOCamlType _ = OCamlPrimitive OChar
instance OCamlType Bool where
toOCamlType _ = OCamlPrimitive OBool
instance (OCamlType a, OCamlType b) => OCamlType (a, b) where
toOCamlType _ =
OCamlPrimitive $
OTuple2 (toOCamlType (Proxy :: Proxy a)) (toOCamlType (Proxy :: Proxy b))
instance (OCamlType a, OCamlType b, OCamlType c) => OCamlType (a, b, c) where
toOCamlType _ =
OCamlPrimitive $
OTuple3 (toOCamlType (Proxy :: Proxy a)) (toOCamlType (Proxy :: Proxy b))
(toOCamlType (Proxy :: Proxy c))
instance (OCamlType a, OCamlType b, OCamlType c, OCamlType d) => OCamlType (a, b, c, d) where
toOCamlType _ =
OCamlPrimitive $
OTuple4 (toOCamlType (Proxy :: Proxy a)) (toOCamlType (Proxy :: Proxy b))
(toOCamlType (Proxy :: Proxy c)) (toOCamlType (Proxy :: Proxy d))
instance (OCamlType a, OCamlType b, OCamlType c, OCamlType d, OCamlType e) => OCamlType (a, b, c, d, e) where
toOCamlType _ =
OCamlPrimitive $
OTuple5 (toOCamlType (Proxy :: Proxy a)) (toOCamlType (Proxy :: Proxy b))
(toOCamlType (Proxy :: Proxy c)) (toOCamlType (Proxy :: Proxy d))
(toOCamlType (Proxy :: Proxy e))
instance (OCamlType a, OCamlType b, OCamlType c, OCamlType d, OCamlType e, OCamlType f) => OCamlType (a, b, c, d, e, f) where
toOCamlType _ =
OCamlPrimitive $
OTuple6 (toOCamlType (Proxy :: Proxy a)) (toOCamlType (Proxy :: Proxy b))
(toOCamlType (Proxy :: Proxy c)) (toOCamlType (Proxy :: Proxy d))
(toOCamlType (Proxy :: Proxy e)) (toOCamlType (Proxy :: Proxy f))
instance (OCamlType a) =>
OCamlType (Proxy a) where
toOCamlType _ = toOCamlType (undefined :: a)
typeableToOCamlType :: forall a. Typeable a => Proxy a -> OCamlDatatype
typeableToOCamlType Proxy =
OCamlDatatype
(HaskellTypeMetaData aTyConName aTyConModule aTyConPackage)
aTyConName
(OCamlValueConstructor . NamedConstructor aTyConName $ OCamlEmpty)
where
aTyCon = typeRepTyCon $ typeRep (Proxy :: Proxy a)
aTyConName = T.pack . tyConName $ aTyCon
aTyConModule = T.pack . tyConModule $ aTyCon
aTyConPackage = T.pack . tyConPackage $ aTyCon
newtype TypeParameterRef0 = TypeParameterRef0 Int deriving (Read, Show, Eq, Generic)
instance Arbitrary TypeParameterRef0 where arbitrary = TypeParameterRef0 <$> arbitrary
instance ToADTArbitrary TypeParameterRef0
instance FromJSON TypeParameterRef0
instance ToJSON TypeParameterRef0
instance OCamlType TypeParameterRef0 where
toOCamlType _ = OCamlDatatype (HaskellTypeMetaData "a0" "OCaml.BuckleScript.Types" "ocaml-export") "a0" $ OCamlValueConstructor $ NamedConstructor "a0" $ OCamlTypeParameterRef "a0"
newtype TypeParameterRef1 = TypeParameterRef1 Int deriving (Read, Show, Eq, Generic)
instance Arbitrary TypeParameterRef1 where arbitrary = TypeParameterRef1 <$> arbitrary
instance ToADTArbitrary TypeParameterRef1
instance FromJSON TypeParameterRef1
instance ToJSON TypeParameterRef1
instance OCamlType TypeParameterRef1 where
toOCamlType _ = OCamlDatatype (HaskellTypeMetaData "a1" "OCaml.BuckleScript.Types" "ocaml-export") "a1" $ OCamlValueConstructor $ NamedConstructor "a1" $ OCamlTypeParameterRef "a1"
data TypeParameterRef2 = TypeParameterRef2 Int deriving (Read, Show, Eq, Generic)
instance Arbitrary TypeParameterRef2 where arbitrary = TypeParameterRef2 <$> arbitrary
instance ToADTArbitrary TypeParameterRef2
instance FromJSON TypeParameterRef2
instance ToJSON TypeParameterRef2
instance OCamlType TypeParameterRef2 where
toOCamlType _ = OCamlDatatype (HaskellTypeMetaData "a2" "OCaml.BuckleScript.Types" "ocaml-export") "a2" $ OCamlValueConstructor $ NamedConstructor "a2" $ OCamlTypeParameterRef "a2"
data TypeParameterRef3 = TypeParameterRef3 Int deriving (Read, Show, Eq, Generic)
instance Arbitrary TypeParameterRef3 where arbitrary = TypeParameterRef3 <$> arbitrary
instance ToADTArbitrary TypeParameterRef3
instance FromJSON TypeParameterRef3
instance ToJSON TypeParameterRef3
instance OCamlType TypeParameterRef3 where
toOCamlType _ = OCamlDatatype (HaskellTypeMetaData "a3" "OCaml.BuckleScript.Types" "ocaml-export") "a3" $ OCamlValueConstructor $ NamedConstructor "a3" $ OCamlTypeParameterRef "a3"
data TypeParameterRef4 = TypeParameterRef4 Int deriving (Read, Show, Eq, Generic)
instance Arbitrary TypeParameterRef4 where arbitrary = TypeParameterRef4 <$> arbitrary
instance ToADTArbitrary TypeParameterRef4
instance FromJSON TypeParameterRef4
instance ToJSON TypeParameterRef4
instance OCamlType TypeParameterRef4 where
toOCamlType _ = OCamlDatatype (HaskellTypeMetaData "a4" "OCaml.BuckleScript.Types" "ocaml-export") "a4" $ OCamlValueConstructor $ NamedConstructor "a4" $ OCamlTypeParameterRef "a4"
data TypeParameterRef5 = TypeParameterRef5 Int deriving (Read, Show, Eq, Generic)
instance Arbitrary TypeParameterRef5 where arbitrary = TypeParameterRef5 <$> arbitrary
instance ToADTArbitrary TypeParameterRef5
instance FromJSON TypeParameterRef5
instance ToJSON TypeParameterRef5
instance OCamlType TypeParameterRef5 where
toOCamlType _ = OCamlDatatype (HaskellTypeMetaData "a5" "OCaml.BuckleScript.Types" "ocaml-export") "a5" $ OCamlValueConstructor $ NamedConstructor "a5" $ OCamlTypeParameterRef "a5"
isEnumeration :: OCamlConstructor -> Bool
isEnumeration (OCamlValueConstructor (NamedConstructor _ OCamlEmpty)) = True
isEnumeration (OCamlValueConstructor (MultipleConstructors cs)) = all isEnumeration (OCamlValueConstructor <$> cs)
isEnumeration _ = False
transformToEnumeration :: OCamlConstructor -> OCamlConstructor
transformToEnumeration (OCamlValueConstructor (NamedConstructor name OCamlEmpty)) =
OCamlEnumeratorConstructor [EnumeratorConstructor name]
transformToEnumeration (OCamlValueConstructor (MultipleConstructors cs)) =
OCamlEnumeratorConstructor . concat . catMaybes
$ getEnumeratorConstructor . transformToEnumeration . OCamlValueConstructor
<$> cs
where
getEnumeratorConstructor constructor =
case constructor of
(OCamlEnumeratorConstructor c) -> Just c
_ -> Nothing
transformToEnumeration cs = cs
transformToSumOfRecord :: Text -> OCamlConstructor -> OCamlConstructor
transformToSumOfRecord typeName (OCamlValueConstructor value@(MultipleConstructors _cs)) = OCamlSumOfRecordConstructor typeName value
transformToSumOfRecord _ constructor = constructor
isSumWithRecord :: OCamlConstructor -> Bool
isSumWithRecord (OCamlValueConstructor (MultipleConstructors cs)) =
(\x -> length x > 1 && or x) $ isSumWithRecordsAux . OCamlValueConstructor <$> cs
where
isSumWithRecordsAux :: OCamlConstructor -> Bool
isSumWithRecordsAux (OCamlValueConstructor (MultipleConstructors cs')) = or $ isSumWithRecordsAux . OCamlValueConstructor <$> cs'
isSumWithRecordsAux (OCamlValueConstructor (RecordConstructor _ _)) = True
isSumWithRecordsAux _ = False
isSumWithRecord _ = False
getTypeParameterRefNames :: [OCamlValue] -> [Text]
getTypeParameterRefNames = nub . concat . (fmap match)
where
lift (OCamlDatatype _ _ constructor) = getTypeParameters constructor
lift _ = []
match value =
case value of
(OCamlRefApp typRep _) -> getTypeParameterRefNameForTypeRep typRep
(OCamlTypeParameterRef name) -> [name]
(Values v1 v2) -> match v1 ++ match v2
(OCamlField _ v1) -> match v1
(OCamlPrimitiveRef (OList v1)) -> lift v1
(OCamlPrimitiveRef (OOption v1)) -> lift v1
(OCamlPrimitiveRef (OTuple2 v1 v2)) -> lift v1 ++ lift v2
(OCamlPrimitiveRef (OTuple3 v1 v2 v3)) -> lift v1 ++ lift v2 ++ lift v3
(OCamlPrimitiveRef (OTuple4 v1 v2 v3 v4)) -> lift v1 ++ lift v2 ++ lift v3 ++ lift v4
(OCamlPrimitiveRef (OTuple5 v1 v2 v3 v4 v5)) -> lift v1 ++ lift v2 ++ lift v3 ++ lift v4 ++ lift v5
(OCamlPrimitiveRef (OTuple6 v1 v2 v3 v4 v5 v6)) -> lift v1 ++ lift v2 ++ lift v3 ++ lift v4 ++ lift v5 ++ lift v6
_ -> []
getOCamlValues :: ValueConstructor -> [OCamlValue]
getOCamlValues (NamedConstructor _ value) = [value]
getOCamlValues (RecordConstructor _ value) = [value]
getOCamlValues (MultipleConstructors cs) = concat $ getOCamlValues <$> cs
getTypeParameters :: OCamlConstructor -> [Text]
getTypeParameters (OCamlValueConstructor vc) = getTypeParameterRefNames . getOCamlValues $ vc
getTypeParameters (OCamlSumOfRecordConstructor _ vc) = getTypeParameterRefNames . getOCamlValues $ vc
getTypeParameters _ = []
isTypeParameterRef :: OCamlDatatype -> Bool
isTypeParameterRef (OCamlDatatype _ _ (OCamlValueConstructor (NamedConstructor _ (OCamlTypeParameterRef _)))) = True
isTypeParameterRef _ = False
getTypeParameterRefNameForTypeRep :: TypeRep -> [Text]
getTypeParameterRefNameForTypeRep t =
if length rst == 0
then typeParamterRefText
else typeParamterRefText <> concat (getTypeParameterRefNameForTypeRep <$> rst)
where
(hd,rst) = splitTyConApp $ t
typeParamterRefText =
case Map.lookup hd typeParameterRefTyConToOCamlTypeText of
Just typeParamterRefText' -> [typeParamterRefText']
Nothing -> []
mkModulePrefix :: OCamlTypeMetaData -> OCamlTypeMetaData -> Text
mkModulePrefix (OCamlTypeMetaData _ decModules decSubModules) (OCamlTypeMetaData _ parModules parSubModules) =
if prefix /= "" then prefix <> "." else ""
where
(l,r) = zipWithRightRemainder (decModules <> decSubModules) (parModules <> parSubModules)
prefix = T.intercalate "." $ (removeMatchingHead l) <> r
removeMatchingHead :: Eq a => [(a,a)] -> [a]
removeMatchingHead [] = []
removeMatchingHead (hd:tl) =
if fst hd == snd hd
then removeMatchingHead tl
else [snd hd] <> (snd <$> tl)
zipWithRightRemainder :: [a] -> [b] -> ([(a,b)], [b])
zipWithRightRemainder [] bs = ([], bs)
zipWithRightRemainder _ab [] = ([], [])
zipWithRightRemainder (a:as) (b:bs) = ([(a,b)], []) <> zipWithRightRemainder as bs
oCamlValueIsFloat :: OCamlValue -> Bool
oCamlValueIsFloat (OCamlPrimitiveRef OFloat) = True
oCamlValueIsFloat _ = False
typeParameterRefTyConToOCamlTypeText :: Map.Map TyCon Text
typeParameterRefTyConToOCamlTypeText = Map.fromList
[ ( typeRepTyCon $ typeRep (Proxy :: Proxy TypeParameterRef0), "a0")
, ( typeRepTyCon $ typeRep (Proxy :: Proxy TypeParameterRef1), "a1")
, ( typeRepTyCon $ typeRep (Proxy :: Proxy TypeParameterRef2), "a2")
, ( typeRepTyCon $ typeRep (Proxy :: Proxy TypeParameterRef3), "a3")
, ( typeRepTyCon $ typeRep (Proxy :: Proxy TypeParameterRef4), "a4")
, ( typeRepTyCon $ typeRep (Proxy :: Proxy TypeParameterRef5), "a5")
]
typeRepToHaskellTypeMetaData :: TypeRep -> HaskellTypeMetaData
typeRepToHaskellTypeMetaData = tyConToHaskellTypeMetaData . typeRepTyCon
tyConToHaskellTypeMetaData :: TyCon -> HaskellTypeMetaData
tyConToHaskellTypeMetaData aTypeCon =
HaskellTypeMetaData
(T.pack . tyConName $ aTypeCon)
(T.pack . tyConModule $ aTypeCon)
(T.pack . tyConPackage $ aTypeCon)