{-# 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 (liftA2)
import Control.Applicative.Free (Ap, liftAp)
import Data.Kind (Type)
import Data.Maybe (fromMaybe)
import Text.Read (readMaybe)

type Args r = Ap (Arg r)

data ArgumentShape = TokenArgument | RemainingArgument

data Arg :: Type -> Type -> Type 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 :: forall r a. String -> (r -> String -> Maybe a) -> Args r a
tokenArg String
name r -> String -> Maybe a
parser = forall (f :: * -> *) a. f a -> Ap f a
liftAp (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 :: forall r. String -> Args r String
remainingArg String
name = forall (f :: * -> *) a. f a -> Ap f a
liftAp (forall r a.
ArgumentShape -> String -> (r -> String -> Maybe a) -> Arg r a
Argument ArgumentShape
RemainingArgument String
name (\r
_ -> forall a. a -> Maybe a
Just))

optionalArg :: Args r a -> Args r (Maybe a)
optionalArg :: forall r a. Args r a -> Args r (Maybe a)
optionalArg = forall (f :: * -> *) a. f a -> Ap f a
liftAp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a. Args r a -> Arg r (Maybe a)
Optional

extensionArg :: String -> (r -> String -> Maybe (Args r a)) -> Args r a
extensionArg :: forall r a. String -> (r -> String -> Maybe (Args r a)) -> Args r a
extensionArg String
name r -> String -> Maybe (Args r a)
parser = forall (f :: * -> *) a. f a -> Ap f a
liftAp (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 :: forall r. String -> Args r String
simpleToken String
name = forall r a. String -> (r -> String -> Maybe a) -> Args r a
tokenArg String
name (\r
_ -> forall a. a -> Maybe a
Just)

numberArg :: Args r Int
numberArg :: forall r. Args r Int
numberArg = forall r a. String -> (r -> String -> Maybe a) -> Args r a
tokenArg String
"number" (\r
_ -> forall a. Read a => String -> Maybe a
readMaybe)

optionalNumberArg :: Args r (Maybe Int)
optionalNumberArg :: forall r. Args r (Maybe Int)
optionalNumberArg = forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall r a. String -> (r -> String -> Maybe a) -> Args r a
tokenArg String
"[number]" (\r
_ -> forall a. Read a => String -> Maybe a
readMaybe))

tokenList ::
  [String] {- ^ required names -} ->
  [String] {- ^ optional names -} ->
  Args r [String]
tokenList :: forall r. [String] -> [String] -> Args r [String]
tokenList [String]
req [String]
opt = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {r}. String -> Ap (Arg r) [String] -> Ap (Arg r) [String]
addReq (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {r}. String -> Ap (Arg r) [String] -> Ap (Arg r) [String]
addOpt (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      = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (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 = forall a. a -> Maybe a -> a
fromMaybe [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall {r}. String -> Ap (Arg r) [String] -> Ap (Arg r) [String]
addReq String
name Ap (Arg r) [String]
rest)