-- | 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
  { 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 :: f a -> A f () a
asA f a
x = f (() -> a) -> A f () a
forall (f :: * -> *) a b. f (a -> b) -> A f a b
A (f (() -> a) -> A f () a) -> f (() -> a) -> A f () a
forall a b. (a -> b) -> a -> b
$ a -> () -> a
forall a b. a -> b -> a
const (a -> () -> a) -> f a -> f (() -> a)
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 :: A f () a -> f a
runA A f () a
a = A f () a -> f (() -> a)
forall (f :: * -> *) a b. A f a b -> f (a -> b)
unA A f () a
a f (() -> a) -> f () -> f a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance Applicative f => Category (A f) where
  id :: A f a a
id = f (a -> a) -> A f a a
forall (f :: * -> *) a b. f (a -> b) -> A f a b
A (f (a -> a) -> A f a a) -> f (a -> a) -> A f a a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> f (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
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) . :: A f b c -> A f a b -> A f a c
. (A f (a -> b)
g) = f (a -> c) -> A f a c
forall (f :: * -> *) a b. f (a -> b) -> A f a b
A (f (a -> c) -> A f a c) -> f (a -> c) -> A f a c
forall a b. (a -> b) -> a -> b
$ ((b -> c) -> (a -> b) -> a -> c) -> (a -> b) -> (b -> c) -> a -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b -> c) -> (a -> b) -> a -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.) ((a -> b) -> (b -> c) -> a -> c)
-> f (a -> b) -> f ((b -> c) -> a -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a -> b)
g f ((b -> c) -> a -> c) -> f (b -> c) -> f (a -> c)
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 :: (b -> c) -> A f b c
arr = f (b -> c) -> A f b c
forall (f :: * -> *) a b. f (a -> b) -> A f a b
A (f (b -> c) -> A f b c)
-> ((b -> c) -> f (b -> c)) -> (b -> c) -> A f b c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (b -> c) -> f (b -> c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  first :: A f b c -> A f (b, d) (c, d)
first (A f (b -> c)
f) = f ((b, d) -> (c, d)) -> A f (b, d) (c, d)
forall (f :: * -> *) a b. f (a -> b) -> A f a b
A (f ((b, d) -> (c, d)) -> A f (b, d) (c, d))
-> f ((b, d) -> (c, d)) -> A f (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((b -> c) -> (b, d) -> (c, d))
-> f (b -> c) -> f ((b, d) -> (c, d))
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