{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

module OptEnvConf.Args
  ( -- * Public API
    Args (..),
    emptyArgs,
    parseArgs,
    consumeArgument,
    consumeOption,
    consumeSwitch,
    recogniseLeftovers,

    -- ** Internals
    Tomb (..),
    Arg (..),
    parseArg,
    renderArg,
    Dashed (..),
    renderDashed,
    prefixDashed,
  )
where

import Control.Arrow
import Control.Monad
import Data.List (stripPrefix)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.String
import Data.Validity
import Data.Validity.Containers ()
import GHC.Generics (Generic)
import GHC.IsList

-- | Tombstone for leftovers of consumed arguments
data Tomb a
  = -- | Consumed
    Dead
  | -- | Unconsumed
    Live a
  deriving (Int -> Tomb a -> ShowS
[Tomb a] -> ShowS
Tomb a -> String
(Int -> Tomb a -> ShowS)
-> (Tomb a -> String) -> ([Tomb a] -> ShowS) -> Show (Tomb a)
forall a. Show a => Int -> Tomb a -> ShowS
forall a. Show a => [Tomb a] -> ShowS
forall a. Show a => Tomb a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Tomb a -> ShowS
showsPrec :: Int -> Tomb a -> ShowS
$cshow :: forall a. Show a => Tomb a -> String
show :: Tomb a -> String
$cshowList :: forall a. Show a => [Tomb a] -> ShowS
showList :: [Tomb a] -> ShowS
Show, Tomb a -> Tomb a -> Bool
(Tomb a -> Tomb a -> Bool)
-> (Tomb a -> Tomb a -> Bool) -> Eq (Tomb a)
forall a. Eq a => Tomb a -> Tomb a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Tomb a -> Tomb a -> Bool
== :: Tomb a -> Tomb a -> Bool
$c/= :: forall a. Eq a => Tomb a -> Tomb a -> Bool
/= :: Tomb a -> Tomb a -> Bool
Eq, (forall x. Tomb a -> Rep (Tomb a) x)
-> (forall x. Rep (Tomb a) x -> Tomb a) -> Generic (Tomb a)
forall x. Rep (Tomb a) x -> Tomb a
forall x. Tomb a -> Rep (Tomb a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Tomb a) x -> Tomb a
forall a x. Tomb a -> Rep (Tomb a) x
$cfrom :: forall a x. Tomb a -> Rep (Tomb a) x
from :: forall x. Tomb a -> Rep (Tomb a) x
$cto :: forall a x. Rep (Tomb a) x -> Tomb a
to :: forall x. Rep (Tomb a) x -> Tomb a
Generic)

instance (Validity a) => Validity (Tomb a)

instance (IsString a) => IsString (Tomb a) where
  fromString :: String -> Tomb a
fromString = a -> Tomb a
forall a. a -> Tomb a
Live (a -> Tomb a) -> (String -> a) -> String -> Tomb a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. IsString a => String -> a
fromString

data Arg
  = ArgBareDoubleDash
  | ArgBareDash
  | ArgDashed !Bool !(NonEmpty Char) -- True means long
  | ArgPlain !String
  deriving (Int -> Arg -> ShowS
[Arg] -> ShowS
Arg -> String
(Int -> Arg -> ShowS)
-> (Arg -> String) -> ([Arg] -> ShowS) -> Show Arg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Arg -> ShowS
showsPrec :: Int -> Arg -> ShowS
$cshow :: Arg -> String
show :: Arg -> String
$cshowList :: [Arg] -> ShowS
showList :: [Arg] -> ShowS
Show, Arg -> Arg -> Bool
(Arg -> Arg -> Bool) -> (Arg -> Arg -> Bool) -> Eq Arg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Arg -> Arg -> Bool
== :: Arg -> Arg -> Bool
$c/= :: Arg -> Arg -> Bool
/= :: Arg -> Arg -> Bool
Eq, (forall x. Arg -> Rep Arg x)
-> (forall x. Rep Arg x -> Arg) -> Generic Arg
forall x. Rep Arg x -> Arg
forall x. Arg -> Rep Arg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Arg -> Rep Arg x
from :: forall x. Arg -> Rep Arg x
$cto :: forall x. Rep Arg x -> Arg
to :: forall x. Rep Arg x -> Arg
Generic)

instance Validity Arg where
  validate :: Arg -> Validation
validate Arg
arg =
    [Validation] -> Validation
forall a. Monoid a => [a] -> a
mconcat
      [ Arg -> Validation
forall a. (Generic a, GValidity (Rep a)) => a -> Validation
genericValidate Arg
arg,
        case Arg
arg of
          ArgDashed Bool
False (Char
c :| String
_) -> String -> Bool -> Validation
declare String
"The first character of a short dashed is not a dash" (Bool -> Validation) -> Bool -> Validation
forall a b. (a -> b) -> a -> b
$ Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-'
          ArgPlain String
s -> String -> Bool -> Validation
declare String
"does not start with a dash" (Bool -> Validation) -> Bool -> Validation
forall a b. (a -> b) -> a -> b
$ case String
s of
            (Char
'-' : String
_) -> Bool
False
            String
_ -> Bool
True
          Arg
_ -> Validation
valid
      ]

instance IsString Arg where
  fromString :: String -> Arg
fromString = String -> Arg
parseArg

parseArg :: String -> Arg
parseArg :: String -> Arg
parseArg = \case
  Char
'-' : Char
'-' : String
rest -> case String -> Maybe (NonEmpty Char)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty String
rest of
    Maybe (NonEmpty Char)
Nothing -> Arg
ArgBareDoubleDash
    Just NonEmpty Char
ne -> Bool -> NonEmpty Char -> Arg
ArgDashed Bool
True NonEmpty Char
ne
  Char
'-' : String
rest -> case String -> Maybe (NonEmpty Char)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty String
rest of
    Maybe (NonEmpty Char)
Nothing -> Arg
ArgBareDash
    Just NonEmpty Char
ne -> Bool -> NonEmpty Char -> Arg
ArgDashed Bool
False NonEmpty Char
ne
  String
s -> String -> Arg
ArgPlain String
s

renderArg :: Arg -> String
renderArg :: Arg -> String
renderArg = \case
  Arg
ArgBareDoubleDash -> String
"--"
  Arg
ArgBareDash -> String
"-"
  ArgDashed Bool
l NonEmpty Char
cs -> (if Bool
l then String
"--" else String
"-") String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Char
cs
  ArgPlain String
a -> String
a

-- | An abstraction over '[String]' that makes it easier to implement
-- 'consumeArgument', 'consumeOption' and 'consumeSwitch'.
--
-- In order to implement folded short dashed options, we need to use tombstones
-- for consumed argumentsn
data Args = Args
  { Args -> [Tomb Arg]
argsBefore :: [Tomb Arg],
    Args -> [Tomb Arg]
argsAfter :: [Tomb Arg]
  }
  deriving (Int -> Args -> ShowS
[Args] -> ShowS
Args -> String
(Int -> Args -> ShowS)
-> (Args -> String) -> ([Args] -> ShowS) -> Show Args
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Args -> ShowS
showsPrec :: Int -> Args -> ShowS
$cshow :: Args -> String
show :: Args -> String
$cshowList :: [Args] -> ShowS
showList :: [Args] -> ShowS
Show, Args -> Args -> Bool
(Args -> Args -> Bool) -> (Args -> Args -> Bool) -> Eq Args
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Args -> Args -> Bool
== :: Args -> Args -> Bool
$c/= :: Args -> Args -> Bool
/= :: Args -> Args -> Bool
Eq, (forall x. Args -> Rep Args x)
-> (forall x. Rep Args x -> Args) -> Generic Args
forall x. Rep Args x -> Args
forall x. Args -> Rep Args x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Args -> Rep Args x
from :: forall x. Args -> Rep Args x
$cto :: forall x. Rep Args x -> Args
to :: forall x. Rep Args x -> Args
Generic)

instance Validity Args

instance IsList Args where
  type Item Args = Tomb Arg
  fromList :: [Item Args] -> Args
fromList [Item Args]
l = Args {argsBefore :: [Tomb Arg]
argsBefore = [], argsAfter :: [Tomb Arg]
argsAfter = [Item Args]
[Tomb Arg]
l}
  toList :: Args -> [Item Args]
toList = Args -> [Item Args]
Args -> [Tomb Arg]
rebuildArgs

-- | Empty list of arguments
emptyArgs :: Args
emptyArgs :: Args
emptyArgs = [String] -> Args
parseArgs []

rebuildArgs :: Args -> [Tomb Arg]
rebuildArgs :: Args -> [Tomb Arg]
rebuildArgs Args {[Tomb Arg]
argsBefore :: Args -> [Tomb Arg]
argsAfter :: Args -> [Tomb Arg]
argsBefore :: [Tomb Arg]
argsAfter :: [Tomb Arg]
..} = [Tomb Arg]
argsBefore [Tomb Arg] -> [Tomb Arg] -> [Tomb Arg]
forall a. [a] -> [a] -> [a]
++ [Tomb Arg]
argsAfter

-- | Create 'Args' with all-live arguments and cursor at the start.
parseArgs :: [String] -> Args
parseArgs :: [String] -> Args
parseArgs [String]
args = Args {argsBefore :: [Tomb Arg]
argsBefore = [], argsAfter :: [Tomb Arg]
argsAfter = (String -> Tomb Arg) -> [String] -> [Tomb Arg]
forall a b. (a -> b) -> [a] -> [b]
map (Arg -> Tomb Arg
forall a. a -> Tomb a
Live (Arg -> Tomb Arg) -> (String -> Arg) -> String -> Tomb Arg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Arg
parseArg) [String]
args}

-- | Consume a single positional argument.
--
-- The result are all possible results
consumeArgument :: Args -> [(Maybe String, Args)]
consumeArgument :: Args -> [(Maybe String, Args)]
consumeArgument Args
as = do
  -- There's always the last-ditch option of consuming nothing in case of
  -- things like a default command.
  let addConsumeNothing :: [(Maybe String, Args)] -> [(Maybe String, Args)]
addConsumeNothing = \case
        [] -> [(Maybe String
forall a. Maybe a
Nothing, Args
as)]
        r :: [(Maybe String, Args)]
r@(t :: (Maybe String, Args)
t@(Maybe String
mA, Args
_) : [(Maybe String, Args)]
rest) -> case Maybe String
mA of
          -- If not consuming anything is already an option, don't add it to the end.
          Maybe String
Nothing -> [(Maybe String, Args)]
r
          Just String
_ -> (Maybe String, Args)
t (Maybe String, Args)
-> [(Maybe String, Args)] -> [(Maybe String, Args)]
forall a. a -> [a] -> [a]
: [(Maybe String, Args)] -> [(Maybe String, Args)]
addConsumeNothing [(Maybe String, Args)]
rest

  [(Maybe String, Args)] -> [(Maybe String, Args)]
addConsumeNothing ([(Maybe String, Args)] -> [(Maybe String, Args)])
-> [(Maybe String, Args)] -> [(Maybe String, Args)]
forall a b. (a -> b) -> a -> b
$ case Args -> [Tomb Arg]
argsAfter Args
as of
    [] -> []
    (Tomb Arg
firstArg : [Tomb Arg]
afters) ->
      let befores :: [Tomb Arg]
befores = Args -> [Tomb Arg]
argsBefore Args
as
          consumed :: Args
consumed = [Tomb Arg] -> [Tomb Arg] -> Args
Args ([Tomb Arg]
befores [Tomb Arg] -> [Tomb Arg] -> [Tomb Arg]
forall a. [a] -> [a] -> [a]
++ [Tomb Arg
forall a. Tomb a
Dead]) [Tomb Arg]
afters
       in case Tomb Arg
firstArg of
            -- Skip any dead argument
            Tomb Arg
Dead -> Args -> [(Maybe String, Args)]
consumeArgument Args
consumed
            Live Arg
a -> case Arg
a of
              -- Plain argument: that's the only option, consume it.
              ArgPlain String
plain -> [(String -> Maybe String
forall a. a -> Maybe a
Just String
plain, Args
consumed)]
              -- A single dash is always an argument
              Arg
ArgBareDash -> [(String -> Maybe String
forall a. a -> Maybe a
Just String
"-", Args
consumed)]
              -- Bare double-dash
              Arg
ArgBareDoubleDash -> case [Tomb Arg]
afters of
                -- If it's the last argument, consume it as an argument
                [] -> [(String -> Maybe String
forall a. a -> Maybe a
Just String
"--", Args
consumed)]
                -- If there's only a dead argument after the double dash, that
                -- means we've been parsing bare args and are now done.
                -- We can stop consuming but get rid of the tombstone as well.
                -- Otherwise there will be a leftover unconsumed '--' after all parsing is done.
                [Tomb Arg
Dead] -> [(Maybe String
forall a. Maybe a
Nothing, [Tomb Arg] -> [Tomb Arg] -> Args
Args [Tomb Arg]
befores [])]
                -- If it's not the last argument, anything after here is an argument.
                -- In order to not have to maintain whether the cursor is after
                -- a bare double dash already, we keep the cursor here and just
                -- pop the args as they come.
                [Tomb Arg]
_ ->
                  let go :: [Tomb a] -> Maybe (a, [Tomb a])
go = \case
                        [] -> Maybe (a, [Tomb a])
forall a. Maybe a
Nothing
                        (Tomb a
Dead : [Tomb a]
rest) -> [Tomb a] -> Maybe (a, [Tomb a])
go [Tomb a]
rest
                        (Live a
a' : [Tomb a]
rest) -> (a, [Tomb a]) -> Maybe (a, [Tomb a])
forall a. a -> Maybe a
Just (a
a', [Tomb a]
rest)
                   in case [Tomb Arg] -> Maybe (Arg, [Tomb Arg])
forall {a}. [Tomb a] -> Maybe (a, [Tomb a])
go [Tomb Arg]
afters of
                        Maybe (Arg, [Tomb Arg])
Nothing -> [(Maybe String
forall a. Maybe a
Nothing, Args
as)]
                        Just (Arg
firstLive, [Tomb Arg]
rest) ->
                          -- We need to leave the dead argument there so that
                          -- we don't consume the double-dash as an argument
                          -- after consuming all the arguments after it as bare
                          -- arguments.
                          [ ( String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Arg -> String
renderArg Arg
firstLive,
                              [Tomb Arg] -> [Tomb Arg] -> Args
Args [Tomb Arg]
befores (Arg -> Tomb Arg
forall a. a -> Tomb a
Live Arg
ArgBareDoubleDash Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
: Tomb Arg
forall a. Tomb a
Dead Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
: [Tomb Arg]
rest)
                            )
                          ]
              ArgDashed {} ->
                -- Dead after dashed, two options, in order that they should be considered:
                --   * The dashed is a switch (don't consume an arg)
                --   * The dashed is an argument
                -- TODO we need to continue looking too
                let switchCase :: [(Maybe String, Args)]
switchCase =
                      Args -> [(Maybe String, Args)]
consumeArgument ([Tomb Arg] -> [Tomb Arg] -> Args
Args ([Tomb Arg]
befores [Tomb Arg] -> [Tomb Arg] -> [Tomb Arg]
forall a. [a] -> [a] -> [a]
++ [Tomb Arg
firstArg]) [Tomb Arg]
afters)
                        [(Maybe String, Args)]
-> [(Maybe String, Args)] -> [(Maybe String, Args)]
forall a. [a] -> [a] -> [a]
++ [ (String -> Maybe String
forall a. a -> Maybe a
Just (Arg -> String
renderArg Arg
a), Args
consumed)
                           ]
                 in case [Tomb Arg]
afters of
                      -- Last argument is is dashed, that's the same as being followed by a dead argument
                      [] -> [(Maybe String, Args)]
switchCase
                      (Tomb Arg
Dead : [Tomb Arg]
_) -> [(Maybe String, Args)]
switchCase
                      (Live Arg
a' : [Tomb Arg]
rest) ->
                        -- Live after dashed, three options, in order that they should be considered:
                        --   * The dashed is an option and the live is the value
                        --   * The dashed is a switch and the live is an argument
                        --   * The dashed is an argument
                        ( case Arg
a' of
                            ArgDashed {} ->
                              Args -> [(Maybe String, Args)]
consumeArgument ([Tomb Arg] -> [Tomb Arg] -> Args
Args ([Tomb Arg]
befores [Tomb Arg] -> [Tomb Arg] -> [Tomb Arg]
forall a. [a] -> [a] -> [a]
++ [Arg -> Tomb Arg
forall a. a -> Tomb a
Live Arg
a]) [Tomb Arg]
afters)
                                [(Maybe String, Args)]
-> [(Maybe String, Args)] -> [(Maybe String, Args)]
forall a. [a] -> [a] -> [a]
++ [ (String -> Maybe String
forall a. a -> Maybe a
Just (Arg -> String
renderArg Arg
a), Args
consumed)
                                   ]
                            Arg
_ ->
                              Args -> [(Maybe String, Args)]
consumeArgument ([Tomb Arg] -> [Tomb Arg] -> Args
Args ([Tomb Arg]
befores [Tomb Arg] -> [Tomb Arg] -> [Tomb Arg]
forall a. [a] -> [a] -> [a]
++ [Arg -> Tomb Arg
forall a. a -> Tomb a
Live Arg
a, Arg -> Tomb Arg
forall a. a -> Tomb a
Live Arg
a']) [Tomb Arg]
rest)
                                [(Maybe String, Args)]
-> [(Maybe String, Args)] -> [(Maybe String, Args)]
forall a. [a] -> [a] -> [a]
++ [ (String -> Maybe String
forall a. a -> Maybe a
Just (Arg -> String
renderArg Arg
a'), [Tomb Arg] -> [Tomb Arg] -> Args
Args ([Tomb Arg]
befores [Tomb Arg] -> [Tomb Arg] -> [Tomb Arg]
forall a. [a] -> [a] -> [a]
++ [Arg -> Tomb Arg
forall a. a -> Tomb a
Live Arg
a, Tomb Arg
forall a. Tomb a
Dead]) [Tomb Arg]
rest),
                                     (String -> Maybe String
forall a. a -> Maybe a
Just (Arg -> String
renderArg Arg
a), Args
consumed)
                                   ]
                        )

-- | Consume an option.
--
-- This supports:
--
--     * @["-f", "foo"]@
--     * @["--foo", "foo"]@
--     * @["-df", "foo"]@
--     * @["--foo=foo"]@
--     * @["-ffoo"]@
consumeOption :: [Dashed] -> Args -> Maybe (String, Args)
consumeOption :: [Dashed] -> Args -> Maybe (String, Args)
consumeOption [Dashed]
dasheds Args
as = do
  case [Tomb Arg] -> Maybe (String, [Tomb Arg])
go (Args -> [Tomb Arg]
argsBefore Args
as) of
    Just (String
val, [Tomb Arg]
newBefores) -> (String, Args) -> Maybe (String, Args)
forall a. a -> Maybe a
Just (String
val, Args
as {argsBefore = newBefores})
    Maybe (String, [Tomb Arg])
Nothing ->
      -- TODO option value on the border
      case [Tomb Arg] -> Maybe (String, [Tomb Arg])
go (Args -> [Tomb Arg]
argsAfter Args
as) of
        Just (String
val, [Tomb Arg]
newAfters) -> (String, Args) -> Maybe (String, Args)
forall a. a -> Maybe a
Just (String
val, Args
as {argsAfter = newAfters})
        Maybe (String, [Tomb Arg])
Nothing -> Maybe (String, Args)
forall a. Maybe a
Nothing
  where
    go :: [Tomb Arg] -> Maybe (String, [Tomb Arg])
    go :: [Tomb Arg] -> Maybe (String, [Tomb Arg])
go = \case
      [] -> Maybe (String, [Tomb Arg])
forall a. Maybe a
Nothing
      -- Skip dead args
      (Tomb Arg
Dead : [Tomb Arg]
rest) -> ([Tomb Arg] -> [Tomb Arg])
-> (String, [Tomb Arg]) -> (String, [Tomb Arg])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Tomb Arg
forall a. Tomb a
Dead Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
:) ((String, [Tomb Arg]) -> (String, [Tomb Arg]))
-> Maybe (String, [Tomb Arg]) -> Maybe (String, [Tomb Arg])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tomb Arg] -> Maybe (String, [Tomb Arg])
go [Tomb Arg]
rest
      -- If we find a live key, try to consume it.
      (Live Arg
k : [Tomb Arg]
rest) ->
        case Arg
k of
          -- We can either consume it as-is, or as a shorthand option.
          Arg
ArgBareDoubleDash -> Maybe (String, [Tomb Arg])
forall a. Maybe a
Nothing
          ArgDashed Bool
isLong NonEmpty Char
cs ->
            case [Dashed] -> Bool -> NonEmpty Char -> Maybe String
consumeDashedShorthandOption [Dashed]
dasheds Bool
isLong NonEmpty Char
cs of
              Just String
v -> (String, [Tomb Arg]) -> Maybe (String, [Tomb Arg])
forall a. a -> Maybe a
Just (String
v, Tomb Arg
forall a. Tomb a
Dead Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
: [Tomb Arg]
rest)
              Maybe String
Nothing ->
                case [Tomb Arg]
rest of
                  (Live Arg
v : [Tomb Arg]
rest') ->
                    case [Dashed] -> Bool -> NonEmpty Char -> Maybe (Maybe (NonEmpty Char))
consumeDashedOption [Dashed]
dasheds Bool
isLong NonEmpty Char
cs of
                      Maybe (Maybe (NonEmpty Char))
Nothing -> ([Tomb Arg] -> [Tomb Arg])
-> (String, [Tomb Arg]) -> (String, [Tomb Arg])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Arg -> Tomb Arg
forall a. a -> Tomb a
Live Arg
k Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
:) ((String, [Tomb Arg]) -> (String, [Tomb Arg]))
-> Maybe (String, [Tomb Arg]) -> Maybe (String, [Tomb Arg])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tomb Arg] -> Maybe (String, [Tomb Arg])
go [Tomb Arg]
rest
                      Just Maybe (NonEmpty Char)
Nothing -> (String, [Tomb Arg]) -> Maybe (String, [Tomb Arg])
forall a. a -> Maybe a
Just (Arg -> String
renderArg Arg
v, Tomb Arg
forall a. Tomb a
Dead Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
: [Tomb Arg]
rest')
                      Just (Just NonEmpty Char
cs') -> (String, [Tomb Arg]) -> Maybe (String, [Tomb Arg])
forall a. a -> Maybe a
Just (Arg -> String
renderArg Arg
v, Arg -> Tomb Arg
forall a. a -> Tomb a
Live (Bool -> NonEmpty Char -> Arg
ArgDashed Bool
isLong NonEmpty Char
cs') Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
: Tomb Arg
forall a. Tomb a
Dead Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
: [Tomb Arg]
rest')
                  [Tomb Arg]
_ -> ([Tomb Arg] -> [Tomb Arg])
-> (String, [Tomb Arg]) -> (String, [Tomb Arg])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Arg -> Tomb Arg
forall a. a -> Tomb a
Live Arg
k Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
:) ((String, [Tomb Arg]) -> (String, [Tomb Arg]))
-> Maybe (String, [Tomb Arg]) -> Maybe (String, [Tomb Arg])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tomb Arg] -> Maybe (String, [Tomb Arg])
go [Tomb Arg]
rest
          Arg
_ -> ([Tomb Arg] -> [Tomb Arg])
-> (String, [Tomb Arg]) -> (String, [Tomb Arg])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Arg -> Tomb Arg
forall a. a -> Tomb a
Live Arg
k Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
:) ((String, [Tomb Arg]) -> (String, [Tomb Arg]))
-> Maybe (String, [Tomb Arg]) -> Maybe (String, [Tomb Arg])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tomb Arg] -> Maybe (String, [Tomb Arg])
go [Tomb Arg]
rest

consumeDashedShorthandOption ::
  [Dashed] ->
  Bool ->
  NonEmpty Char ->
  Maybe String
consumeDashedShorthandOption :: [Dashed] -> Bool -> NonEmpty Char -> Maybe String
consumeDashedShorthandOption [Dashed]
dasheds Bool
isLong NonEmpty Char
cs =
  if Bool
isLong
    then [NonEmpty Char] -> NonEmpty Char -> Maybe String
consumeLongDashedShorthandOption ([Dashed] -> [NonEmpty Char]
longDasheds [Dashed]
dasheds) NonEmpty Char
cs
    else String -> NonEmpty Char -> Maybe String
consumeShortDashedShorthandOption ([Dashed] -> String
shortDasheds [Dashed]
dasheds) NonEmpty Char
cs

consumeLongDashedShorthandOption ::
  [NonEmpty Char] ->
  NonEmpty Char ->
  Maybe String
consumeLongDashedShorthandOption :: [NonEmpty Char] -> NonEmpty Char -> Maybe String
consumeLongDashedShorthandOption [NonEmpty Char]
dasheds NonEmpty Char
cs =
  [Maybe String] -> Maybe String
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe String] -> Maybe String) -> [Maybe String] -> Maybe String
forall a b. (a -> b) -> a -> b
$
    (NonEmpty Char -> Maybe String)
-> [NonEmpty Char] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map
      ( \NonEmpty Char
dashed ->
          String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix
            (NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Char
dashed String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=")
            (NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Char
cs)
      )
      [NonEmpty Char]
dasheds

consumeShortDashedShorthandOption ::
  [Char] ->
  NonEmpty Char ->
  Maybe String
consumeShortDashedShorthandOption :: String -> NonEmpty Char -> Maybe String
consumeShortDashedShorthandOption String
dasheds = \case
  (Char
c :| String
rest)
    | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
dasheds Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest) ->
        String -> Maybe String
forall a. a -> Maybe a
Just String
rest
  NonEmpty Char
_ -> Maybe String
forall a. Maybe a
Nothing

-- Can consume only the last in a folded dashed
consumeDashedOption ::
  [Dashed] ->
  Bool ->
  NonEmpty Char ->
  Maybe (Maybe (NonEmpty Char))
consumeDashedOption :: [Dashed] -> Bool -> NonEmpty Char -> Maybe (Maybe (NonEmpty Char))
consumeDashedOption [Dashed]
dasheds Bool
isLong NonEmpty Char
cs =
  if Bool
isLong
    then
      if NonEmpty Char -> Dashed
DashedLong NonEmpty Char
cs Dashed -> [Dashed] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Dashed]
dasheds
        then Maybe (NonEmpty Char) -> Maybe (Maybe (NonEmpty Char))
forall a. a -> Maybe a
Just Maybe (NonEmpty Char)
forall a. Maybe a
Nothing
        else Maybe (Maybe (NonEmpty Char))
forall a. Maybe a
Nothing
    else
      let (Maybe (NonEmpty Char)
mRest, Char
c) = NonEmpty Char -> (Maybe (NonEmpty Char), Char)
forall a. NonEmpty a -> (Maybe (NonEmpty a), a)
unsnocNE NonEmpty Char
cs
       in if Char -> Dashed
DashedShort Char
c Dashed -> [Dashed] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Dashed]
dasheds
            then Maybe (NonEmpty Char) -> Maybe (Maybe (NonEmpty Char))
forall a. a -> Maybe a
Just Maybe (NonEmpty Char)
mRest
            else Maybe (Maybe (NonEmpty Char))
forall a. Maybe a
Nothing

unsnocNE :: NonEmpty a -> (Maybe (NonEmpty a), a)
unsnocNE :: forall a. NonEmpty a -> (Maybe (NonEmpty a), a)
unsnocNE = [a] -> NonEmpty a -> (Maybe (NonEmpty a), a)
forall {a}. [a] -> NonEmpty a -> (Maybe (NonEmpty a), a)
go []
  where
    go :: [a] -> NonEmpty a -> (Maybe (NonEmpty a), a)
go [a]
acc NonEmpty a
ne =
      let (a
a, Maybe (NonEmpty a)
mRest) = NonEmpty a -> (a, Maybe (NonEmpty a))
forall a. NonEmpty a -> (a, Maybe (NonEmpty a))
NE.uncons NonEmpty a
ne
       in case Maybe (NonEmpty a)
mRest of
            Maybe (NonEmpty a)
Nothing -> ([a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([a] -> Maybe (NonEmpty a)) -> [a] -> Maybe (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc, a
a)
            Just NonEmpty a
rest -> [a] -> NonEmpty a -> (Maybe (NonEmpty a), a)
go (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc) NonEmpty a
rest

-- | Consume a switch.
--
-- This supports:
--
--     * @["-f"]@
--     * @["--foo"]@
--     * @["-df"]@
consumeSwitch :: [Dashed] -> Args -> Maybe Args
consumeSwitch :: [Dashed] -> Args -> Maybe Args
consumeSwitch [Dashed]
dasheds Args
as = do
  case [Tomb Arg] -> Maybe [Tomb Arg]
go (Args -> [Tomb Arg]
argsBefore Args
as) of
    Just [Tomb Arg]
newBefores -> Args -> Maybe Args
forall a. a -> Maybe a
Just (Args -> Maybe Args) -> Args -> Maybe Args
forall a b. (a -> b) -> a -> b
$ Args
as {argsBefore = newBefores}
    Maybe [Tomb Arg]
Nothing -> case [Tomb Arg] -> Maybe [Tomb Arg]
go (Args -> [Tomb Arg]
argsAfter Args
as) of
      Just [Tomb Arg]
newAfters -> Args -> Maybe Args
forall a. a -> Maybe a
Just (Args -> Maybe Args) -> Args -> Maybe Args
forall a b. (a -> b) -> a -> b
$ Args
as {argsAfter = newAfters}
      Maybe [Tomb Arg]
Nothing -> Maybe Args
forall a. Maybe a
Nothing
  where
    go :: [Tomb Arg] -> Maybe [Tomb Arg]
    go :: [Tomb Arg] -> Maybe [Tomb Arg]
go = \case
      [] -> Maybe [Tomb Arg]
forall a. Maybe a
Nothing
      (Tomb Arg
Dead : [Tomb Arg]
rest) -> (Tomb Arg
forall a. Tomb a
Dead Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
:) ([Tomb Arg] -> [Tomb Arg]) -> Maybe [Tomb Arg] -> Maybe [Tomb Arg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tomb Arg] -> Maybe [Tomb Arg]
go [Tomb Arg]
rest
      (Live Arg
o : [Tomb Arg]
rest) -> case Arg
o of
        Arg
ArgBareDoubleDash -> Maybe [Tomb Arg]
forall a. Maybe a
Nothing
        ArgDashed Bool
isLong NonEmpty Char
cs -> case [Dashed]
-> Bool -> NonEmpty Char -> Maybe (Maybe (NonEmpty Char, Bool))
consumeDashedSwitch [Dashed]
dasheds Bool
isLong NonEmpty Char
cs of
          Maybe (Maybe (NonEmpty Char, Bool))
Nothing -> (Arg -> Tomb Arg
forall a. a -> Tomb a
Live Arg
o Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
:) ([Tomb Arg] -> [Tomb Arg]) -> Maybe [Tomb Arg] -> Maybe [Tomb Arg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tomb Arg] -> Maybe [Tomb Arg]
go [Tomb Arg]
rest
          Just Maybe (NonEmpty Char, Bool)
Nothing -> [Tomb Arg] -> Maybe [Tomb Arg]
forall a. a -> Maybe a
Just ([Tomb Arg] -> Maybe [Tomb Arg]) -> [Tomb Arg] -> Maybe [Tomb Arg]
forall a b. (a -> b) -> a -> b
$ Tomb Arg
forall a. Tomb a
Dead Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
: [Tomb Arg]
rest
          Just (Just (NonEmpty Char
cs', Bool
needTombstone)) ->
            let rest' :: [Tomb Arg]
rest' = if Bool
needTombstone then Tomb Arg
forall a. Tomb a
Dead Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
: [Tomb Arg]
rest else [Tomb Arg]
rest
             in [Tomb Arg] -> Maybe [Tomb Arg]
forall a. a -> Maybe a
Just ([Tomb Arg] -> Maybe [Tomb Arg]) -> [Tomb Arg] -> Maybe [Tomb Arg]
forall a b. (a -> b) -> a -> b
$ Arg -> Tomb Arg
forall a. a -> Tomb a
Live (Bool -> NonEmpty Char -> Arg
ArgDashed Bool
isLong NonEmpty Char
cs') Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
: [Tomb Arg]
rest'
        Arg
_ -> do
          [Tomb Arg]
os <- [Tomb Arg] -> Maybe [Tomb Arg]
go [Tomb Arg]
rest
          [Tomb Arg] -> Maybe [Tomb Arg]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Tomb Arg] -> Maybe [Tomb Arg]) -> [Tomb Arg] -> Maybe [Tomb Arg]
forall a b. (a -> b) -> a -> b
$ Arg -> Tomb Arg
forall a. a -> Tomb a
Live Arg
o Tomb Arg -> [Tomb Arg] -> [Tomb Arg]
forall a. a -> [a] -> [a]
: [Tomb Arg]
os

-- Can consume anywhere in a folded dashed, return True if it was the last
-- character because then we need a tombstone.
consumeDashedSwitch ::
  [Dashed] ->
  Bool ->
  NonEmpty Char ->
  Maybe (Maybe (NonEmpty Char, Bool))
consumeDashedSwitch :: [Dashed]
-> Bool -> NonEmpty Char -> Maybe (Maybe (NonEmpty Char, Bool))
consumeDashedSwitch [Dashed]
dasheds Bool
isLong NonEmpty Char
cs =
  if Bool
isLong
    then
      if NonEmpty Char -> Dashed
DashedLong NonEmpty Char
cs Dashed -> [Dashed] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Dashed]
dasheds
        then Maybe (NonEmpty Char, Bool) -> Maybe (Maybe (NonEmpty Char, Bool))
forall a. a -> Maybe a
Just Maybe (NonEmpty Char, Bool)
forall a. Maybe a
Nothing
        else Maybe (Maybe (NonEmpty Char, Bool))
forall a. Maybe a
Nothing
    else String -> NonEmpty Char -> Maybe (Maybe (NonEmpty Char, Bool))
consumeChar ([Dashed] -> String
shortDasheds [Dashed]
dasheds) NonEmpty Char
cs

consumeChar :: [Char] -> NonEmpty Char -> Maybe (Maybe (NonEmpty Char, Bool))
consumeChar :: String -> NonEmpty Char -> Maybe (Maybe (NonEmpty Char, Bool))
consumeChar String
cs = NonEmpty Char -> Maybe (Maybe (NonEmpty Char, Bool))
go
  where
    go :: NonEmpty Char -> Maybe (Maybe (NonEmpty Char, Bool))
    go :: NonEmpty Char -> Maybe (Maybe (NonEmpty Char, Bool))
go (Char
c :| String
rest) =
      if Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
cs
        then Maybe (NonEmpty Char, Bool) -> Maybe (Maybe (NonEmpty Char, Bool))
forall a. a -> Maybe a
Just (Maybe (NonEmpty Char, Bool)
 -> Maybe (Maybe (NonEmpty Char, Bool)))
-> Maybe (NonEmpty Char, Bool)
-> Maybe (Maybe (NonEmpty Char, Bool))
forall a b. (a -> b) -> a -> b
$ (\NonEmpty Char
ne -> (NonEmpty Char
ne, String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest)) (NonEmpty Char -> (NonEmpty Char, Bool))
-> Maybe (NonEmpty Char) -> Maybe (NonEmpty Char, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe (NonEmpty Char)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty String
rest
        else do
          NonEmpty Char
rest' <- String -> Maybe (NonEmpty Char)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty String
rest
          Maybe (NonEmpty Char, Bool)
new <- NonEmpty Char -> Maybe (Maybe (NonEmpty Char, Bool))
go NonEmpty Char
rest'
          Maybe (NonEmpty Char, Bool) -> Maybe (Maybe (NonEmpty Char, Bool))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (NonEmpty Char, Bool)
 -> Maybe (Maybe (NonEmpty Char, Bool)))
-> Maybe (NonEmpty Char, Bool)
-> Maybe (Maybe (NonEmpty Char, Bool))
forall a b. (a -> b) -> a -> b
$
            (NonEmpty Char, Bool) -> Maybe (NonEmpty Char, Bool)
forall a. a -> Maybe a
Just ((NonEmpty Char, Bool) -> Maybe (NonEmpty Char, Bool))
-> (NonEmpty Char, Bool) -> Maybe (NonEmpty Char, Bool)
forall a b. (a -> b) -> a -> b
$
              (NonEmpty Char, Bool)
-> ((NonEmpty Char, Bool) -> (NonEmpty Char, Bool))
-> Maybe (NonEmpty Char, Bool)
-> (NonEmpty Char, Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                (Char
c Char -> String -> NonEmpty Char
forall a. a -> [a] -> NonEmpty a
:| [], Bool
True)
                ((NonEmpty Char -> NonEmpty Char)
-> (NonEmpty Char, Bool) -> (NonEmpty Char, Bool)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Char
c Char -> NonEmpty Char -> NonEmpty Char
forall a. a -> NonEmpty a -> NonEmpty a
NE.<|))
                Maybe (NonEmpty Char, Bool)
new

recogniseLeftovers :: Args -> Maybe (NonEmpty String)
recogniseLeftovers :: Args -> Maybe (NonEmpty String)
recogniseLeftovers Args {[Tomb Arg]
argsBefore :: Args -> [Tomb Arg]
argsAfter :: Args -> [Tomb Arg]
argsBefore :: [Tomb Arg]
argsAfter :: [Tomb Arg]
..} = [String] -> Maybe (NonEmpty String)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([String] -> Maybe (NonEmpty String))
-> [String] -> Maybe (NonEmpty String)
forall a b. (a -> b) -> a -> b
$ [Tomb Arg] -> [String]
live [Tomb Arg]
argsBefore [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Tomb Arg] -> [String]
live ([Tomb Arg] -> [Tomb Arg]
modDoubleDash [Tomb Arg]
argsAfter)
  where
    -- If arguments were parsed after a double dash, don't consider the double
    -- dash leftover.
    modDoubleDash :: [Tomb Arg] -> [Tomb Arg]
modDoubleDash = \case
      Live Arg
ArgBareDoubleDash : Tomb Arg
Dead : [Tomb Arg]
rest -> [Tomb Arg]
rest
      [Tomb Arg]
a -> [Tomb Arg]
a
    live :: [Tomb Arg] -> [String]
live =
      (Tomb Arg -> Maybe String) -> [Tomb Arg] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
        ( \case
            Live Arg
a -> String -> Maybe String
forall a. a -> Maybe a
Just (Arg -> String
renderArg Arg
a)
            Tomb Arg
Dead -> Maybe String
forall a. Maybe a
Nothing
        )

data Dashed
  = DashedShort !Char
  | DashedLong !(NonEmpty Char)
  deriving (Int -> Dashed -> ShowS
[Dashed] -> ShowS
Dashed -> String
(Int -> Dashed -> ShowS)
-> (Dashed -> String) -> ([Dashed] -> ShowS) -> Show Dashed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dashed -> ShowS
showsPrec :: Int -> Dashed -> ShowS
$cshow :: Dashed -> String
show :: Dashed -> String
$cshowList :: [Dashed] -> ShowS
showList :: [Dashed] -> ShowS
Show, Dashed -> Dashed -> Bool
(Dashed -> Dashed -> Bool)
-> (Dashed -> Dashed -> Bool) -> Eq Dashed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dashed -> Dashed -> Bool
== :: Dashed -> Dashed -> Bool
$c/= :: Dashed -> Dashed -> Bool
/= :: Dashed -> Dashed -> Bool
Eq, (forall x. Dashed -> Rep Dashed x)
-> (forall x. Rep Dashed x -> Dashed) -> Generic Dashed
forall x. Rep Dashed x -> Dashed
forall x. Dashed -> Rep Dashed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Dashed -> Rep Dashed x
from :: forall x. Dashed -> Rep Dashed x
$cto :: forall x. Rep Dashed x -> Dashed
to :: forall x. Rep Dashed x -> Dashed
Generic)

instance Validity Dashed

instance IsString Dashed where
  fromString :: String -> Dashed
fromString String
s = case String -> Arg
forall a. IsString a => String -> a
fromString String
s of
    ArgDashed Bool
True NonEmpty Char
cs -> NonEmpty Char -> Dashed
DashedLong NonEmpty Char
cs
    ArgDashed Bool
False (Char
c :| []) -> Char -> Dashed
DashedShort Char
c
    Arg
_ -> String -> Dashed
forall a. HasCallStack => String -> a
error String
"Invalid dashed"

renderDashed :: Dashed -> String
renderDashed :: Dashed -> String
renderDashed = \case
  DashedShort Char
c -> [Char
'-', Char
c]
  DashedLong NonEmpty Char
cs -> Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Char
cs

prefixDashed :: String -> Dashed -> Dashed
prefixDashed :: String -> Dashed -> Dashed
prefixDashed String
p = \case
  DashedLong NonEmpty Char
l -> NonEmpty Char -> Dashed
DashedLong (NonEmpty Char -> Dashed) -> NonEmpty Char -> Dashed
forall a b. (a -> b) -> a -> b
$ String
p String -> NonEmpty Char -> NonEmpty Char
forall a. [a] -> NonEmpty a -> NonEmpty a
`NE.prependList` NonEmpty Char
l
  DashedShort Char
c -> Char -> Dashed
DashedShort Char
c

shortDasheds :: [Dashed] -> [Char]
shortDasheds :: [Dashed] -> String
shortDasheds =
  (Dashed -> Maybe Char) -> [Dashed] -> String
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
    ( \case
        DashedShort Char
c -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
        DashedLong NonEmpty Char
_ -> Maybe Char
forall a. Maybe a
Nothing
    )

longDasheds :: [Dashed] -> [NonEmpty Char]
longDasheds :: [Dashed] -> [NonEmpty Char]
longDasheds =
  (Dashed -> Maybe (NonEmpty Char)) -> [Dashed] -> [NonEmpty Char]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
    ( \case
        DashedLong NonEmpty Char
l -> NonEmpty Char -> Maybe (NonEmpty Char)
forall a. a -> Maybe a
Just NonEmpty Char
l
        DashedShort Char
_ -> Maybe (NonEmpty Char)
forall a. Maybe a
Nothing
    )