{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
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 (Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> String
(Int -> Result a -> ShowS)
-> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
showsPrec :: Int -> Result a -> ShowS
$cshow :: forall a. Show a => Result a -> String
show :: Result a -> String
$cshowList :: forall a. Show a => [Result a] -> ShowS
showList :: [Result a] -> ShowS
Show, Result a -> Result a -> Bool
(Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool) -> Eq (Result a)
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
/= :: Result a -> Result a -> Bool
Eq, Eq (Result a)
Eq (Result a) =>
(Result a -> Result a -> Ordering)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool)
-> (Result a -> Result a -> Result a)
-> (Result a -> Result a -> Result a)
-> Ord (Result a)
Result a -> Result a -> Bool
Result a -> Result a -> Ordering
Result a -> Result a -> Result a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Result a)
forall a. Ord a => Result a -> Result a -> Bool
forall a. Ord a => Result a -> Result a -> Ordering
forall a. Ord a => Result a -> Result a -> Result a
$ccompare :: forall a. Ord a => Result a -> Result a -> Ordering
compare :: Result a -> Result a -> Ordering
$c< :: forall a. Ord a => Result a -> Result a -> Bool
< :: Result a -> Result a -> Bool
$c<= :: forall a. Ord a => Result a -> Result a -> Bool
<= :: Result a -> Result a -> Bool
$c> :: forall a. Ord a => Result a -> Result a -> Bool
> :: Result a -> Result a -> Bool
$c>= :: forall a. Ord a => Result a -> Result a -> Bool
>= :: Result a -> Result a -> Bool
$cmax :: forall a. Ord a => Result a -> Result a -> Result a
max :: Result a -> Result a -> Result a
$cmin :: forall a. Ord a => Result a -> Result a -> Result a
min :: Result a -> Result a -> Result a
Ord, (forall a b. (a -> b) -> Result a -> Result b)
-> (forall a b. a -> Result b -> Result a) -> Functor Result
forall a b. a -> Result b -> Result a
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
fmap :: forall a b. (a -> b) -> Result a -> Result b
$c<$ :: forall a b. a -> Result b -> Result a
<$ :: forall a b. a -> Result b -> Result a
Functor)
instance Applicative Result where
pure :: forall a. a -> Result a
pure = a -> Result a
forall a. a -> Result a
Success
OutputAndExit String
message <*> :: forall a b. Result (a -> b) -> Result a -> Result b
<*> Result a
_ = String -> Result b
forall a. String -> Result a
OutputAndExit String
message
Result (a -> b)
_ <*> OutputAndExit String
message = String -> Result b
forall a. String -> Result a
OutputAndExit String
message
Success a -> b
f <*> Success a
x = b -> Result b
forall a. a -> Result a
Success (a -> b
f a
x)
Errors String
a <*> Errors String
b = String -> Result b
forall a. String -> Result a
Errors (String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b)
Errors String
err <*> Success a
_ = String -> Result b
forall a. String -> Result a
Errors String
err
Success a -> b
_ <*> Errors String
err = String -> Result b
forall a. String -> Result a
Errors String
err
(|>) :: Result a -> Result b -> Result b
Result a
a |> :: forall a b. Result a -> Result b -> Result b
|> Result b
b = Result a
a Result a -> (a -> Result b) -> Result b
forall a b. Result a -> (a -> Result b) -> Result b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Result b -> a -> Result b
forall a b. a -> b -> a
const Result b
b
instance Monad Result where
return :: forall a. a -> Result a
return = a -> Result a
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Success a
a >>= :: forall a b. Result a -> (a -> Result b) -> Result b
>>= a -> Result b
b = a -> Result b
b a
a
Errors String
errs >>= a -> Result b
_ = String -> Result b
forall a. String -> Result a
Errors String
errs
OutputAndExit String
message >>= a -> Result b
_ = String -> Result b
forall a. String -> Result a
OutputAndExit String
message
>> :: forall a b. Result a -> Result b -> Result b
(>>) = Result a -> Result b -> Result b
forall a b. Result a -> Result b -> Result b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
handleResult :: Result a -> IO a
handleResult :: forall a. Result a -> IO a
handleResult Result a
result = case Result a -> Result a
forall a. Result a -> Result a
sanitize Result a
result of
Success a
a -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
OutputAndExit String
message -> do
String -> IO ()
putStr String
message
ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith ExitCode
ExitSuccess
Errors String
err -> do
Handle -> String -> IO ()
hPutStr Handle
stderr String
err
ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO a) -> ExitCode -> IO a
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1
sanitize :: Result a -> Result a
sanitize :: forall a. Result a -> Result a
sanitize = \ case
Success a
a -> a -> Result a
forall a. a -> Result a
Success a
a
OutputAndExit String
message -> String -> Result a
forall a. String -> Result a
OutputAndExit (String -> Result a) -> String -> Result a
forall a b. (a -> b) -> a -> b
$ ShowS
sanitizeMessage String
message
Errors String
messages -> String -> Result a
forall a. String -> Result a
Errors (String -> Result a) -> String -> Result a
forall a b. (a -> b) -> a -> b
$ ShowS
sanitizeMessage String
messages
sanitizeMessage :: String -> String
sanitizeMessage :: ShowS
sanitizeMessage =
String -> [String]
lines (String -> [String]) -> ([String] -> String) -> ShowS
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
stripTrailingSpaces ([String] -> [String])
-> ([String] -> String) -> [String] -> String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
(String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String])
-> ([String] -> String) -> [String] -> String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") ([String] -> [String])
-> ([String] -> String) -> [String] -> String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
stripTrailingSpaces :: String -> String
stripTrailingSpaces :: ShowS
stripTrailingSpaces =
ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
inner ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
' ', Char
'\n']) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse
where
inner :: ShowS
inner String
s = case String
s of
(Char
'\n' : Char
' ' : String
r) -> ShowS
inner (Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
: String
r)
(Char
a : String
r) -> Char
a Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
inner String
r
[] -> []