{-|

Module      : EasyArgs
Description : Parses arguments
Copyright   : (C) Jonathan Lamothe
License     : LGPL-3
Maintainer  : jonathan@jlamothe.net
Stability   : experimental
Portability : POSIX

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this program.  If not, see
<https://www.gnu.org/licenses/>.

-}

module EasyArgs (Arg (..), parseArg, parseArgs) where

-- | Defines an argument type
data Arg
  = Dash
  -- ^ Represents a single dash i.e.: @"-"@
  | DoubleDash
  -- ^ Represents a double dash i.e.: @"--"@
  | Flag Char
  -- ^ Represents a single character flag, e.g.: @"-a"@
  | Tag String
  -- ^ Represents a multi-character tag, e.g.: @"--foo"@
  | ArgText String
  -- ^ Represents a non-dashed argument, e.g.: @"foo"@
  deriving (Arg -> Arg -> Bool
(Arg -> Arg -> Bool) -> (Arg -> Arg -> Bool) -> Eq Arg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arg -> Arg -> Bool
$c/= :: Arg -> Arg -> Bool
== :: Arg -> Arg -> Bool
$c== :: Arg -> Arg -> Bool
Eq, 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
showList :: [Arg] -> ShowS
$cshowList :: [Arg] -> ShowS
show :: Arg -> String
$cshow :: Arg -> String
showsPrec :: Int -> Arg -> ShowS
$cshowsPrec :: Int -> Arg -> ShowS
Show)

-- | Parses a single argument string to a list of 'Arg's
parseArg :: String -> [Arg]
parseArg :: String -> [Arg]
parseArg String
"-"           = [Arg
Dash]
parseArg String
"--"          = [Arg
DoubleDash]
parseArg (Char
'-':Char
'-':String
str) = [String -> Arg
Tag String
str]
parseArg (Char
'-':String
str)     = (Char -> Arg) -> String -> [Arg]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Arg
Flag String
str
parseArg String
str           = [String -> Arg
ArgText String
str]

-- | Parses a list of argument strings to a list of 'Arg's
parseArgs :: [String] -> [Arg]
parseArgs :: [String] -> [Arg]
parseArgs = (String -> [Arg]) -> [String] -> [Arg]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [Arg]
parseArg

--jl