{-# 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

-- | Type to wrap results from 'WithCli.Pure.withCliPure'.
data Result a
  = Success a
    -- ^ The CLI was used correctly and a value of type @a@ was
    --   successfully constructed.
  | Errors String
    -- ^ The CLI was used incorrectly. The 'Result' contains error messages.
    --
    --   It can also happen that the data type you're trying to use isn't
    --   supported. See the
    --   <https://github.com/zalora/getopt-generics#getopt-generics README> for
    --   details.
  | OutputAndExit String
    -- ^ The CLI was used with @--help@. The 'Result' contains the help message.
  deriving (Int -> Result a -> ShowS
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
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, Result a -> Result a -> Bool
Result a -> Result a -> Ordering
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
Ord, 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
<$ :: forall a b. a -> Result b -> Result a
$c<$ :: forall a b. a -> Result b -> Result a
fmap :: forall a b. (a -> b) -> Result a -> Result b
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
Functor)

instance Applicative Result where
  pure :: forall a. a -> Result a
pure = forall a. a -> Result a
Success
  OutputAndExit String
message <*> :: forall a b. Result (a -> b) -> Result a -> Result b
<*> Result a
_ = forall a. String -> Result a
OutputAndExit String
message
  Result (a -> b)
_ <*> OutputAndExit String
message = forall a. String -> Result a
OutputAndExit String
message
  Success a -> b
f <*> Success a
x = forall a. a -> Result a
Success (a -> b
f a
x)
  Errors String
a <*> Errors String
b = forall a. String -> Result a
Errors (String
a forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String
b)
  Errors String
err <*> Success a
_ = forall a. String -> Result a
Errors String
err
  Success a -> b
_ <*> Errors String
err = 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. a -> b -> a
const Result b
b

instance Monad Result where
  return :: forall a. a -> Result a
return = 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
_ = forall a. String -> Result a
Errors String
errs
  OutputAndExit String
message >>= a -> Result b
_ = forall a. String -> Result a
OutputAndExit String
message

  >> :: forall a b. Result a -> Result b -> Result b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

-- | Handles an input of type @'Result' a@:
--
-- - On @'Success' a@ it returns the value @a@.
-- - On @'OutputAndExit' message@ it writes the message to 'stdout' and throws
--   'ExitSuccess'.
-- - On @'Errors' errs@ it writes the error messages to 'stderr' and throws
--   @'ExitFailure' 1@.
--
-- This is used by 'WithCli.withCli' to handle parse results.
handleResult :: Result a -> IO a
handleResult :: forall a. Result a -> IO a
handleResult Result a
result = case forall a. Result a -> Result a
sanitize Result a
result of
  Success a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  OutputAndExit String
message -> do
    String -> IO ()
putStr String
message
    forall a. ExitCode -> IO a
exitWith ExitCode
ExitSuccess
  Errors String
err -> do
    Handle -> String -> IO ()
hPutStr Handle
stderr String
err
    forall a. ExitCode -> IO a
exitWith 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 -> forall a. a -> Result a
Success a
a
  OutputAndExit String
message -> forall a. String -> Result a
OutputAndExit forall a b. (a -> b) -> a -> b
$ ShowS
sanitizeMessage String
message
  Errors String
messages -> forall a. String -> Result a
Errors forall a b. (a -> b) -> a -> b
$ ShowS
sanitizeMessage String
messages

sanitizeMessage :: String -> String
sanitizeMessage :: ShowS
sanitizeMessage =
  String -> [String]
lines forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  forall a b. (a -> b) -> [a] -> [b]
map ShowS
stripTrailingSpaces forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a] -> [a]
++ String
"\n") forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat

stripTrailingSpaces :: String -> String
stripTrailingSpaces :: ShowS
stripTrailingSpaces =
  forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
inner forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
' ', Char
'\n']) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
  where
    inner :: ShowS
inner String
s = case String
s of
      (Char
'\n' : Char
' ' : String
r) -> ShowS
inner (Char
'\n' forall a. a -> [a] -> [a]
: String
r)
      (Char
a : String
r) -> Char
a forall a. a -> [a] -> [a]
: ShowS
inner String
r
      [] -> []