module WithCli.Result (
Result(..),
(|>),
handleResult,
sanitizeMessage,
sanitize,
) where
import Prelude ()
import Prelude.Compat
import Control.Arrow
import System.Exit
import System.IO
data Result a
= Success a
| Errors String
| OutputAndExit String
deriving (Show, Eq, Ord, Functor)
instance Applicative Result where
pure = Success
OutputAndExit message <*> _ = OutputAndExit message
_ <*> OutputAndExit message = OutputAndExit message
Success f <*> Success x = Success (f x)
Errors a <*> Errors b = Errors (a ++ "\n" ++ b)
Errors err <*> Success _ = Errors err
Success _ <*> Errors err = Errors err
(|>) :: Result a -> Result b -> Result b
a |> b = a >>= const b
instance Monad Result where
return = pure
Success a >>= b = b a
Errors errs >>= _ = Errors errs
OutputAndExit message >>= _ = OutputAndExit message
(>>) = (*>)
handleResult :: Result a -> IO a
handleResult result = case sanitize result of
Success a -> return a
OutputAndExit message -> do
putStr message
exitWith ExitSuccess
Errors err -> do
hPutStr stderr err
exitWith $ ExitFailure 1
sanitize :: Result a -> Result a
sanitize = \ case
Success a -> Success a
OutputAndExit message -> OutputAndExit $ sanitizeMessage message
Errors messages -> Errors $ sanitizeMessage messages
sanitizeMessage :: String -> String
sanitizeMessage =
lines >>>
map stripTrailingSpaces >>>
filter (not . null) >>>
map (++ "\n") >>>
concat
stripTrailingSpaces :: String -> String
stripTrailingSpaces =
reverse . inner . dropWhile (`elem` [' ', '\n']) . reverse
where
inner s = case s of
('\n' : ' ' : r) -> inner ('\n' : r)
(a : r) -> a : inner r
[] -> []