{- |
   Module      : Options.Applicative.CmdLine.Util
   Description : Utility functions for working with optparse-applicative
   Copyright   : (c) Tony Zorman  2020 2021 2022
   License     : AGPL
   Maintainer  : Tony Zorman <soliditsallgood@mailbox.org>
   Stability   : experimental
   Portability : non-portable

This module contains utility functions for working with the
'optparse-applicative' library.

Much of the module revolves around easily building options that can take
"multiple arguments" in the form of separated inputs (e.g. program
--option one,two,three,four).  This still honours the POSIX standard for
options only taking a single argument (by not using spaces to separate
the different inputs), while also being very convenient to enter (as
opposed to, say, wrapping everything inside quotes).

Another focus involves connecting the 'attoparsec' library with
'optparse-applicative' (this is often useful when options involve more
complex parsing patterns).
-}
module Options.Applicative.CmdLine.Util
    ( -- * Types
      AttoParser    -- type alias: Data.Attoparsec.Parser

      -- * Interfacing with parsing libraries
    , attoReadM     -- :: AttoParser a -> ReadM a
    , optionA       -- :: AttoParser a -> Mod OptionFields a -> Parser a

      -- * Parsing a list of things
    , splitWith     -- :: AttoParser p -> String -> AttoParser [p]
    , splitOn       -- :: String -> AttoParser [Text]

      -- * Parsing one thing out of a list of things
    , anyOf         -- :: [(a, [Text])] -> AttoParser a
    , anyOfSkip     -- :: (Char -> Bool) -> [(a, [Text])] -> AttoParser a
    , anyOfRM       -- :: [(a, [Text])] -> ReadM a

      -- * Easier parsing for a thing
    , aliases       -- :: Foldable t => t Text -> AttoParser Text

      -- * Misc
    , showSepChars  -- :: Foldable t => t Char -> [Char]
    ) where

import qualified Data.Attoparsec.Text as A
import qualified Data.Text            as T

import Data.Text (Text)
import Options.Applicative (Mod, OptionFields, Parser, ReadM, eitherReader, option)


-- | Less confusion as to which 'Parser' one is referring to.
type AttoParser = A.Parser

-- | Attoparsec <--> optparse-applicative interface.
attoReadM :: AttoParser a -> ReadM a
attoReadM :: forall a. AttoParser a -> ReadM a
attoReadM AttoParser a
p = (String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
eitherReader (AttoParser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
A.parseOnly AttoParser a
p (Text -> Either String a)
-> (String -> Text) -> String -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)

-- | Like 'option', but takes an 'AttoParser' instead of a 'ReadM'.
optionA :: AttoParser a -> Mod OptionFields a -> Parser a
optionA :: forall a. AttoParser a -> Mod OptionFields a -> Parser a
optionA = ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (ReadM a -> Mod OptionFields a -> Parser a)
-> (AttoParser a -> ReadM a)
-> AttoParser a
-> Mod OptionFields a
-> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttoParser a -> ReadM a
forall a. AttoParser a -> ReadM a
attoReadM

-- | Parse a collection of things, separated by some specific characters.
splitWith
    :: AttoParser p  -- ^ Parser for a single entry
    -> String        -- ^ Characters that may be used to separate different entries
    -> AttoParser [p]
splitWith :: forall p. AttoParser p -> String -> AttoParser [p]
splitWith AttoParser p
p String
sepChars = [Parser Text [p]] -> Parser Text [p]
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice
    [ [] [p] -> Parser Text () -> Parser Text [p]
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text ()
forall t. Chunk t => Parser t ()
A.endOfInput
    , AttoParser p
p AttoParser p -> Parser Text Char -> Parser Text [p]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy` (Parser Text ()
A.skipSpace Parser Text () -> Parser Text Char -> Parser Text Char
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Parser Text Char) -> String -> Parser Text Char
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> Parser Text Char
A.char String
sepChars Parser Text Char -> Parser Text () -> Parser Text Char
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
A.skipSpace)
    ]

-- | Like 'splitWith', but the parser is just taking everything it can until the
-- next separation character.
splitOn :: String -> AttoParser [Text]
splitOn :: String -> AttoParser [Text]
splitOn String
sepChars = (Char -> Bool) -> Parser Text
A.takeWhile (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
sepChars) Parser Text -> String -> AttoParser [Text]
forall p. AttoParser p -> String -> AttoParser [p]
`splitWith` String
sepChars

-- | Create a parser that matches case-insensitively for all elements of a given
-- list.
aliases :: Foldable t => t Text -> AttoParser Text
aliases :: forall (t :: * -> *). Foldable t => t Text -> Parser Text
aliases = (Text -> Parser Text) -> t Text -> Parser Text
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Parser Text
A.asciiCI
{-# INLINE aliases #-}

-- | Create a parser that matches any of the given 'a', with the given aliases.
anyOf :: [(a, [Text])] -> AttoParser a
anyOf :: forall a. [(a, [Text])] -> AttoParser a
anyOf = [Parser Text a] -> Parser Text a
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice ([Parser Text a] -> Parser Text a)
-> ([(a, [Text])] -> [Parser Text a])
-> [(a, [Text])]
-> Parser Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, [Text]) -> Parser Text a) -> [(a, [Text])] -> [Parser Text a]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
a, [Text]
ts) -> a
a a -> Parser Text -> Parser Text a
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Text] -> Parser Text
forall (t :: * -> *). Foldable t => t Text -> Parser Text
aliases [Text]
ts)

-- | Like 'anyOf' but, after having found a match, skip all remaining
-- text as long as the given predicate is true.
anyOfSkip :: (Char -> Bool) -> [(a, [Text])] -> AttoParser a
anyOfSkip :: forall a. (Char -> Bool) -> [(a, [Text])] -> AttoParser a
anyOfSkip Char -> Bool
p [(a, [Text])]
xs = [(a, [Text])] -> AttoParser a
forall a. [(a, [Text])] -> AttoParser a
anyOf [(a, [Text])]
xs AttoParser a -> Parser Text () -> AttoParser a
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Text ()
A.skipWhile Char -> Bool
p

-- | Like 'anyOf', but return a 'ReadM a' instead of an 'AttoParser a'.
anyOfRM :: [(a, [Text])] -> ReadM a
anyOfRM :: forall a. [(a, [Text])] -> ReadM a
anyOfRM = AttoParser a -> ReadM a
forall a. AttoParser a -> ReadM a
attoReadM (AttoParser a -> ReadM a)
-> ([(a, [Text])] -> AttoParser a) -> [(a, [Text])] -> ReadM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, [Text])] -> AttoParser a
forall a. [(a, [Text])] -> AttoParser a
anyOf

-- | Pretty print some container of separation characters, inserting a space
-- between each item.
showSepChars :: Foldable t => t Char -> String
showSepChars :: forall (t :: * -> *). Foldable t => t Char -> String
showSepChars = (Char -> String) -> t Char -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (Char -> String) -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
:[]))
{-# INLINE showSepChars #-}