b471cd9 · obelisk · git.iko.soy

git.iko.soy/obelisk

failWith returns IO a; nearly all places use failWith now

Except one, where fail is used to play well with Either monad

commitb471cd9df9315b41c7982253ed77332157f556f5 authorSridhar Ratnakumar <srid@srid.ca> dateTue 8 May 2018, 19:48 (8 years ago) parent34f61e5

3 files changed+21−19

compare with master

unifiedsplit

lib/command/src/Obelisk/Command.hs+7−4 lib/command/src/Obelisk/Command/CLI.hs+2−3 lib/command/src/Obelisk/Command/Thunk.hs+12−12

lib/command/src/Obelisk/Command.hs+7−4

@@ -196,7 +196,7 @@ ob = \case

196196 ObCommand_Deploy dc -> case dc of

197197 DeployCommand_Init deployOpts -> withProjectRoot "." $ \root -> do

198198 thunkPtr <- readThunk root >>= \case

199− Left err -> fail $ "thunk pack: " <> show err

199+ Left err -> failWith $ T.pack $ "thunk pack: " <> show err

200200 Right (ThunkData_Packed ptr) -> return ptr

201201 Right (ThunkData_Checkout (Just ptr)) -> return ptr

202202 Right (ThunkData_Checkout Nothing) ->

@@ -208,7 +208,7 @@ ob = \case

208208 DeployCommand_Push -> do

209209 checkGitCleanStatus "." >>= \case

210210 True -> return ()

211− False -> fail "ob push: Commit any changes to the deployment configuration before proceeding"

211+ False -> failWith "ob push: Commit any changes to the deployment configuration before proceeding"

212212 ObCommand_Run -> inNixShell' $ static run

213213 -- inNixShell ($(mkClosure 'ghcidAction) ())

214214 ObCommand_Thunk tc -> case tc of

@@ -219,17 +219,20 @@ ob = \case

219219 ObCommand_Watch component -> watch component

220220 ObCommand_Internal icmd -> case icmd of

221221 ObInternal_RunStaticIO k -> unsafeLookupStaticPtr @(IO ()) k >>= \case

222− Nothing -> failWith $ "ObInternal_RunStaticIO: no such StaticKey: " <> (T.pack $ show k)

222+ Nothing -> failWith $ "ObInternal_RunStaticIO: no such StaticKey: " <> T.pack (show k)

223223 Just p -> deRefStaticPtr p

224224--TODO: Clean up all the magic strings throughout this codebase

225225

226226encodeStaticKey :: StaticKey -> String

227227encodeStaticKey = T.unpack . decodeUtf8 . Base16.encode . LBS.toStrict . Binary.encode

228228

229+-- TODO: This function should use `failWith` instead of `fail` so as to be consistent with the way obelisk

230+-- outputs in the rest of the codebase. However `failWith` returns `IO a`, so that involves revisiting

231+-- this function and thinking of how best to raise errors from pure (non-IO) functions.

229232decodeStaticKey :: String -> Either String StaticKey

230233decodeStaticKey s = case Base16.decode $ encodeUtf8 $ T.pack s of

231234 (b, "") -> case Binary.decodeOrFail $ LBS.fromStrict b of

232235 Right ("", _, a) -> pure a

233− Right _ -> fail $ "decodeStaticKey: Binary.decodeOrFail didn't consume all input"

236+ Right _ -> fail "decodeStaticKey: Binary.decodeOrFail didn't consume all input"

234237 Left (_, _, e) -> fail $ "decodeStaticKey: Binary.decodeOrFail failed: " <> show e

235238 _ -> fail $ "decodeStaticKey: could not decode hex string: " <> show s

lib/command/src/Obelisk/Command/CLI.hs+2−3

@@ -44,10 +44,9 @@ data Level = Level_Normal | Level_Warning | Level_Error

4444

4545-- | Prefer this over the alternative ways to exit the program with an error message as it automatically

4646-- takes care of cleaning on spinners.

47−-- TODO: Replace the uses of 'fail' throughout Stela to use this function.

4847-- TODO: Handle this error cleanly when evaluating outside of `withSpinner` (eg: runCLI)

49−failWith :: Text -> IO ()

50−failWith = throw . AppError

48+failWith :: Text -> IO a

49+failWith = ioError . userError . T.unpack

5150

5251putError :: Text -> IO ()

5352putError = putMsg Level_Error

lib/command/src/Obelisk/Command/Thunk.hs+12−12

@@ -325,10 +325,10 @@ createThunkWithLatest target s = do

325325updateThunkToLatest :: FilePath -> IO ()

326326updateThunkToLatest target = do

327327 (overwrite, ptr) <- readThunk target >>= \case

328− Left err -> fail $ "thunk update: " <> show err

329− Right c -> return $ case c of

330− ThunkData_Packed t -> (target, t)

331− ThunkData_Checkout _ -> fail "cannot update an unpacked thunk"

328+ Left err -> failWith $ T.pack $ "thunk update: " <> show err

329+ Right c -> case c of

330+ ThunkData_Packed t -> return (target, t)

331+ ThunkData_Checkout _ -> failWith "cannot update an unpacked thunk"

332332 let src = _thunkPtr_source ptr

333333 rev <- getLatestRev src

334334 overwriteThunk overwrite $ ThunkPtr

@@ -458,7 +458,7 @@ unpackThunk thunkDir = readThunk thunkDir >>= \case

458458 mauth <- getHubAuth "github.com"

459459 repoResult <- executeRequestMaybe mauth $ repositoryR (_gitHubSource_owner s) (_gitHubSource_repo s)

460460 githubURI <- either throwIO (return . repoSshUrl) repoResult >>= \case

461− Nothing -> fail "Cannot determine clone URI for thunk source"

461+ Nothing -> failWith "Cannot determine clone URI for thunk source"

462462 Just c -> return $ T.unpack $ getUrl c

463463 withSpinner "Cloning from GitHub ..." (Just $ "Cloned " <> githubURI) $ do

464464 callProcess "hub" --TODO: Depend on hub explicitly

@@ -503,7 +503,7 @@ packThunk :: FilePath

503503 -> String

504504 -> IO ()

505505packThunk thunkDir upstream = readThunk thunkDir >>= \case

506− Left err -> fail $ "thunk pack: " <> show err

506+ Left err -> failWith $ T.pack $ "thunk pack: " <> show err

507507 Right (ThunkData_Packed _) -> failWith "pack: thunk is already packed"

508508 Right (ThunkData_Checkout _) -> do

509509 thunkPtr <- getThunkPtr thunkDir upstream

@@ -520,7 +520,7 @@ getThunkPtr thunkDir upstream = do

520520 False -> do

521521 statusDebug <- readProcess "hub"

522522 [ "-C", thunkDir, "status", "--ignored" ] ""

523− fail $ unlines $

523+ failWith $ T.pack $ unlines $

524524 [ "thunk pack: thunk checkout contains unsaved modifications"

525525 , "git status:"

526526 ] ++ lines statusDebug

@@ -530,7 +530,7 @@ getThunkPtr thunkDir upstream = do

530530 stashOutput <- readProcess "hub" [ "-C", thunkDir, "stash", "list" ] ""

531531 case null stashOutput of

532532 False -> do

533− fail $ unlines $

533+ failWith $ T.pack $ unlines $

534534 [ "thunk pack: thunk checkout has stashes"

535535 , "git stash list:"

536536 ] ++ lines stashOutput

@@ -544,7 +544,7 @@ getThunkPtr thunkDir upstream = do

544544 remotes <- lines <$> readProcess "hub" [ "-C", thunkDir, "remote" ] ""

545545 --Check that the upstream specified actually exists

546546 case L.find (== upstream) remotes of

547− Nothing -> fail $ "thunk pack: upstream " <> upstream <> " does not exist"

547+ Nothing -> failWith $ T.pack $ "thunk pack: upstream " <> upstream <> " does not exist"

548548 Just _ -> return ()

549549 -- iterate over cartesian product

550550 forM_ repoHeads $ \hd -> do

@@ -558,7 +558,7 @@ getThunkPtr thunkDir upstream = do

558558 , "remotes/" <> rm <> "/" <> hd

559559 ] ""

560560 case remoteMergeRev == localRev of

561− False -> fail $ mconcat [ "thunk unpack: branch ", hd, " has not been pushed to ", rm ]

561+ False -> failWith $ T.pack $ mconcat [ "thunk unpack: branch ", hd, " has not been pushed to ", rm ]

562562 True -> return ()

563563

564564 --We assume it's safe to pack the thunk at this point

@@ -571,7 +571,7 @@ getThunkPtr thunkDir upstream = do

571571 mRemoteUri = parseURIReference remoteUri'

572572 <|> parseSshShorthand remoteUri'

573573 thunkPtr <- case mRemoteUri of

574− Nothing -> fail uriParseFailure

574+ Nothing -> failWith $ T.pack uriParseFailure

575575 Just remoteUri -> do

576576 refs <- fmap (refsToTuples . words) . lines <$> readProcess "hub"

577577 [ "-C"

@@ -631,7 +631,7 @@ getThunkPtr thunkDir upstream = do

631631 case uriScheme u of

632632 "https:" -> return ()

633633 "git:" -> return ()

634− _ -> fail $ "thunk pack: obelisk currently only supports https and git protocols for non-GitHub remotes"

634+ _ -> failWith "thunk pack: obelisk currently only supports https and git protocols for non-GitHub remotes"

635635 $notImplemented

636636 parseSshShorthand uri' = do

637637 -- This is what git does to check that the remote