    {-# 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
    [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
    (*>)

    -- | 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 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
          [] -> []