streaming output works

src/Lib/Error.hs

@@ -46,8 +46,8 @@ toStatus :: S9Error -> Status
 toStatus = \case
     PersistentE _ -> status500
 
-respondStatusException :: MonadHandler m => S9ErrT m a -> m a
-respondStatusException action = runExceptT action >>= \case
+handleS9ErrT :: MonadHandler m => S9ErrT m a -> m a
+handleS9ErrT action = runExceptT action >>= \case
     Left e -> toStatus >>= sendResponseStatus $ e
     Right a -> pure a
 

src/Lib/Registry.hs

@@ -0,0 +1,77 @@
+module Lib.Registry where
+
+import           Startlude         hiding (empty, toList)
+
+import           Data.HashMap.Lazy hiding (mapMaybe)
+import qualified GHC.Read          (Read (..))
+import qualified GHC.Show          (Show (..))
+import           System.Directory
+import           System.FilePath
+import           Yesod.Core
+
+import           Data.Text         (isSuffixOf)
+
+import           Lib.Semver
+import           Lib.Types.Semver
+
+newtype S9PK = S9PK String deriving (Eq)
+instance Show S9PK where
+    show (S9PK t) = t <.> "s9pk"
+
+instance Read S9PK where
+    readsPrec _ s = [(S9PK . take (m - n) $ s, "") | toS s9pk `isSuffixOf` toS s]
+        where
+            m = length s
+            s9pk = ".s9pk" :: String
+            n = length s9pk
+
+instance PathPiece S9PK where
+    fromPathPiece = readMaybe . toS
+    toPathPiece = show
+
+appResourceDir :: FilePath
+appResourceDir = "./resources/apps"
+
+sysResourceDir :: FilePath
+sysResourceDir = "./resources/sys"
+
+appManifestPath :: FilePath
+appManifestPath = appResourceDir </> "apps.yaml"
+
+appManifestFile :: FilePath
+appManifestFile = "apps.yml"
+
+s9pkExt :: String -> FilePath
+s9pkExt = show . S9PK
+
+type Registry = HashMap String (HashMap AppVersion FilePath)
+
+newtype RegisteredAppVersion = RegisteredAppVersion (AppVersion, FilePath)
+instance HasAppVersion RegisteredAppVersion where
+    version (RegisteredAppVersion (av, _)) = av
+
+loadAppRegistry :: MonadIO m => m Registry
+loadAppRegistry = loadRegistry appResourceDir
+
+loadSysRegistry :: MonadIO m => m Registry
+loadSysRegistry = loadRegistry sysResourceDir
+
+loadRegistry :: MonadIO m => FilePath -> m Registry
+loadRegistry rootDirectory = liftIO $ do
+    appDirectories <- getSubDirectories rootDirectory
+    foldM
+        ( \registry appId -> do
+            subdirs <- getSubDirectories (rootDirectory </> appId)
+            let validVersions = mapMaybe readMaybe subdirs
+            let versionedApps = fromList . fmap (id &&& fullS9pk rootDirectory appId) $ validVersions
+            pure $ insert appId versionedApps registry
+        ) empty appDirectories
+    where
+        getSubDirectories path = listDirectory path >>= filterM (fmap not . doesFileExist)
+        fullS9pk root appId' appVersion = root </> appId' </> show appVersion </> s9pkExt appId'
+
+getAppFile :: String -> Registry -> AppVersion -> Maybe FilePath
+getAppFile appId r av = lookup av <=< lookup appId $ r
+
+registeredAppVersions :: String -> Registry -> [RegisteredAppVersion]
+registeredAppVersions appId r = maybe [] (fmap RegisteredAppVersion . toList) (lookup appId r)

src/Lib/Resource.hs

@@ -1,50 +0,0 @@
-{-# LANGUAGE TupleSections #-}
-
-module Lib.Resource where
-
-import           Startlude         hiding (empty, toList)
-
-import           Data.HashMap.Lazy hiding (mapMaybe)
-import           System.Directory
-import           System.FilePath
-
-import           Lib.Semver
-import           Lib.Types.Semver
-
-
-resourcePath :: FilePath
-resourcePath = "./resources"
-
-manifestPath :: FilePath
-manifestPath = resourcePath </> "apps.yml"
-
-manifestFile :: FilePath
-manifestFile = "apps.yml"
-
-s9pkFile :: String -> FilePath
-s9pkFile appId = toS appId <.> "s9pk"
-
-type Registry = HashMap String (HashMap AppVersion FilePath)
-
-newtype RegisteredAppVersion = RegisteredAppVersion (AppVersion, FilePath)
-instance HasAppVersion RegisteredAppVersion where
-    version (RegisteredAppVersion (av, _)) = av
-
-loadResources :: MonadIO m => m Registry
-loadResources = liftIO $ do
-    appDirectories <- getSubDirectories resourcePath
-    foldM
-        ( \hm appId -> do
-            subdirs <- getSubDirectories (resourcePath </> appId)
-            let validVersions = mapMaybe readMaybe subdirs
-            let newAppVersions = fromList $ fmap (\v -> (v, resourcePath </> show v </> s9pkFile appId)) validVersions
-            pure $ insert appId newAppVersions hm
-        ) empty appDirectories
-    where
-        getSubDirectories path = listDirectory path >>= filterM (fmap not . doesFileExist)
-
-getAppFile :: Registry -> String -> AppVersion -> Maybe FilePath
-getAppFile r appId av = lookup av <=< lookup appId $ r
-
-registeredAppVersions :: Registry -> String -> [RegisteredAppVersion]
-registeredAppVersions r appId = fromMaybe [] $ fmap RegisteredAppVersion . toList <$> lookup appId r

src/Lib/Semver.hs

@@ -30,7 +30,7 @@ hasGiven :: (AppVersion -> Word16) -> AppVersion -> AppVersion -> Bool
 hasGiven projection av = (== projection av) . projection
 
 getSpecifiedAppVersion :: HasAppVersion a => AppVersionSpecification -> [a] -> Maybe a
-getSpecifiedAppVersion avSpec = appVersionMax . filter (<|| avSpec) --  get the largest thing satisfying the spec.
+getSpecifiedAppVersion avSpec = appVersionMax . filter (<|| avSpec)
 
 class HasAppVersion a where
     version :: a -> AppVersion

src/Lib/Types/AppsManifest.hs

@@ -1,56 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-
-module Lib.Types.AppsManifest where
-
-import           Data.HashMap.Strict
-import           Data.Yaml
-
-import           Lib.Types.Semver
-import           Startlude
-
-
-type AppsManifest = HashMap Text FullAppManifest
-data FullAppManifest = FullAppManifest { name :: Text, appGlobals :: AppGlobals, appVersionDetails :: NonEmpty AppVersionDetails }
-
-data AppGlobals = AppGlobals
-    { globalAppTitle            :: Text
-    , globalAppDescriptionShort :: Text
-    , globalAppDescriptionLong  :: Text
-    , globalAppIconUrl          :: Text
-    }
-
-instance FromJSON AppGlobals where
-    parseJSON = withObject "App Globals" $ \o -> do
-        desc <- o .: "description"
-        (globalAppDescriptionShort, globalAppDescriptionLong) <-
-            ( withObject "App Description" $ \d -> do
-                s <- d .: "short"
-                l <- d .: "long"
-                pure (s,l)
-            ) desc
-        globalAppTitle <- o .: "title"
-        globalAppIconUrl <- o .: "icon-url"
-        pure AppGlobals{..}
-instance ToJSON AppGlobals where
-    toJSON AppGlobals{..} = object
-        [ "title" .= globalAppTitle
-        , "descriptionShort" .= globalAppDescriptionShort
-        , "descriptionLong" .= globalAppDescriptionLong
-        , "iconUrl" .= globalAppIconUrl
-        ]
-
-
-data AppVersionDetails = AppVersionDetails
-    { versionDetailsVersion      :: AppVersion
-    , versionDetailsReleaseNotes :: Text
-    } deriving (Eq, Ord, Show)
-instance FromJSON AppVersionDetails where
-    parseJSON = withObject "Store App Version Info" $ \o -> do
-        versionDetailsVersion <- o .: "version"
-        versionDetailsReleaseNotes <- o .: "release-notes"
-        pure AppVersionDetails{..}
-instance ToJSON AppVersionDetails where
-    toJSON AppVersionDetails{..} = object
-        [ "version" .= versionDetailsVersion
-        , "releaseNotes" .= versionDetailsReleaseNotes
-        ]

src/Lib/Types/Semver.hs

@@ -91,6 +91,9 @@ instance FromJSON AppVersionSpecification where
         requestModifier <- parseJSON . String $ svMod
         pure $ AppVersionSpecification {..}
 
+mostRecentVersion :: AppVersionSpecification
+mostRecentVersion = AppVersionSpecification SVGreaterThanEq $ AppVersion (0,0,0)
+
 ------------------------------------------------------------------------------------------------------------------------
 -- Semver RequestModifier
 ------------------------------------------------------------------------------------------------------------------------

src/Lib/Types/StoreApp.hs

@@ -1,33 +0,0 @@
-
-{-# LANGUAGE RecordWildCards #-}
-module Lib.Types.StoreApp where
-
-import           Startlude
-
-import           Control.Monad.Fail
-import           Data.Aeson
-import           Data.Text
-
-import           Lib.Types.AppsManifest
-import           Lib.Types.Semver
-
-data StoreApp = StoreApp
-    { storeAppId               :: Text
-    , storeAppTitle            :: Text
-    , storeAppDescriptionShort :: Text
-    , storeAppDescriptionLong  :: Text
-    , storeAppIconUrl          :: Text
-    , storeAppVersions         :: NonEmpty AppVersionDetails
-    } deriving (Eq, Show)
-
-instance ToJSON StoreApp where
-    toJSON (StoreApp{..}) = object
-                [ "id" .= storeAppId
-                , "title" .= storeAppTitle
-                , "iconURL" .= storeAppIconUrl
-                , "description" .= object
-                    [ "short" .= storeAppDescriptionShort
-                    , "long" .= storeAppDescriptionLong
-                    ]
-                , "versionInfo" .= storeAppVersions
-                ]