{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module WithCli.Pure.Internal where

import           WithCli.HasArguments
import           WithCli.Modifier
import           WithCli.Parser
import           WithCli.Result

class WithCliPure function output where
  run :: String -> Modifiers -> Result (Parser Unnormalized input)
    -> (input -> function) -> [String] -> Result output

instance WithCliPure output output where
  run :: String -> Modifiers -> Result (Parser Unnormalized input) -> (input -> output)
    -> [String] -> Result output
  run :: forall input.
String
-> Modifiers
-> Result (Parser Unnormalized input)
-> (input -> output)
-> [String]
-> Result output
run String
progName Modifiers
modifiers Result (Parser Unnormalized input)
mkParser input -> output
function [String]
args = do
    Result (Parser Unnormalized input)
mkParser forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Parser Unnormalized input
parser -> do
      input
input <- forall a.
String -> Modifiers -> Parser Normalized a -> [String] -> Result a
runParser String
progName Modifiers
modifiers
        (forall a. Parser Unnormalized a -> Parser Normalized a
normalizeParser (forall a.
Modifiers -> Parser Unnormalized a -> Parser Unnormalized a
applyModifiers Modifiers
modifiers Parser Unnormalized input
parser))
        [String]
args
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ input -> output
function input
input

instance (HasArguments input, WithCliPure function output) =>
  WithCliPure (input -> function) output where

  run :: String -> Modifiers -> Result (Parser Unnormalized otherInput)
    -> (otherInput -> (input -> function)) -> [String] -> Result output
  run :: forall input.
String
-> Modifiers
-> Result (Parser Unnormalized input)
-> (input -> input -> function)
-> [String]
-> Result output
run String
progName Modifiers
modifiers Result (Parser Unnormalized otherInput)
mkParser otherInput -> input -> function
function [String]
args = do
    forall function output input.
WithCliPure function output =>
String
-> Modifiers
-> Result (Parser Unnormalized input)
-> (input -> function)
-> [String]
-> Result output
run String
progName Modifiers
modifiers
      (forall a b phase.
Result (Parser phase a)
-> Result (Parser phase b) -> Result (Parser phase (a, b))
combine Result (Parser Unnormalized otherInput)
mkParser (forall a.
HasArguments a =>
Modifiers -> Maybe String -> Result (Parser Unnormalized a)
argumentsParser Modifiers
modifiers forall a. Maybe a
Nothing))
      (\ (otherInput
otherInput, input
input) -> otherInput -> input -> function
function otherInput
otherInput input
input)
      [String]
args