From 9804a8e70af857561451595b3fb0709fefea5219 Mon Sep 17 00:00:00 2001 From: Keagan McClelland Date: Fri, 10 Jun 2022 16:29:39 -0600 Subject: [PATCH] removes dependent types --- package.yaml | 3 -- src/Handler/Package.hs | 15 +++---- src/Handler/Package/Api.hs | 77 ++++++++++++++------------------- src/Handler/Package/V0/Index.hs | 9 ++-- src/Handler/Package/V1/Index.hs | 8 ++-- src/Handler/Types/Api.hs | 20 ++++----- 6 files changed, 54 insertions(+), 78 deletions(-) diff --git a/package.yaml b/package.yaml index ea09054..193d575 100644 --- a/package.yaml +++ b/package.yaml @@ -54,9 +54,6 @@ dependencies: - protolude - rainbow - shakespeare - - singletons # sorry - - singletons-base # sorry - - singletons-th # sorry - template-haskell - terminal-progress-bar - text diff --git a/src/Handler/Package.hs b/src/Handler/Package.hs index 023739a..af8007e 100644 --- a/src/Handler/Package.hs +++ b/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 V0 = fmap (SV0 :&:) Handler.Package.V0.Index.getPackageIndexR -getPackageIndexR V1 = fmap (SV1 :&:) Handler.Package.V1.Index.getPackageIndexR +getPackageIndexR :: ApiVersion -> Handler TypedContent +getPackageIndexR V0 = toTypedContent . apiEncode V0 <$> Handler.Package.V0.Index.getPackageIndexR +getPackageIndexR V1 = toTypedContent . apiEncode V1 <$> Handler.Package.V1.Index.getPackageIndexR getVersionLatestR :: ApiVersion -> Handler VersionLatestRes diff --git a/src/Handler/Package/Api.hs b/src/Handler/Package/Api.hs index 70cd7e5..cb8f948 100644 --- a/src/Handler/Package/Api.hs +++ b/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 a = PackageListRes [PackageRes a] +newtype PackageListRes = PackageListRes [PackageRes] deriving (Generic) -instance ToJSON (PackageRes a) => ToJSON (PackageListRes a) where - toJSON (PackageListRes a) = toJSON a -instance ToJSON (PackageRes a) => ToContent (PackageListRes a) where - toContent = toContent . toJSON -instance ToJSON (PackageRes a) => ToTypedContent (PackageListRes a) where - toTypedContent = toTypedContent . toJSON +instance ApiResponse PackageListRes where + apiEncode V0 (PackageListRes pkgs) = toJSON $ apiEncode V0 <$> pkgs + apiEncode V1 (PackageListRes pkgs) = toJSON $ apiEncode V1 <$> pkgs -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 - toJSON PackageRes{..} = +instance ApiResponse PackageRes where + 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 - ] -instance ToJSON (PackageRes 'V1) where - toJSON PackageRes{..} = - object - [ "icon" .= dataUrl packageResIcon - , "license" .= packageResLicense - , "instructions" .= packageResInstructions - , "manifest" .= packageResManifest - , "categories" .= packageResCategories - , "versions" .= packageResVersions - , "dependency-metadata" .= packageResDependencies + , "dependency-metadata" .= (apiEncode v <$> packageResDependencies) ] -instance ToJSON (Sigma ApiVersion (TyCon PackageListRes)) where - 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 +data DependencyRes = DependencyRes { dependencyResTitle :: !Text , dependencyResIcon :: !(ContentType, ByteString) } deriving (Eq, Show) -instance ToJSON (DependencyRes 'V0) where - toJSON DependencyRes{..} = object ["icon" .= encodeBase64 (snd dependencyResIcon), "title" .= dependencyResTitle] -instance ToJSON (DependencyRes 'V1) where - toJSON DependencyRes{..} = object ["icon" .= dataUrl dependencyResIcon, "title" .= dependencyResTitle] +instance ApiResponse DependencyRes where + apiEncode V0 DependencyRes{..} = object ["icon" .= encodeBase64 (snd dependencyResIcon), "title" .= dependencyResTitle] + apiEncode V1 DependencyRes{..} = object ["icon" .= dataUrl dependencyResIcon, "title" .= dependencyResTitle] diff --git a/src/Handler/Package/V0/Index.hs b/src/Handler/Package/V0/Index.hs index c9e49d6..eb5dff7 100644 --- a/src/Handler/Package/V0/Index.hs +++ b/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 -getPackageIndexR :: Handler (PackageListRes 'V0) -getPackageIndexR = unsafeCoerce <$> Handler.Package.V1.Index.getPackageIndexR \ No newline at end of file +-- implementation is the same but we will encode different payloads on the way out +getPackageIndexR :: Handler PackageListRes +getPackageIndexR = Handler.Package.V1.Index.getPackageIndexR \ No newline at end of file diff --git a/src/Handler/Package/V1/Index.hs b/src/Handler/Package/V1/Index.hs index bc24a1b..ef42c8c 100644 --- a/src/Handler/Package/V1/Index.hs +++ b/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) -> - m (PackageRes a) + HashMap PkgId DependencyRes -> + m PackageRes constructPackageListApiRes PackageMetadata{..} dependencies = do settings <- ask @_ @_ @AppSettings let pkgId = packageMetadataPkgId diff --git a/src/Handler/Types/Api.hs b/src/Handler/Types/Api.hs index 877ef9d..c9a74ff 100644 --- a/src/Handler/Types/Api.hs +++ b/src/Handler/Types/Api.hs @@ -6,11 +6,9 @@ module Handler.Types.Api where -import Data.Ord.Singletons -import Data.Singletons.TH +import Data.Aeson (Value) 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 - [d| - data ApiVersion - = V0 - | V1 - deriving (Eq, Ord) - |] - ) +data ApiVersion + = V0 + | 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 \ No newline at end of file