module WithCli.Result (
Result(..),
handleResult,
sanitize,
) where
import Prelude ()
import Prelude.Compat
import Control.Arrow
import Data.List.Compat
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 ++ b)
Errors errs <*> Success _ = Errors errs
Success _ <*> Errors errs = Errors errs
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 result of
Success a -> return a
OutputAndExit message -> do
putStr $ sanitize message
exitWith ExitSuccess
Errors errs -> do
hPutStr stderr $ sanitize $ intercalate "\n" errs
exitWith $ ExitFailure 1
sanitize :: String -> String
sanitize =
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
[] -> []