Skip to content
Snippets Groups Projects
Commit 3704a6e6 authored by Jens Nolte's avatar Jens Nolte
Browse files

Fix generated instances

parent 2894e3de
No related branches found
No related tags found
No related merge requests found
...@@ -64,12 +64,12 @@ interfaceDec interface = execWriterT do ...@@ -64,12 +64,12 @@ interfaceDec interface = execWriterT do
when (length interface.requests > 0) do when (length interface.requests > 0) do
tellQ $ dataD (pure []) rTypeName [] Nothing (rCon <$> interface.requests) [] tellQ $ dataD (pure []) rTypeName [] Nothing (rCon <$> interface.requests) []
tellQ $ messageInstanceD ((\req@(RequestSpec msg) -> (msg, rConName req)) <$> interface.requests) tellQ $ messageInstanceD rT ((\req@(RequestSpec msg) -> (msg, rConName req)) <$> interface.requests)
tellQs $ binaryInstanceD rT tellQs $ binaryInstanceD rT
when (length interface.events > 0) do when (length interface.events > 0) do
tellQ $ dataD (pure []) eTypeName [] Nothing (eCon <$> interface.events) [] tellQ $ dataD (pure []) eTypeName [] Nothing (eCon <$> interface.events) []
tellQ $ messageInstanceD ((\ev@(EventSpec msg) -> (msg, eConName ev)) <$> interface.events) tellQ $ messageInstanceD eT ((\ev@(EventSpec msg) -> (msg, eConName ev)) <$> interface.events)
tellQs $ binaryInstanceD eT tellQs $ binaryInstanceD eT
where where
...@@ -77,8 +77,8 @@ interfaceDec interface = execWriterT do ...@@ -77,8 +77,8 @@ interfaceDec interface = execWriterT do
iT = interfaceT interface iT = interfaceT interface
instanceDecs = [ instanceDecs = [
valD (varP 'interfaceName) (normalB (stringE interface.name)) [], valD (varP 'interfaceName) (normalB (stringE interface.name)) [],
tySynInstD (tySynEqn Nothing (appT (conT ''TRequest) iT) rT), tySynInstD (tySynEqn Nothing (appT (conT ''Request) iT) rT),
tySynInstD (tySynEqn Nothing (appT (conT ''TEvent) iT) eT) tySynInstD (tySynEqn Nothing (appT (conT ''Event) iT) eT)
] ]
rT :: Q Type rT :: Q Type
rT = if length interface.requests > 0 then conT rTypeName else [t|Void|] rT = if length interface.requests > 0 then conT rTypeName else [t|Void|]
...@@ -96,8 +96,8 @@ interfaceDec interface = execWriterT do ...@@ -96,8 +96,8 @@ interfaceDec interface = execWriterT do
eConName (EventSpec event) = mkName $ "E_" <> interface.name <> "_" <> event.name eConName (EventSpec event) = mkName $ "E_" <> interface.name <> "_" <> event.name
eCon :: EventSpec -> Q Con eCon :: EventSpec -> Q Con
eCon event = normalC (eConName event) [] eCon event = normalC (eConName event) []
messageInstanceD :: [(MessageSpec, Name)] -> Q Dec messageInstanceD :: Q Type -> [(MessageSpec, Name)] -> Q Dec
messageInstanceD messages = instanceD (pure []) [t|IsMessage $rT|] messageNameD messageInstanceD t messages = instanceD (pure []) [t|IsMessage $t|] messageNameD
where where
messageNameD :: [Q Dec] messageNameD :: [Q Dec]
messageNameD = messageNameD =
...@@ -135,7 +135,7 @@ parseInterface :: MonadFail m => Element -> m InterfaceSpec ...@@ -135,7 +135,7 @@ parseInterface :: MonadFail m => Element -> m InterfaceSpec
parseInterface element = do parseInterface element = do
name <- getAttr "name" element name <- getAttr "name" element
requests <- mapM parseRequest $ zip [0..] $ findChildren (qname "request") element requests <- mapM parseRequest $ zip [0..] $ findChildren (qname "request") element
events <- mapM parseEvent $ zip [0..] $ findChildren (qname "events") element events <- mapM parseEvent $ zip [0..] $ findChildren (qname "event") element
pure InterfaceSpec { pure InterfaceSpec {
name, name,
requests, requests,
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment