{-# Language GADTs #-}
module Client.Commands.Arguments.Parser (parse) where
import Client.Commands.Arguments.Spec
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Control.Applicative.Free
parse :: r -> Args r a -> String -> Maybe a
parse :: r -> Args r a -> String -> Maybe a
parse r
env Args r a
spec String
str =
do (a
a,String
rest) <- StateT String Maybe a -> String -> Maybe (a, String)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (r -> Args r a -> StateT String Maybe a
forall r a. r -> Args r a -> Parser a
parseArgs r
env Args r a
spec) String
str
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char
' 'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
rest)
a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
type Parser = StateT String Maybe
parseArgs :: r -> Args r a -> Parser a
parseArgs :: r -> Args r a -> Parser a
parseArgs r
env Args r a
spec = (forall x. Arg r x -> StateT String Maybe x)
-> Args r a -> Parser a
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runAp (r -> Arg r x -> Parser x
forall r a. r -> Arg r a -> Parser a
parseArg r
env) Args r a
spec
parseArg :: r -> Arg r a -> Parser a
parseArg :: r -> Arg r a -> Parser a
parseArg r
env Arg r a
spec =
case Arg r a
spec of
Argument ArgumentShape
shape String
_ r -> String -> Maybe a
f ->
do String
t <- ArgumentShape -> Parser String
argumentString ArgumentShape
shape
Maybe a -> Parser a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (r -> String -> Maybe a
f r
env String
t)
Optional Args r a
subspec -> StateT String Maybe a -> StateT String Maybe (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (r -> Args r a -> StateT String Maybe a
forall r a. r -> Args r a -> Parser a
parseArgs r
env Args r a
subspec)
Extension String
_ r -> String -> Maybe (Args r a)
parseFormat ->
do String
t <- Parser String
token
Args r a
subspec <- Maybe (Args r a) -> StateT String Maybe (Args r a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (r -> String -> Maybe (Args r a)
parseFormat r
env String
t)
r -> Args r a -> Parser a
forall r a. r -> Args r a -> Parser a
parseArgs r
env Args r a
subspec
argumentString :: ArgumentShape -> Parser String
argumentString :: ArgumentShape -> Parser String
argumentString ArgumentShape
TokenArgument = Parser String
token
argumentString ArgumentShape
RemainingArgument = Parser String
remaining
remaining :: Parser String
remaining :: Parser String
remaining =
do String
xs <- Parser String
forall (m :: * -> *) s. Monad m => StateT s m s
get
String -> StateT String Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put String
""
String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$! case String
xs of
Char
' ':String
xs' -> String
xs'
String
_ -> String
xs
token :: Parser String
token :: Parser String
token =
do String
xs <- Parser String
forall (m :: * -> *) s. Monad m => StateT s m s
get
let (String
t, String
xs') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char
' 'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char
' 'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
xs)
Bool -> StateT String Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
t))
String -> StateT String Maybe ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put String
xs'
String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return String
t