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 :: forall u. String -> CharParser u String
caseInsensitive = (Char -> ParsecT String u Identity Char)
-> String -> ParsecT String u Identity String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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_ :: forall u a. CharParser u a -> CharParser u ()
lookAhead_ CharParser u a
p = 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 a
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT String u Identity ()
forall a. a -> ParsecT String u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

isNotFollowedBy :: Show a => CharParser u a -> CharParser u Bool
isNotFollowedBy :: forall a u. Show a => CharParser u a -> CharParser u Bool
isNotFollowedBy CharParser u a
p = Bool
-> ParsecT String u Identity Bool -> ParsecT String u Identity 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 ()
-> ParsecT String u Identity Bool -> ParsecT String u Identity Bool
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT String u Identity Bool
forall a. a -> ParsecT String u Identity a
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 :: forall u. CharParser u Char
inlineSpace = (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
            ParsecT String u Identity Char
-> String -> ParsecT String u Identity 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 :: forall u. CharParser u ()
inlineSpaces = ParsecT String u Identity Char -> ParsecT String u Identity ()
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)
             ParsecT String u Identity ()
-> String -> ParsecT String u Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"inline-spaces"

inlineSpaces1 :: CharParser u ()
inlineSpaces1 :: forall u. CharParser u ()
inlineSpaces1 = ParsecT String u Identity Char -> ParsecT String u Identity ()
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)
              ParsecT String u Identity ()
-> String -> ParsecT String u Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"1+ inline-spaces"

spaces1 :: CharParser u ()
spaces1 :: forall u. CharParser u ()
spaces1 = ParsecT String u Identity Char -> ParsecT String u Identity ()
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)
        ParsecT String u Identity ()
-> String -> ParsecT String u Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
">=1 spaces"

endline :: CharParser u Char
endline :: forall u. CharParser u Char
endline = CharParser u ()
forall u. CharParser u ()
inlineSpaces CharParser u ()
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
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
newline

optionalEndline :: CharParser u ()
optionalEndline :: forall u. CharParser u ()
optionalEndline = CharParser u ()
forall u. CharParser u ()
inlineSpaces CharParser u () -> CharParser u () -> CharParser u ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
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 :: forall u. CharParser u Char
pipe = Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' ParsecT String u Identity Char
-> String -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"'|'"

ellipsis :: CharParser u String
ellipsis :: forall u. CharParser u String
ellipsis = CharParser u ()
forall u. CharParser u ()
inlineSpaces CharParser u ()
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"..."
         ParsecT String u Identity String
-> String -> ParsecT String u Identity 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 :: forall u a b. 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 a. a -> ParsecT String u Identity 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 :: forall a u. Show a => CharParser u a -> CharParser u ()
skipUntil CharParser u a
p = ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (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 ()
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
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 :: forall u a. 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
-> ParsecT String u Identity [a]
-> ParsecT String u Identity [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 a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
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)
                            (ParsecT String u Identity [a] -> ParsecT String u Identity [a])
-> ParsecT String u Identity [a] -> ParsecT String u Identity [a]
forall a b. (a -> b) -> a -> b
$ (CharParser u ()
forall u. CharParser u ()
inlineSpaces CharParser u () -> CharParser u () -> CharParser u ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
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 a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CharParser u a
elemParser)
                              CharParser u a
-> ParsecT String u Identity Char -> ParsecT String u Identity [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 a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
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 :: forall u a. 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
-> ParsecT String u Identity [a]
-> ParsecT String u Identity [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 u. CharParser u String
begin ParsecT String u Identity String
forall u. CharParser u String
end ParsecT String u Identity [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 a b.
ParsecT String st Identity a
-> ParsecT String st Identity b -> ParsecT String st Identity b
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 :: ParsecT String u Identity [a]
manyP = CharParser u a
p CharParser u a
-> ParsecT String u Identity () -> ParsecT String u Identity [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 :: forall k a.
Ord k =>
(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 b a. (b -> a -> b) -> b -> [a] -> b
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