From d2dadbc35b841acaeebc0c5f80c36aafaed8b9cb Mon Sep 17 00:00:00 2001 From: Lucy Cifferello <12953208+elvece@users.noreply.github.com> Date: Fri, 28 Jul 2023 19:09:12 -0400 Subject: [PATCH] fix package manifest parsing --- src/Lib/Types/Emver.hs | 8 +++++-- src/Lib/Types/Manifest.hs | 46 +++++++++++++++++++++++++++++---------- src/Orphans/Emver.hs | 2 -- 3 files changed, 41 insertions(+), 15 deletions(-) diff --git a/src/Lib/Types/Emver.hs b/src/Lib/Types/Emver.hs index 9353557..7c7c0f4 100644 --- a/src/Lib/Types/Emver.hs +++ b/src/Lib/Types/Emver.hs @@ -73,7 +73,7 @@ import Startlude ( ($) ) import Control.Monad.Fail ( fail ) -import Data.Aeson ( ToJSONKey ) +import Data.Aeson ( ToJSONKey, toJSON, Value(String)) import qualified Data.Attoparsec.Text as Atto import qualified Data.Text as T import GHC.Base ( error ) @@ -81,9 +81,13 @@ import qualified GHC.Read as GHC ( readsPrec ) import qualified GHC.Show as GHC ( show ) +import Dhall (Generic) +import Data.Aeson.Types (ToJSON) -- | AppVersion is the core representation of the SemverQuad type. -newtype Version = Version { unVersion :: (Word, Word, Word, Word) } deriving (Eq, Ord, ToJSONKey, Hashable) +newtype Version = Version { unVersion :: (Word, Word, Word, Word) } deriving (Eq, Ord, Generic, ToJSONKey, Hashable) +instance ToJSON Version where + toJSON = String . show instance Show Version where show (Version (x, y, z, q)) = let postfix = if q == 0 then "" else '.' : GHC.show q diff --git a/src/Lib/Types/Manifest.hs b/src/Lib/Types/Manifest.hs index d092e17..8b2fe0b 100644 --- a/src/Lib/Types/Manifest.hs +++ b/src/Lib/Types/Manifest.hs @@ -11,8 +11,20 @@ import Data.String.Interpolate.IsString (i) import Data.Text qualified as T import Lib.Types.Core (PkgId, OsArch) import Lib.Types.Emver (Version (..), VersionRange) -import Startlude (ByteString, Eq, Generic, Hashable, Maybe (..), Monad ((>>=)), Read, Show, Text, for, pure, readMaybe, ($), Int, (.), (<>)) +import Startlude (ByteString, Eq, Generic, Hashable, Maybe (..), Monad ((>>=)), Read, Show, Text, for, pure, readMaybe, ($), Int, (.), (<>), String, map) import Data.Aeson + ( eitherDecode, + eitherDecodeStrict, + encode, + (.:), + (.:?), + withObject, + withText, + object, + FromJSON(parseJSON), + Value(Object), + KeyValue((.=)), + ToJSON(toJSON) ) import Database.Persist.Sql ( PersistFieldSql(..) ) import Database.Persist.Types (SqlType(..)) import qualified Data.Text.Encoding as TE @@ -20,6 +32,8 @@ import qualified Data.ByteString.Lazy as BL import Database.Persist (PersistValue(..)) import Data.Either (Either(..)) import Database.Persist.Class ( PersistField(..) ) +import Data.Aeson.Key ( fromText ) +import Data.Maybe (maybe) data PackageManifest = PackageManifest { packageManifestId :: !PkgId @@ -56,12 +70,11 @@ instance FromJSON PackageManifest where let packageManifestAlerts = HM.fromList a packageManifestDependencies <- o .: "dependencies" packageManifestEosVersion <- o .: "eos-version" - packageHardwareDevice <- o .: "hardware-requirements" >>= (.: "device") - packageHardwareRam <- o .: "hardware-requirements" >>= (.: "ram") - packageHardwareArch <- o .: "hardware-requirements" >>= (.: "arch") + packageHardwareDevice <- o .:? "hardware-requirements" >>= maybe (pure Nothing) (.:? "device") + packageHardwareRam <- o .:? "hardware-requirements" >>= maybe (pure Nothing) (.:? "ram") + packageHardwareArch <- o .:? "hardware-requirements" >>= maybe (pure Nothing) (.:? "arch") pure PackageManifest{..} - data PackageDependency = PackageDependency { packageDependencyOptional :: !(Maybe Text) , packageDependencyVersion :: !VersionRange @@ -85,7 +98,17 @@ instance ToJSON RegexPattern where toJSON (RegexPattern txt) = toJSON txt data PackageDevice = PackageDevice (HashMap Text RegexPattern) - deriving (Show, Eq, Generic, ToJSON, FromJSON) + deriving (Show, Eq) + +instance ToJSON PackageDevice where + toJSON (PackageDevice hashMap) = object (toJSONKeyValuePairs hashMap) + where + toJSONKeyValuePairs = map toKeyValue . HM.toList + toKeyValue (key, value) = fromText key .= toJSON value +instance FromJSON PackageDevice where + parseJSON = withObject "PackageDevice" $ \obj -> do + hashMap <- parseJSON (Object obj) + pure $ PackageDevice hashMap instance PersistField PackageDevice where toPersistValue = PersistByteString . BL.toStrict . encode @@ -100,25 +123,26 @@ data ServiceAlert = INSTALL | UNINSTALL | RESTORE | START | STOP deriving (Show, Eq, Generic, Hashable, Read) --- >>> eitherDecode testManifest :: Either String PackageManifest +-- >>> eitherDecodeStrict testManifest :: Either String PackageManifest testManifest :: ByteString testManifest = [i|{ "id": "embassy-pages", "title": "Embassy Pages", "version": "0.1.3", + "eos-version": "0.3.0", "description": { "short": "Create Tor websites, hosted on your Embassy.", "long": "Embassy Pages is a simple web server that uses directories inside File Browser to serve Tor websites." }, - "hardware-requirements" { + "hardware-requirements": { "device": { "processor": "^[A-Za-z0-9]+$", "display": "^[A-Za-z0-9]+$" }, - "ram": "8000000000", + "ram": 8000000000, "arch": ["aarch64", "x86_64"] - } + }, "assets": { "license": "LICENSE", "icon": "icon.png", @@ -248,4 +272,4 @@ testManifest = "config": null } } -}|] \ No newline at end of file +}|] diff --git a/src/Orphans/Emver.hs b/src/Orphans/Emver.hs index 6c0c5c2..7a4ce20 100644 --- a/src/Orphans/Emver.hs +++ b/src/Orphans/Emver.hs @@ -35,8 +35,6 @@ import Lib.Types.Emver ( Version instance FromJSON Version where parseJSON = withText "Emver Version" $ either fail pure . Atto.parseOnly parseVersion -instance ToJSON Version where - toJSON = String . show instance FromJSON VersionRange where parseJSON = withText "Emver" $ either fail pure . Atto.parseOnly parseRange instance ToJSON VersionRange where