changed prints to logs

This commit is contained in:
Keagan McClelland
2021-09-29 13:29:02 -06:00
parent 056e04f4e3
commit b949eafbfa
2 changed files with 33 additions and 18 deletions

View File

@@ -7,6 +7,7 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TemplateHaskell #-}
module Lib.External.AppMgr where
@@ -24,6 +25,9 @@ import Conduit ( (.|)
, ConduitT
, runConduit
)
import Control.Monad.Logger ( MonadLoggerIO
, logErrorSH
)
import qualified Data.Conduit.List as CL
import Data.Conduit.Process.Typed
import GHC.IO.Exception ( IOErrorType(NoSuchThing)
@@ -77,35 +81,47 @@ readProcessInheritStderr a b c sink = do
else throwIO e
)
sourceManifest :: (MonadUnliftIO m) => FilePath -> FilePath -> (ConduitT () ByteString m () -> m r) -> m r
sourceManifest :: (MonadUnliftIO m, MonadLoggerIO m)
=> FilePath
-> FilePath
-> (ConduitT () ByteString m () -> m r)
-> m r
sourceManifest appmgrPath pkgFile sink = do
let appmgr = readProcessInheritStderr (appmgrPath </> "embassy-sdk") ["inspect", "manifest", pkgFile] ""
appmgr sink `catch` \ece ->
print ece *> throwIO (AppMgrE [i|embassy-sdk inspect manifest #{pkgFile}|] (eceExitCode ece))
$logErrorSH ece *> throwIO (AppMgrE [i|embassy-sdk inspect manifest #{pkgFile}|] (eceExitCode ece))
sourceIcon :: (MonadUnliftIO m) => FilePath -> FilePath -> (ConduitT () ByteString m () -> m r) -> m r
sourceIcon :: (MonadUnliftIO m, MonadLoggerIO m) => FilePath -> FilePath -> (ConduitT () ByteString m () -> m r) -> m r
sourceIcon appmgrPath pkgFile sink = do
let appmgr = readProcessInheritStderr (appmgrPath </> "embassy-sdk") ["inspect", "icon", pkgFile] ""
appmgr sink
`catch` \ece -> print ece *> throwIO (AppMgrE [i|embassy-sdk inspect icon #{pkgFile}|] (eceExitCode ece))
appmgr sink `catch` \ece ->
$logErrorSH ece *> throwIO (AppMgrE [i|embassy-sdk inspect icon #{pkgFile}|] (eceExitCode ece))
getPackageHash :: (MonadUnliftIO m) => FilePath -> FilePath -> m ByteString
getPackageHash :: (MonadUnliftIO m, MonadLoggerIO m) => FilePath -> FilePath -> m ByteString
getPackageHash appmgrPath pkgFile = do
let appmgr = readProcessInheritStderr (appmgrPath </> "embassy-sdk") ["inspect", "hash", pkgFile] ""
appmgr (\bsSource -> runConduit $ bsSource .| CL.foldMap id)
`catch` \ece -> print ece *> throwIO (AppMgrE [i|embassy-sdk inspect hash #{pkgFile}|] (eceExitCode ece))
appmgr (\bsSource -> runConduit $ bsSource .| CL.foldMap id) `catch` \ece ->
$logErrorSH ece *> throwIO (AppMgrE [i|embassy-sdk inspect hash #{pkgFile}|] (eceExitCode ece))
sourceInstructions :: (MonadUnliftIO m) => FilePath -> FilePath -> (ConduitT () ByteString m () -> m r) -> m r
sourceInstructions :: (MonadUnliftIO m, MonadLoggerIO m)
=> FilePath
-> FilePath
-> (ConduitT () ByteString m () -> m r)
-> m r
sourceInstructions appmgrPath pkgFile sink = do
let appmgr = readProcessInheritStderr (appmgrPath </> "embassy-sdk") ["inspect", "instructions", pkgFile] ""
appmgr sink `catch` \ece ->
print ece *> throwIO (AppMgrE [i|embassy-sdk inspect instructions #{pkgFile}|] (eceExitCode ece))
$logErrorSH ece *> throwIO (AppMgrE [i|embassy-sdk inspect instructions #{pkgFile}|] (eceExitCode ece))
sourceLicense :: (MonadUnliftIO m) => FilePath -> FilePath -> (ConduitT () ByteString m () -> m r) -> m r
sourceLicense :: (MonadUnliftIO m, MonadLoggerIO m)
=> FilePath
-> FilePath
-> (ConduitT () ByteString m () -> m r)
-> m r
sourceLicense appmgrPath pkgFile sink = do
let appmgr = readProcessInheritStderr (appmgrPath </> "embassy-sdk") ["inspect", "license", pkgFile] ""
appmgr sink
`catch` \ece -> print ece *> throwIO (AppMgrE [i|embassy-sdk inspect license #{pkgFile}|] (eceExitCode ece))
appmgr sink `catch` \ece ->
$logErrorSH ece *> throwIO (AppMgrE [i|embassy-sdk inspect license #{pkgFile}|] (eceExitCode ece))
sinkMem :: (Monad m, Monoid a) => ConduitT () a m () -> m a
sinkMem c = runConduit $ c .| CL.foldMap id

View File

@@ -144,13 +144,12 @@ extractPkg fp = handle @_ @SomeException cleanup $ do
$logInfo [i|Extracting package: #{fp}|]
PkgRepo { pkgRepoAppMgrBin = appmgr } <- ask
let pkgRoot = takeDirectory fp
manifestTask <- async $ liftIO . runResourceT $ AppMgr.sourceManifest appmgr fp $ sinkIt
(pkgRoot </> "manifest.json")
manifestTask <- async $ runResourceT $ AppMgr.sourceManifest appmgr fp $ sinkIt (pkgRoot </> "manifest.json")
pkgHashTask <- async $ AppMgr.getPackageHash appmgr fp
instructionsTask <- async $ liftIO . runResourceT $ AppMgr.sourceInstructions appmgr fp $ sinkIt
instructionsTask <- async $ runResourceT $ AppMgr.sourceInstructions appmgr fp $ sinkIt
(pkgRoot </> "instructions.md")
licenseTask <- async $ liftIO . runResourceT $ AppMgr.sourceLicense appmgr fp $ sinkIt (pkgRoot </> "license.md")
iconTask <- async $ liftIO . runResourceT $ AppMgr.sourceIcon appmgr fp $ sinkIt (pkgRoot </> "icon.tmp")
licenseTask <- async $ runResourceT $ AppMgr.sourceLicense appmgr fp $ sinkIt (pkgRoot </> "license.md")
iconTask <- async $ runResourceT $ AppMgr.sourceIcon appmgr fp $ sinkIt (pkgRoot </> "icon.tmp")
wait manifestTask
eManifest <- liftIO (eitherDecodeFileStrict' (pkgRoot </> "manifest.json"))
case eManifest of