implement selective instance codegen for purescript backend

3 files changed, 28 insertions, 6 deletions

diff --git a/ddl/Generate.hs b/ddl/Generate.hs
index b276324..855406f 100644
--- a/ddl/Generate.hs
+++ b/ddl/Generate.hs
@@ -21,8 +21,10 @@ import Language
 instance Unquote [Field]
 instance Unquote [Char]
 instance Quote [Char]
+instance Quote [Instance]
 instance Unquote DataDef
 instance Unquote Type
+instance Unquote [(Target,Instance)]
 
 main :: IO ()
 main = do
@@ -60,6 +62,8 @@ main = do
                 , "javaType"        @: javaType aliasMap
                 , "swiftType"       @: swiftType aliasMap
                 , "hasEnumConstructor" @: hasEnumConstructor
+                , "psInstances"     @: filterInstances PureScript
+                , "hsInstances"     @: filterInstances Haskell
                 ]
 
             toPath a = flip map a $ \case
diff --git a/ddl/Language.hs b/ddl/Language.hs
index be684db..9701023 100644
--- a/ddl/Language.hs
+++ b/ddl/Language.hs
@@ -26,7 +26,7 @@ data DataDef
   = DataDef
   { dataName      :: String
   , constructors  :: [ConstructorDef]
-  , instances     :: [Instance]
+  , instances     :: [(Target,Instance)]
   }
   | TypeAlias
   { aliasName     :: String
@@ -59,7 +59,7 @@ data Target
   | PureScript
   | Cpp
   | CSharp
-  deriving (Show,Generic)
+  deriving (Show,Eq,Generic)
 
 data Type
   = Int
@@ -81,6 +81,9 @@ data Type
   | Data { name_ :: String }
   deriving (Show,Generic,Eq,Ord)
 
+filterInstances :: Target -> [(Target,Instance)] -> [Instance]
+filterInstances target l = [inst | (t,inst) <- l, t == target]
+
 hasEnumConstructor :: DataDef -> Bool
 hasEnumConstructor DataDef{..} = or [null fields | ConstructorDef{..} <- constructors]
 hasEnumConstructor _ = False
@@ -359,16 +362,18 @@ instance ToJSON DataDef
 instance ToJSON Instance
 instance ToJSON Field
 instance ToJSON Type
+instance ToJSON Target
 
 instance FromJSON ConstructorDef
 instance FromJSON DataDef
 instance FromJSON Instance
 instance FromJSON Field
 instance FromJSON Type
+instance FromJSON Target
 
 type MDef = Writer [ModuleDef]
 type DDef = Writer ([DataDef],[String])
-type CDef = Writer ([ConstructorDef],[Instance])
+type CDef = Writer ([ConstructorDef],[(Target,Instance)])
 
 module_ :: String -> DDef () -> MDef ()
 module_ n m = tell [let (d,i) = execWriter m in ModuleDef n i d]
@@ -394,7 +399,7 @@ instance IsField Type where
   toField a = Field "" a
 
 deriving_ :: [Target] -> [Instance] -> CDef ()
-deriving_ t l = tell (mempty,l)
+deriving_ targets instances = tell (mempty,[(t,i) | i <- instances, t <- targets])
 
 const_ :: String -> [Type] -> CDef ()
 const_ n t = tell ([ConstructorDef n [Field a b | Field a b <- map toField t]],mempty)
diff --git a/ddl/templates/data.purs.ede b/ddl/templates/data.purs.ede
index f8b3e5d..2374c1d 100644
--- a/ddl/templates/data.purs.ede
+++ b/ddl/templates/data.purs.ede
@@ -39,11 +39,24 @@ type {{ t.value.aliasName }} = {{ t.value.aliasType | psType }}
 
 {% endcase %}
 {% endfor %}
-{% for t in definitions %}{% let l = t.value.instances | length %}{% if l > 0 %}{# FIXME!!! #}
+{% for t in definitions %}
+{% let l = t.value.instances | psInstances %}
+{% for i in l %}
+{% if i.first %}
+
 derive instance generic{{ t.value.dataName }} :: Generic {{ t.value.dataName }}
+{% endif %}
+{% case i.value %}
+{% when "Show" %}
 instance show{{ t.value.dataName }} :: Show {{ t.value.dataName }} where show = gShow
+{% when "Eq" %}
 instance eq{{ t.value.dataName }}   :: Eq {{ t.value.dataName }}   where eq = gEq
-{% endif %}{% endlet %}{% endfor %}
+{% else %}
+-- FIXME: {{ i.value }} instance is not supported!
+{% endcase %}
+{% endfor %}
+{% endlet %}
+{% endfor %}
 
 {# JSON Encode and Decode #}
 {% for t in definitions %}