refactor: replace singletons package with ad-hoc singletons pattern

package.yaml

@@ -20,7 +20,6 @@ dependencies:
   - iso8601-time == 0.1.*
   - mtl
   - network
-  - singletons
   - stm
   - time == 1.9.*
   - unliftio-core

src/ConnStore.hs

@@ -5,7 +5,6 @@
 
 module ConnStore where
 
-import Data.Singletons
 import Transmission
 
 data Connection = Connection
@@ -20,7 +19,7 @@ data ConnStatus = ConnActive | ConnOff
 
 class MonadConnStore s m where
   addConn :: s -> m (RecipientId, SenderId) -> RecipientKey -> m (Either ErrorType Connection)
-  getConn :: s -> Sing (a :: Party) -> ConnId -> m (Either ErrorType Connection)
+  getConn :: s -> SParty (a :: Party) -> ConnId -> m (Either ErrorType Connection)
   secureConn :: s -> RecipientId -> SenderKey -> m (Either ErrorType ())
   suspendConn :: s -> RecipientId -> m (Either ErrorType ())
   deleteConn :: s -> RecipientId -> m (Either ErrorType ())

src/ConnStore/STM.hs

@@ -16,7 +16,6 @@ import ConnStore
 import Control.Monad.IO.Unlift
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Singletons
 import Transmission
 import UnliftIO.STM
 
@@ -53,7 +52,7 @@ instance MonadUnliftIO m => MonadConnStore STMConnStore m where
                     }
                 return $ Just c
 
-  getConn :: STMConnStore -> Sing (p :: Party) -> ConnId -> m (Either ErrorType Connection)
+  getConn :: STMConnStore -> SParty (p :: Party) -> ConnId -> m (Either ErrorType Connection)
   getConn store SRecipient rId = atomically $ do
     cs <- readTVar store
     return $ getRcpConn cs rId

src/Server.hs

@@ -20,7 +20,6 @@ import Crypto.Random
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.Map.Strict as M
-import Data.Singletons
 import Data.Time.Clock
 import Env.STM
 import MsgStore
@@ -87,7 +86,7 @@ verifyTransmission signature connId cmd = do
     Cmd SRecipient _ -> withConnection SRecipient $ verifySignature . recipientKey
     Cmd SSender (SEND _) -> withConnection SSender $ verifySend . senderKey
   where
-    withConnection :: Sing (p :: Party) -> (Connection -> m Cmd) -> m Cmd
+    withConnection :: SParty (p :: Party) -> (Connection -> m Cmd) -> m Cmd
     withConnection party f = do
       store <- asks connStore
       conn <- getConn store party connId

src/Transmission.hs

@@ -1,12 +1,10 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
@@ -17,19 +15,22 @@ import Data.ByteString.Base64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (ord)
-import Data.Singletons.TH
+import Data.Kind
 import Data.Time.Clock
 import Data.Time.ISO8601
 
-$( singletons
-     [d|
-       data Party = Broker | Recipient | Sender
-         deriving (Show)
-       |]
- )
+data SParty :: Party -> Type where
+  SBroker :: SParty 'Broker
+  SRecipient :: SParty 'Recipient
+  SSender :: SParty 'Sender
+
+deriving instance Show (SParty a)
+
+data Party = Broker | Recipient | Sender
+  deriving (Show)
 
 data Cmd where
-  Cmd :: Sing a -> Command a -> Cmd
+  Cmd :: SParty a -> Command a -> Cmd
 
 deriving instance Show Cmd