module System.Console.Docopt.ParseUtils
    (
        module System.Console.Docopt.ParseUtils,
        module System.Console.Docopt.ApplicativeParsec,
        module Data.Char,
    )
    where

import System.Console.Docopt.ApplicativeParsec

import           Data.Map (Map)
import qualified Data.Map as M

import Data.Char (isSpace, toUpper, toLower)

-- * Constants

lowers, uppers, letters, numerics, specialChars, alphanumerics, alphanumSpecial :: String
lowers :: String
lowers = [Char
'a'..Char
'z']
uppers :: String
uppers = [Char
'A'..Char
'Z']
letters :: String
letters = String
lowersString -> String -> String
forall a. [a] -> [a] -> [a]
++String
uppers
numerics :: String
numerics = [Char
'0'..Char
'9']String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"-_"
specialChars :: String
specialChars = String
" :/"
alphanumerics :: String
alphanumerics = String
lettersString -> String -> String
forall a. [a] -> [a] -> [a]
++String
numerics
alphanumSpecial :: String
alphanumSpecial = String
alphanumerics String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
specialChars


-- * Basic Parsers

caseInsensitive :: String -> CharParser u String
caseInsensitive :: String -> CharParser u String
caseInsensitive = (Char -> ParsecT String u Identity Char)
-> String -> CharParser u String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Char
c -> Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char (Char -> Char
toLower Char
c) ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char (Char -> Char
toUpper Char
c))

lookAhead_ :: CharParser u a -> CharParser u ()
lookAhead_ :: CharParser u a -> CharParser u ()
lookAhead_ CharParser u a
p = do CharParser u a -> CharParser u a
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead CharParser u a
p
                  () -> CharParser u ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

isNotFollowedBy :: Show a => CharParser u a -> CharParser u Bool
isNotFollowedBy :: CharParser u a -> CharParser u Bool
isNotFollowedBy CharParser u a
p = Bool -> CharParser u Bool -> CharParser u Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (CharParser u a -> ParsecT String u Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy CharParser u a
p ParsecT String u Identity ()
-> CharParser u Bool -> CharParser u Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> CharParser u Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)

isInlineSpace :: Char -> Bool
isInlineSpace :: Char -> Bool
isInlineSpace Char
c = Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Char
c String
"\n\r"
                   Bool -> Bool -> Bool
&& Char -> Bool
isSpace Char
c

inlineSpace :: CharParser u Char
inlineSpace :: CharParser u Char
inlineSpace = (Char -> Bool) -> CharParser u Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isInlineSpace
            CharParser u Char -> String -> CharParser u Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"inline-space"

-- | like `spaces`, except does not match newlines
inlineSpaces :: CharParser u ()
inlineSpaces :: CharParser u ()
inlineSpaces = ParsecT String u Identity Char -> CharParser u ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ((Char -> Bool) -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isInlineSpace)
             CharParser u () -> String -> CharParser u ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"inline-spaces"

inlineSpaces1 :: CharParser u ()
inlineSpaces1 :: CharParser u ()
inlineSpaces1 = ParsecT String u Identity Char -> CharParser u ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ((Char -> Bool) -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isInlineSpace)
              CharParser u () -> String -> CharParser u ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"1+ inline-spaces"

spaces1 :: CharParser u ()
spaces1 :: CharParser u ()
spaces1 = ParsecT String u Identity Char -> CharParser u ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ((Char -> Bool) -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSpace)
        CharParser u () -> String -> CharParser u ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
">=1 spaces"

endline :: CharParser u Char
endline :: CharParser u Char
endline = CharParser u ()
forall u. CharParser u ()
inlineSpaces CharParser u () -> CharParser u Char -> CharParser u Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser u Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline

optionalEndline :: CharParser u ()
optionalEndline :: CharParser u ()
optionalEndline = CharParser u ()
forall u. CharParser u ()
inlineSpaces CharParser u () -> CharParser u () -> CharParser u ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity Char -> CharParser u ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline

pipe :: CharParser u Char
pipe :: CharParser u Char
pipe = Char -> CharParser u Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' CharParser u Char -> String -> CharParser u Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"'|'"

ellipsis :: CharParser u String
ellipsis :: CharParser u String
ellipsis = CharParser u ()
forall u. CharParser u ()
inlineSpaces CharParser u () -> CharParser u String -> CharParser u String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> CharParser u String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"..."
         CharParser u String -> String -> CharParser u String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"'...'"

manyTill1 :: CharParser u a -> CharParser u b -> CharParser u [a]
manyTill1 :: CharParser u a -> CharParser u b -> CharParser u [a]
manyTill1 CharParser u a
p CharParser u b
end = do
  a
first <- CharParser u a
p
  [a]
rest <- CharParser u a -> CharParser u b -> CharParser u [a]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill CharParser u a
p CharParser u b
end
  [a] -> CharParser u [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> CharParser u [a]) -> [a] -> CharParser u [a]
forall a b. (a -> b) -> a -> b
$ a
first a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rest

-- |@skipUntil p@ ignores everything that comes before `p`.
-- Returns what `p` returns.
skipUntil :: Show a => CharParser u a -> CharParser u ()
skipUntil :: CharParser u a -> CharParser u ()
skipUntil CharParser u a
p = ParsecT String u Identity Char -> CharParser u ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (CharParser u a -> CharParser u ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy CharParser u a
p CharParser u ()
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)

pGroup :: Char -> CharParser u a -> Char -> CharParser u [a]
pGroup :: Char -> CharParser u a -> Char -> CharParser u [a]
pGroup Char
beg CharParser u a
elemParser Char
end = ParsecT String u Identity Char
-> ParsecT String u Identity Char
-> CharParser u [a]
-> CharParser u [a]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
beg) (CharParser u ()
forall u. CharParser u ()
inlineSpaces CharParser u ()
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
end)
                            (CharParser u [a] -> CharParser u [a])
-> CharParser u [a] -> CharParser u [a]
forall a b. (a -> b) -> a -> b
$ (CharParser u ()
forall u. CharParser u ()
inlineSpaces CharParser u () -> CharParser u () -> CharParser u ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity Char -> CharParser u ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT String u Identity Char
forall u. CharParser u Char
pipe CharParser u () -> CharParser u a -> CharParser u a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser u a
elemParser)
                              CharParser u a
-> ParsecT String u Identity Char -> CharParser u [a]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`sepBy`
                              (CharParser u ()
forall u. CharParser u ()
inlineSpaces CharParser u ()
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String u Identity Char
forall u. CharParser u Char
pipe)

betweenS :: String -> String -> CharParser u a -> CharParser u [a]
betweenS :: String -> String -> CharParser u a -> CharParser u [a]
betweenS String
b String
e CharParser u a
p = ParsecT String u Identity String
-> ParsecT String u Identity String
-> CharParser u [a]
-> CharParser u [a]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ParsecT String u Identity String
forall st. GenParser Char st String
begin ParsecT String u Identity String
forall st. GenParser Char st String
end CharParser u [a]
manyP
                 where begin :: GenParser Char st String
begin = GenParser Char st String -> GenParser Char st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st String -> GenParser Char st String)
-> GenParser Char st String -> GenParser Char st String
forall a b. (a -> b) -> a -> b
$ String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
b
                       end :: GenParser Char st String
end = GenParser Char st String -> GenParser Char st String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char st String -> GenParser Char st String)
-> GenParser Char st String -> GenParser Char st String
forall a b. (a -> b) -> a -> b
$ CharParser st ()
forall u. CharParser u ()
inlineSpaces CharParser st ()
-> GenParser Char st String -> GenParser Char st String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> GenParser Char st String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
e
                       manyP :: CharParser u [a]
manyP = CharParser u a
p CharParser u a -> ParsecT String u Identity () -> CharParser u [a]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`sepBy` ParsecT String u Identity ()
forall u. CharParser u ()
inlineSpaces1


-- | Data.Map utils
alterAllWithKey :: Ord k => (k -> Maybe a -> Maybe a) -> [k] -> Map k a -> Map k a
alterAllWithKey :: (k -> Maybe a -> Maybe a) -> [k] -> Map k a -> Map k a
alterAllWithKey k -> Maybe a -> Maybe a
f [k]
ks Map k a
m = (Map k a -> k -> Map k a) -> Map k a -> [k] -> Map k a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Map k a
m' k
k -> (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (k -> Maybe a -> Maybe a
f k
k) k
k Map k a
m') Map k a
m [k]
ks