removes dependent types

package.yaml

@@ -54,9 +54,6 @@ dependencies:
   - protolude
   - rainbow
   - shakespeare
-  - singletons # sorry
-  - singletons-base # sorry
-  - singletons-th # sorry
   - template-haskell
   - terminal-progress-bar
   - text

src/Handler/Package.hs

@@ -1,9 +1,6 @@
 module Handler.Package where
 
-import Data.Singletons (TyCon)
-import Data.Singletons.Sigma (Sigma (..))
 import Foundation (Handler)
-import Handler.Package.Api (PackageListRes)
 import Handler.Package.V0.Icon qualified
 import Handler.Package.V0.Index qualified
 import Handler.Package.V0.Info (InfoRes, getInfoR)
@@ -15,12 +12,12 @@ import Handler.Package.V0.ReleaseNotes (ReleaseNotes, getReleaseNotesR)
 import Handler.Package.V0.S9PK qualified
 import Handler.Package.V0.Version (AppVersionRes, getPkgVersionR)
 import Handler.Package.V1.Index (getPackageIndexR)
-import Handler.Types.Api (ApiVersion (..), SApiVersion (..))
+import Handler.Types.Api (ApiResponse (..), ApiVersion (..))
 import Lib.Types.Core (PkgId, S9PK)
-import Startlude (fmap)
+import Startlude ((.), (<$>))
+import Yesod
 import Yesod.Core.Types (
     JSONResponse,
-    TypedContent,
  )
 
 
@@ -28,9 +25,9 @@ getInfoR :: ApiVersion -> Handler (JSONResponse InfoRes)
 getInfoR _ = Handler.Package.V0.Info.getInfoR
 
 
-getPackageIndexR :: ApiVersion -> Handler (Sigma ApiVersion (TyCon PackageListRes))
+getPackageIndexR :: ApiVersion -> Handler TypedContent
-getPackageIndexR V0 = fmap (SV0 :&:) Handler.Package.V0.Index.getPackageIndexR
+getPackageIndexR V0 = toTypedContent . apiEncode V0 <$> Handler.Package.V0.Index.getPackageIndexR
-getPackageIndexR V1 = fmap (SV1 :&:) Handler.Package.V1.Index.getPackageIndexR
+getPackageIndexR V1 = toTypedContent . apiEncode V1 <$> Handler.Package.V1.Index.getPackageIndexR
 
 
 getVersionLatestR :: ApiVersion -> Handler VersionLatestRes

src/Handler/Package/Api.hs

@@ -9,13 +9,23 @@ module Handler.Package.Api where
 
 import Data.ByteString.Base64 (encodeBase64)
 import Data.HashMap.Strict
-import Data.Singletons (TyCon)
-import Data.Singletons.Sigma (Sigma (..))
 import Data.String.Interpolate.IsString (i)
-import Handler.Types.Api (ApiVersion (..), SApiVersion (..))
+import Handler.Types.Api (ApiResponse (..), ApiVersion (..))
 import Lib.Types.Core
 import Lib.Types.Emver
-import Startlude
+import Startlude (
+    ByteString,
+    Eq,
+    Generic,
+    NonEmpty,
+    Show,
+    Text,
+    snd,
+    ($),
+    (&),
+    (.),
+    (<$>),
+ )
 import Yesod
 
 
@@ -23,72 +33,49 @@ dataUrl :: (ContentType, ByteString) -> Text
 dataUrl (ct, payload) = [i|data:#{ct};base64,#{encodeBase64 payload}|]
 
 
-type PackageListRes :: ApiVersion -> Type
+newtype PackageListRes = PackageListRes [PackageRes]
-newtype PackageListRes a = PackageListRes [PackageRes a]
     deriving (Generic)
-instance ToJSON (PackageRes a) => ToJSON (PackageListRes a) where
+instance ApiResponse PackageListRes where
-    toJSON (PackageListRes a) = toJSON a
+    apiEncode V0 (PackageListRes pkgs) = toJSON $ apiEncode V0 <$> pkgs
-instance ToJSON (PackageRes a) => ToContent (PackageListRes a) where
+    apiEncode V1 (PackageListRes pkgs) = toJSON $ apiEncode V1 <$> pkgs
-    toContent = toContent . toJSON
-instance ToJSON (PackageRes a) => ToTypedContent (PackageListRes a) where
-    toTypedContent = toTypedContent . toJSON
 
 
-data PackageRes a = PackageRes
+data PackageRes = PackageRes
     { packageResIcon :: !(ContentType, ByteString)
     , packageResManifest :: !Value -- PackageManifest
     , packageResCategories :: ![Text]
     , packageResInstructions :: !Text
     , packageResLicense :: !Text
     , packageResVersions :: !(NonEmpty Version)
-    , packageResDependencies :: !(HashMap PkgId (DependencyRes a))
+    , packageResDependencies :: !(HashMap PkgId DependencyRes)
     }
     deriving (Show, Generic)
 
 
-instance ToJSON (PackageRes 'V0) where
+instance ApiResponse PackageRes where
-    toJSON PackageRes{..} =
+    apiEncode v PackageRes{..} =
         object
-            [ "icon" .= encodeBase64 (snd packageResIcon)
+            [ "icon"
+                .= ( packageResIcon & case v of
+                        V0 -> encodeBase64 . snd
+                        V1 -> dataUrl
+                   )
             , "license" .= packageResLicense
             , "instructions" .= packageResInstructions
             , "manifest" .= packageResManifest
             , "categories" .= packageResCategories
             , "versions" .= packageResVersions
-            , "dependency-metadata" .= packageResDependencies
+            , "dependency-metadata" .= (apiEncode v <$> packageResDependencies)
-            ]
-instance ToJSON (PackageRes 'V1) where
-    toJSON PackageRes{..} =
-        object
-            [ "icon" .= dataUrl packageResIcon
-            , "license" .= packageResLicense
-            , "instructions" .= packageResInstructions
-            , "manifest" .= packageResManifest
-            , "categories" .= packageResCategories
-            , "versions" .= packageResVersions
-            , "dependency-metadata" .= packageResDependencies
             ]
 
 
-instance ToJSON (Sigma ApiVersion (TyCon PackageListRes)) where
+data DependencyRes = DependencyRes
-    toJSON (s :&: t) = case s of
-        SV0 -> toJSON t
-        SV1 -> toJSON t
-instance ToContent (Sigma ApiVersion (TyCon PackageListRes)) where
-    toContent = toContent . toJSON
-instance ToTypedContent (Sigma ApiVersion (TyCon PackageListRes)) where
-    toTypedContent = toTypedContent . toJSON
-
-
-type DependencyRes :: ApiVersion -> Type
-data DependencyRes a = DependencyRes
     { dependencyResTitle :: !Text
     , dependencyResIcon :: !(ContentType, ByteString)
     }
     deriving (Eq, Show)
 
 
-instance ToJSON (DependencyRes 'V0) where
+instance ApiResponse DependencyRes where
-    toJSON DependencyRes{..} = object ["icon" .= encodeBase64 (snd dependencyResIcon), "title" .= dependencyResTitle]
+    apiEncode V0 DependencyRes{..} = object ["icon" .= encodeBase64 (snd dependencyResIcon), "title" .= dependencyResTitle]
-instance ToJSON (DependencyRes 'V1) where
+    apiEncode V1 DependencyRes{..} = object ["icon" .= dataUrl dependencyResIcon, "title" .= dependencyResTitle]
-    toJSON DependencyRes{..} = object ["icon" .= dataUrl dependencyResIcon, "title" .= dependencyResTitle]

src/Handler/Package/V0/Index.hs

@@ -6,11 +6,8 @@ module Handler.Package.V0.Index where
 import Foundation (Handler)
 import Handler.Package.Api (PackageListRes)
 import Handler.Package.V1.Index qualified
-import Handler.Types.Api (ApiVersion (..))
-import Startlude ((<$>))
-import Unsafe.Coerce (unsafeCoerce)
 
 
--- this use of unsafecoerce is OK because the 'V0 witness does not appear in any way in the representation
+-- implementation is the same but we will encode different payloads on the way out
-getPackageIndexR :: Handler (PackageListRes 'V0)
+getPackageIndexR :: Handler PackageListRes
-getPackageIndexR = unsafeCoerce <$> Handler.Package.V1.Index.getPackageIndexR
+getPackageIndexR = Handler.Package.V1.Index.getPackageIndexR

src/Handler/Package/V1/Index.hs

@@ -115,7 +115,7 @@ data PackageMetadata = PackageMetadata
     deriving (Eq, Show)
 
 
-getPackageIndexR :: Handler (PackageListRes 'V1)
+getPackageIndexR :: Handler PackageListRes
 getPackageIndexR = do
     osPredicate <-
         getOsVersionQuery <&> \case
@@ -191,7 +191,7 @@ getPackageDependencies ::
     (MonadIO m, MonadLogger m, MonadResource m, Has PkgRepo r, MonadReader r m) =>
     (Version -> Bool) ->
     PackageMetadata ->
-    ReaderT SqlBackend m (HashMap PkgId (DependencyRes 'V1))
+    ReaderT SqlBackend m (HashMap PkgId DependencyRes)
 getPackageDependencies osPredicate PackageMetadata{packageMetadataPkgId = pkg, packageMetadataPkgVersion = pkgVersion} =
     do
         pkgDepInfo <- getPkgDependencyData pkg pkgVersion
@@ -208,8 +208,8 @@ getPackageDependencies osPredicate PackageMetadata{packageMetadataPkgId = pkg, p
 constructPackageListApiRes ::
     (MonadResource m, MonadReader r m, Has AppSettings r, Has PkgRepo r) =>
     PackageMetadata ->
-    HashMap PkgId (DependencyRes a) ->
+    HashMap PkgId DependencyRes ->
-    m (PackageRes a)
+    m PackageRes
 constructPackageListApiRes PackageMetadata{..} dependencies = do
     settings <- ask @_ @_ @AppSettings
     let pkgId = packageMetadataPkgId

src/Handler/Types/Api.hs

@@ -6,11 +6,9 @@
 
 module Handler.Types.Api where
 
-import Data.Ord.Singletons
+import Data.Aeson (Value)
-import Data.Singletons.TH
 import GHC.Read (Read (..))
 import GHC.Show (show)
-import Prelude.Singletons
 import Startlude (
     Eq,
     Maybe (..),
@@ -20,14 +18,10 @@ import Startlude (
 import Yesod (PathPiece (..))
 
 
-$( singletons
+data ApiVersion
-    [d|
+    = V0
-        data ApiVersion
+    | V1
-            = V0
+    deriving (Eq, Ord)
-            | V1
-            deriving (Eq, Ord)
-        |]
- )
 
 
 instance Show ApiVersion where
@@ -47,3 +41,7 @@ instance PathPiece ApiVersion where
     fromPathPiece "v0" = Just V0
     fromPathPiece "v1" = Just V1
     fromPathPiece _ = Nothing
+
+
+class ApiResponse a where
+    apiEncode :: ApiVersion -> a -> Value