-- | This module contains an arrow interface for option parsers, which allows
-- to define and combine parsers using the arrow notation and arrow
-- combinators.
--
-- The arrow syntax is particularly useful to create parsers of nested
-- structures, or records where the order of fields is different from the order
-- in which the parsers should be applied.
--
-- For example, an 'Options.Applicative.Builder.arguments` parser often needs
-- to be applied last, and that makes it inconvenient to use it for a field
-- which is not the last one in a record.
--
-- Using the arrow syntax and the functions in this module, one can write, e.g.:
--
-- > data Options = Options
-- >   { optArgs :: [String]
-- >   , optVerbose :: Bool }
-- >
-- > opts :: Parser Options
-- > opts = runA $ proc () -> do
-- >   verbose <- asA (switch (short 'v')) -< ()
-- >   args <- asA (arguments str idm) -< ()
-- >   returnA -< Options args verbose
--
-- Parser arrows, created out of regular 'Parser' values using the 'asA'
-- function, are arrows taking @()@ as argument and returning the parsed value.
module Options.Applicative.Arrows (
  module Control.Arrow,
  A(..),
  asA,
  runA,
  ParserA,
  ) where

import Control.Arrow
import Control.Category (Category(..))

import Options.Applicative

import Prelude hiding ((.), id)

-- | For any 'Applicative' functor @f@, @A f@ is the 'Arrow' instance
-- associated to @f@.
--
-- The 'A' constructor can be used to convert a value of type @f (a -> b)@ into
-- an arrow.
newtype A f a b = A
  { forall (f :: * -> *) a b. A f a b -> f (a -> b)
unA :: f (a -> b) }

-- | Convert a value of type @f a@ into an arrow taking @()@ as argument.
--
-- Applied to a value of type 'Parser', it turns it into an arrow that can be
-- used inside an arrow command, or passed to arrow combinators.
asA :: Applicative f => f a -> A f () a
asA :: forall (f :: * -> *) a. Applicative f => f a -> A f () a
asA f a
x = forall (f :: * -> *) a b. f (a -> b) -> A f a b
A forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x

-- | Convert an arrow back to an applicative value.
--
-- This function can be used to return a result of type 'Parser' from an arrow
-- command.
runA :: Applicative f => A f () a -> f a
runA :: forall (f :: * -> *) a. Applicative f => A f () a -> f a
runA A f () a
a = forall (f :: * -> *) a b. A f a b -> f (a -> b)
unA A f () a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance Applicative f => Category (A f) where
  id :: forall a. A f a a
id = forall (f :: * -> *) a b. f (a -> b) -> A f a b
A forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  -- use reverse composition, because we want effects to run from
  -- top to bottom in the arrow syntax
  (A f (b -> c)
f) . :: forall b c a. A f b c -> A f a b -> A f a c
. (A f (a -> b)
g) = forall (f :: * -> *) a b. f (a -> b) -> A f a b
A forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a -> b)
g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (b -> c)
f

instance Applicative f => Arrow (A f) where
  arr :: forall b c. (b -> c) -> A f b c
arr = forall (f :: * -> *) a b. f (a -> b) -> A f a b
A forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  first :: forall b c d. A f b c -> A f (b, d) (c, d)
first (A f (b -> c)
f) = forall (f :: * -> *) a b. f (a -> b) -> A f a b
A forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (b -> c)
f

-- | The type of arrows associated to the applicative 'Parser' functor.
type ParserA = A Parser