{-# Language KindSignatures, GADTs #-}

{-|
Module      : Client.Commands.Arguments.Spec
Description : Argument specifications used within client commands
Copyright   : (c) Eric Mertens, 2017
License     : ISC
Maintainer  : emertens@gmail.com

-}

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] {- ^ required names -} ->
  [String] {- ^ optional names -} ->
  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)