git.iko.soy/typeable/octopod
on master help sign in
improve logging in DMC
commit9485fe50b57f379757817a606162a47c5c0f58dc authorAndrei Orlov <aaorlov1@gmail.com> dateTue 11 Feb 2020, 15:12 (7 years ago) parent59c4b02
1 file changed+15−18
src/DMC/Lib.hs+15−18
src/DMC/Lib.hs+15−18
@@ -6,10 +6,12 @@ module DMC.Lib
66 ( runDMC
77 ) where
88
9+import Prelude hiding (unlines)
10+
911import Control.Monad
1012import Data.Maybe (fromMaybe)
1113import Data.Proxy
12−import Data.Text (pack, unpack)
14+import Data.Text (pack, unlines, unpack)
1315import Options.Generic
1416import Network.HTTP.Client (newManager, defaultManagerSettings)
1517import Network.URI
@@ -36,7 +38,6 @@ instance ParseRecord Args where
3638runDMC :: IO ()
3739runDMC = do
3840 args <- getRecord "DMC"
39− print (args :: Args)
4041
4142 manager <- newManager defaultManagerSettings
4243 env <- getBaseUrl
@@ -60,13 +61,10 @@ getBaseUrl = do
6061 p = read . tail . uriPort $ uriData
6162 return $ BaseUrl s h p ""
6263
63−handleCommand clientEnv Create {name, template, envs} = do
64− res <- flip runClientM clientEnv $ create $ Deployment name template envs
65− print res
64+handleCommand clientEnv Create {name, template, envs}
65+ = handleResponse =<< runClientM (create $ Deployment name template envs) clientEnv
6666
67−handleCommand clientEnv List = do
68− res <- runClientM list clientEnv
69− print res
67+handleCommand clientEnv List = (\l -> handleResponse $ unlines <$> l) =<< runClientM list clientEnv
7068
7169handleCommand clientEnv Edit {name} = do
7270 editor <- lookupEnv "EDITOR"
@@ -83,20 +81,16 @@ handleCommand clientEnv Edit {name} = do
8381 editEnvs ed e = withTempFile "" "dmc" $ \p h -> do
8482 mapM_ (hPutStrLn h) (fmap unpack e)
8583 hFlush h
86− withProcessWait_ (proc ed [p]) $ \_ -> print "sending update..."
84+ withProcessWait_ (proc ed [p]) $ \_ -> putStrLn "sending update..."
8785 fmap pack . lines <$> readFile p
8886
89− sendUpdate t e = do
90− res <- flip runClientM clientEnv $ edit name $ Deployment name t e
91− print res
87+ sendUpdate t e = handleResponse =<< runClientM (edit name $ Deployment name t e) clientEnv
9288
93−handleCommand clientEnv Destroy {name} = do
94− res <- flip runClientM clientEnv $ destroy name
95− print res
89+handleCommand clientEnv Destroy {name} = handleResponse =<< runClientM (destroy name) clientEnv
9690
97−handleCommand clientEnv Update {name, template} = do
98− res <- flip runClientM clientEnv $ update name $ Deployment name template ["SOME_KEY=SOME_VAL"]
99− print res
91+handleCommand clientEnv Update {name, template}
92+ = handleResponse =<< runClientM (update name $ Deployment name template envs) clientEnv
93+ where envs = ["UNUSED_KEY=UNUSED_VALUE"]
10094
10195deploymentAPI :: Proxy DeploymentAPI
10296deploymentAPI = Proxy
@@ -114,3 +108,6 @@ edit :: Text -> Deployment -> ClientM Text
114108destroy :: Text -> ClientM Text
115109
116110update :: Text -> Deployment -> ClientM Text
111+
112+handleResponse (Right result) = putStrLn (unpack result) >> putStrLn "done"
113+handleResponse (Left err) = putStrLn $ "command failed, reason: " ++ show err