{-# 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
showList :: [Result a] -> ShowS
$cshowList :: forall a. Show a => [Result a] -> ShowS
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> 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
/= :: Result a -> Result a -> Bool
$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
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
min :: Result a -> Result a -> Result a
$cmin :: forall a. Ord a => Result a -> Result a -> Result a
max :: Result a -> Result a -> Result a
$cmax :: forall a. Ord a => Result a -> Result a -> Result a
>= :: 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
$c< :: forall a. Ord a => Result a -> Result a -> Bool
compare :: Result a -> Result a -> Ordering
$ccompare :: forall a. Ord a => Result a -> Result a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Result a)
Ord, a -> Result b -> Result a
(a -> b) -> Result a -> Result b
(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
<$ :: a -> Result b -> Result a
$c<$ :: forall a b. a -> Result b -> Result a
fmap :: (a -> b) -> Result a -> Result b
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
Functor)
instance Applicative Result where
pure :: a -> Result a
pure = a -> Result a
forall a. a -> Result a
Success
OutputAndExit message :: String
message <*> :: Result (a -> b) -> Result a -> Result b
<*> _ = String -> Result b
forall a. String -> Result a
OutputAndExit String
message
_ <*> OutputAndExit message :: String
message = String -> Result b
forall a. String -> Result a
OutputAndExit String
message
Success f :: a -> b
f <*> Success x :: a
x = b -> Result b
forall a. a -> Result a
Success (a -> b
f a
x)
Errors a :: String
a <*> Errors b :: String
b = String -> Result b
forall a. String -> Result a
Errors (String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b)
Errors err :: String
err <*> Success _ = String -> Result b
forall a. String -> Result a
Errors String
err
Success _ <*> Errors err :: String
err = String -> Result b
forall a. String -> Result a
Errors String
err
(|>) :: Result a -> Result b -> Result b
a :: Result a
a |> :: Result a -> Result b -> Result b
|> b :: Result b
b = Result a
a 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 :: a -> Result a
return = a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Success a :: a
a >>= :: Result a -> (a -> Result b) -> Result b
>>= b :: a -> Result b
b = a -> Result b
b a
a
Errors errs :: String
errs >>= _ = String -> Result b
forall a. String -> Result a
Errors String
errs
OutputAndExit message :: String
message >>= _ = String -> Result b
forall a. String -> Result a
OutputAndExit String
message
>> :: Result a -> Result b -> Result 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 :: Result a -> IO a
handleResult result :: Result a
result = case Result a -> Result a
forall a. Result a -> Result a
sanitize Result a
result of
Success a :: a
a -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
OutputAndExit message :: String
message -> do
String -> IO ()
putStr String
message
ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith ExitCode
ExitSuccess
Errors err :: 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 1
sanitize :: Result a -> Result a
sanitize :: Result a -> Result a
sanitize = \ case
Success a :: a
a -> a -> Result a
forall a. a -> Result a
Success a
a
OutputAndExit message :: 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 messages :: 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 (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]
++ "\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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [' ', '\n']) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse
where
inner :: ShowS
inner s :: String
s = case String
s of
('\n' : ' ' : r :: String
r) -> ShowS
inner ('\n' Char -> ShowS
forall a. a -> [a] -> [a]
: String
r)
(a :: Char
a : r :: String
r) -> Char
a Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
inner String
r
[] -> []