Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-26 02:11:53 +00:00
Code Issues Packages Projects Releases Wiki Activity

remove unnecessary conversions

Browse Source
This commit is contained in:
Keagan McClelland
2021-09-27 20:35:42 -06:00
parent 1fc3c2b678
commit 4204d96b51
1 changed files with 19 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
src/Lib/PkgRepository.hs
View File

@@ -5,6 +5,7 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Lib.PkgRepository where module Lib.PkgRepository where
import Conduit ( (.|) import Conduit ( (.|)
@@ -86,7 +87,7 @@ import UnliftIO.Directory ( listDirectory
, renameFile , renameFile
) )
data ManifestParseException = ManifestParseException PkgId Version String data ManifestParseException = ManifestParseException FilePath
deriving Show deriving Show
instance Exception ManifestParseException instance Exception ManifestParseException
@@ -104,24 +105,24 @@ getVersionsFor pkg = do
pure successes pure successes
-- extract all package assets into their own respective files -- extract all package assets into their own respective files
extractPkg :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m) => PkgId -> Version -> m () extractPkg :: (MonadUnliftIO m, MonadReader r m, Has PkgRepo r, MonadLoggerIO m) => FilePath -> m ()
extractPkg pkg v = (`onException` cleanup) $ do extractPkg fp = (`onException` cleanup) $ do
$logInfo [i|Extracting package: #{pkg}@#{v}|] $logInfo [i|Extracting package: #{fp}|]
PkgRepo { pkgRepoFileRoot = root, pkgRepoAppMgrBin = appmgr } <- ask PkgRepo { pkgRepoAppMgrBin = appmgr } <- ask
let pkgRoot = root </> show pkg </> show v let pkgRoot = takeDirectory fp
let s9pk = pkgRoot </> show pkg <.> "s9pk" -- let s9pk = pkgRoot </> show pkg <.> "s9pk"
manifestTask <- async $ liftIO . runResourceT $ AppMgr.sourceManifest appmgr s9pk $ sinkIt manifestTask <- async $ liftIO . runResourceT $ AppMgr.sourceManifest appmgr fp $ sinkIt
(pkgRoot </> "manifest.json") (pkgRoot </> "manifest.json")
instructionsTask <- async $ liftIO . runResourceT $ AppMgr.sourceInstructions appmgr s9pk $ sinkIt instructionsTask <- async $ liftIO . runResourceT $ AppMgr.sourceInstructions appmgr fp $ sinkIt
(pkgRoot </> "instructions.md") (pkgRoot </> "instructions.md")
licenseTask <- async $ liftIO . runResourceT $ AppMgr.sourceLicense appmgr s9pk $ sinkIt (pkgRoot </> "license.md") licenseTask <- async $ liftIO . runResourceT $ AppMgr.sourceLicense appmgr fp $ sinkIt (pkgRoot </> "license.md")
iconTask <- async $ liftIO . runResourceT $ AppMgr.sourceIcon appmgr s9pk $ sinkIt (pkgRoot </> "icon.tmp") iconTask <- async $ liftIO . runResourceT $ AppMgr.sourceIcon appmgr fp $ sinkIt (pkgRoot </> "icon.tmp")
wait manifestTask wait manifestTask
eManifest <- liftIO (eitherDecodeFileStrict' (pkgRoot </> "manifest.json")) eManifest <- liftIO (eitherDecodeFileStrict' (pkgRoot </> "manifest.json"))
case eManifest of case eManifest of
Left e -> do Left _ -> do
$logError [i|Invalid Package Manifest: #{pkg}@#{v}|] $logError [i|Invalid Package Manifest: #{fp}|]
liftIO . throwIO $ ManifestParseException pkg v e liftIO . throwIO $ ManifestParseException (pkgRoot </> "manifest.json")
Right manifest -> do Right manifest -> do
wait iconTask wait iconTask
let iconDest = "icon" <.> T.unpack (fromMaybe "png" (serviceManifestIcon manifest)) let iconDest = "icon" <.> T.unpack (fromMaybe "png" (serviceManifestIcon manifest))
@@ -131,8 +132,7 @@ extractPkg pkg v = (`onException` cleanup) $ do
where where
sinkIt fp source = runConduit $ source .| sinkFileCautious fp sinkIt fp source = runConduit $ source .| sinkFileCautious fp
cleanup = do cleanup = do
root <- asks pkgRepoFileRoot let pkgRoot = takeDirectory fp
let pkgRoot = root </> show pkg </> show v
fs <- listDirectory pkgRoot fs <- listDirectory pkgRoot
let toRemove = filter (not . (== ".s9pk") . takeExtension) fs let toRemove = filter (not . (== ".s9pk") . takeExtension) fs
mapConcurrently (removeFile . (pkgRoot </>)) toRemove mapConcurrently (removeFile . (pkgRoot </>)) toRemove
@@ -143,13 +143,9 @@ watchPkgRepoRoot = do
runInIO <- askRunInIO runInIO <- askRunInIO
box <- newEmptyMVar @_ @() box <- newEmptyMVar @_ @()
_ <- forkIO $ liftIO $ withManager $ \watchManager -> do _ <- forkIO $ liftIO $ withManager $ \watchManager -> do
stop <- watchTree watchManager root onlyAdded $ \evt -> stop <- watchTree watchManager root onlyAdded $ \evt -> do
let pkg = PkgId . T.pack $ takeBaseName (eventPath evt) let pkg = eventPath evt
version = Atto.parseOnly parseVersion . T.pack . takeFileName . takeDirectory $ (eventPath evt) runInIO (extractPkg pkg)
in case version of
Left _ -> runInIO $ do
$logError [i|Invalid Version in package path: #{eventPath evt}|]
Right v -> runInIO (extractPkg pkg v)
takeMVar box takeMVar box
stop stop
pure $ tryPutMVar box () pure $ tryPutMVar box ()