Add Arrow interface.

This commit is contained in:
Paolo Capriotti 2012-07-07 23:23:56 +01:00
parent 62c2de230b
commit 80ea53d20d
2 changed files with 34 additions and 0 deletions

View File

@ -0,0 +1,33 @@
module Options.Applicative.Arrows (
A(..),
asA,
runA,
ParserA
) where
import Control.Arrow
import Control.Category
import Options.Applicative
import Prelude hiding ((.), id)
newtype A f a b = A
{ unA :: f (a -> b) }
asA :: Applicative f => f a -> A f () a
asA x = A $ const <$> x
runA :: Applicative f => A f () a -> f a
runA a = unA a <*> pure ()
instance Applicative f => Category (A f) where
id = A $ pure id
-- use reverse composition, because we want effects to run from
-- top to bottom in the arrow syntax
(A f) . (A g) = A $ flip (.) <$> g <*> f
instance Applicative f => Arrow (A f) where
arr = A . pure
first (A f) = A $ first <$> f
type ParserA = A Parser

View File

@ -73,6 +73,7 @@ extra-source-files: README.md
library
exposed-modules: Options.Applicative,
Options.Applicative.Arrows,
Options.Applicative.Common,
Options.Applicative.Types,
Options.Applicative.Builder,