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