{-# Language KindSignatures, GADTs #-}
module Client.Commands.Arguments.Spec
( Args
, simpleToken
, remainingArg
, optionalArg
, tokenList
, numberArg
, optionalNumberArg
, extensionArg
, tokenArg
, ArgumentShape(..)
, Arg(..)
) where
import Control.Applicative
import Control.Applicative.Free
import Data.Maybe (fromMaybe)
import Text.Read (readMaybe)
type Args r = Ap (Arg r)
data ArgumentShape = TokenArgument | RemainingArgument
data Arg :: * -> * -> * where
Argument :: ArgumentShape -> String -> (r -> String -> Maybe a) -> Arg r a
Optional :: Args r a -> Arg r (Maybe a)
Extension :: String -> (r -> String -> Maybe (Args r a)) -> Arg r a
tokenArg :: String -> (r -> String -> Maybe a) -> Args r a
tokenArg :: String -> (r -> String -> Maybe a) -> Args r a
tokenArg String
name r -> String -> Maybe a
parser = Arg r a -> Args r a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (ArgumentShape -> String -> (r -> String -> Maybe a) -> Arg r a
forall r a.
ArgumentShape -> String -> (r -> String -> Maybe a) -> Arg r a
Argument ArgumentShape
TokenArgument String
name r -> String -> Maybe a
parser)
remainingArg :: String -> Args r String
remainingArg :: String -> Args r String
remainingArg String
name = Arg r String -> Args r String
forall (f :: * -> *) a. f a -> Ap f a
liftAp (ArgumentShape
-> String -> (r -> String -> Maybe String) -> Arg r String
forall r a.
ArgumentShape -> String -> (r -> String -> Maybe a) -> Arg r a
Argument ArgumentShape
RemainingArgument String
name (\r
_ -> String -> Maybe String
forall a. a -> Maybe a
Just))
optionalArg :: Args r a -> Args r (Maybe a)
optionalArg :: Args r a -> Args r (Maybe a)
optionalArg = Arg r (Maybe a) -> Args r (Maybe a)
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Arg r (Maybe a) -> Args r (Maybe a))
-> (Args r a -> Arg r (Maybe a)) -> Args r a -> Args r (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args r a -> Arg r (Maybe a)
forall r a. Args r a -> Arg r (Maybe a)
Optional
extensionArg :: String -> (r -> String -> Maybe (Args r a)) -> Args r a
extensionArg :: String -> (r -> String -> Maybe (Args r a)) -> Args r a
extensionArg String
name r -> String -> Maybe (Args r a)
parser = Arg r a -> Args r a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (String -> (r -> String -> Maybe (Args r a)) -> Arg r a
forall r a. String -> (r -> String -> Maybe (Args r a)) -> Arg r a
Extension String
name r -> String -> Maybe (Args r a)
parser)
simpleToken :: String -> Args r String
simpleToken :: String -> Args r String
simpleToken String
name = String -> (r -> String -> Maybe String) -> Args r String
forall r a. String -> (r -> String -> Maybe a) -> Args r a
tokenArg String
name (\r
_ -> String -> Maybe String
forall a. a -> Maybe a
Just)
numberArg :: Args r Int
numberArg :: Args r Int
numberArg = String -> (r -> String -> Maybe Int) -> Args r Int
forall r a. String -> (r -> String -> Maybe a) -> Args r a
tokenArg String
"number" (\r
_ -> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe)
optionalNumberArg :: Args r (Maybe Int)
optionalNumberArg :: Args r (Maybe Int)
optionalNumberArg = Args r Int -> Args r (Maybe Int)
forall r a. Args r a -> Args r (Maybe a)
optionalArg (String -> (r -> String -> Maybe Int) -> Args r Int
forall r a. String -> (r -> String -> Maybe a) -> Args r a
tokenArg String
"[number]" (\r
_ -> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe))
tokenList ::
[String] ->
[String] ->
Args r [String]
tokenList :: [String] -> [String] -> Args r [String]
tokenList [String]
req [String]
opt = (String -> Args r [String] -> Args r [String])
-> Args r [String] -> [String] -> Args r [String]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> Args r [String] -> Args r [String]
forall r. String -> Ap (Arg r) [String] -> Ap (Arg r) [String]
addReq ((String -> Args r [String] -> Args r [String])
-> Args r [String] -> [String] -> Args r [String]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> Args r [String] -> Args r [String]
forall r. String -> Ap (Arg r) [String] -> Ap (Arg r) [String]
addOpt ([String] -> Args r [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) [String]
opt) [String]
req
where
addReq :: String -> Ap (Arg r) [String] -> Ap (Arg r) [String]
addReq String
name = (String -> [String] -> [String])
-> Ap (Arg r) String -> Ap (Arg r) [String] -> Ap (Arg r) [String]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (String -> Ap (Arg r) String
forall r. String -> Args r String
simpleToken String
name)
addOpt :: String -> Ap (Arg r) [String] -> Ap (Arg r) [String]
addOpt String
name Ap (Arg r) [String]
rest = [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [String] -> [String])
-> Ap (Arg r) (Maybe [String]) -> Ap (Arg r) [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ap (Arg r) [String] -> Ap (Arg r) (Maybe [String])
forall r a. Args r a -> Args r (Maybe a)
optionalArg (String -> Ap (Arg r) [String] -> Ap (Arg r) [String]
forall r. String -> Ap (Arg r) [String] -> Ap (Arg r) [String]
addReq String
name Ap (Arg r) [String]
rest)