From aa2ac80cf90bf654da3cd7d7af8441927ef825f5 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Wed, 13 May 2020 11:47:24 +0100
Subject: [PATCH] simplify predicate template

---
 definitions/src/Predicate.hs                | 36 ++++++++++-----------
 definitions/src/Simplex/Messaging/Client.hs |  8 +++++
 2 files changed, 26 insertions(+), 18 deletions(-)

diff --git a/definitions/src/Predicate.hs b/definitions/src/Predicate.hs
index 9564e53d34..a3f800b81a 100644
--- a/definitions/src/Predicate.hs
+++ b/definitions/src/Predicate.hs
@@ -1,6 +1,11 @@
+{-# LANGUAGE TemplateHaskell #-}
+
 module Predicate where
 
 import ClassyPrelude
+import Data.Type.Predicate
+import Data.Type.Predicate.Auto
+import Language.Haskell.TH.Lib
 import Language.Haskell.TH.Syntax
 
 -- This template adds instances of Auto typeclass (from decidable package)
@@ -24,23 +29,18 @@ import Language.Haskell.TH.Syntax
 -- to be used in type constraints
 
 predicate :: Q [Dec] -> Q [Dec]
-predicate decls = mconcat . map mkInstances <$> decls
+predicate decls = concat <$> (decls >>= mapM addInstances)
   where
-    mkInstances :: Dec -> [Dec]
-    mkInstances d@(DataD _ tName _ _ constructors _) =
-      d : mapMaybe (mkInstance tName) constructors
-    mkInstances d = [d]
+    addInstances :: Dec -> Q [Dec]
+    addInstances d@(DataD _ ty _ _ constructors _) = do
+      ds <- mapM (mkInstance ty) constructors
+      return $ d : concat ds
+    addInstances d = return [d]
 
-    mkInstance :: Name -> Con -> Maybe InstanceDec
-    mkInstance tName (GadtC [cName] [] (AppT _ pType)) =
-      let tyCon name = AppT (ConT (mkName name))
-          ty =  AppT
-                  (tyCon "Auto"
-                    (tyCon "TyPred"
-                      (ConT tName)))
-                  pType
-          ds =  [ValD
-                  (VarP (mkName "auto"))
-                  (NormalB (ConE cName)) []]
-      in Just $ InstanceD Nothing [] ty ds
-    mkInstance _ _ = Nothing
+    mkInstance :: Name -> Con -> Q [Dec]
+    mkInstance ty (GadtC [con] [] (AppT _ (PromotedT p))) =
+      [d|
+        instance Auto (TyPred $(conT ty)) $(promotedT p) where
+          auto = $(conE con)
+        |]
+    mkInstance _ _ = return []
diff --git a/definitions/src/Simplex/Messaging/Client.hs b/definitions/src/Simplex/Messaging/Client.hs
index fa00879565..6abc3b8569 100644
--- a/definitions/src/Simplex/Messaging/Client.hs
+++ b/definitions/src/Simplex/Messaging/Client.hs
@@ -16,6 +16,14 @@ import Simplex.Messaging.Protocol
 import Simplex.Messaging.Types
 
 
+-- $(protocol Recipient [d|
+--   raCreateConn  :: (--> Broker) CreateConn
+--   raSubscribe   :: (--> Broker) Subscribe
+--   rcPushConfirm :: (<-- Broker) PushConfirm
+--   rcPushMsg     :: (<-- Broker) PushMsg
+--   ...
+--   |]
+
 instance Prf HasState Sender s
          => ProtocolAction Recipient
               Broker