diff --git a/Options/Applicative/Arrows.hs b/Options/Applicative/Arrows.hs new file mode 100644 index 0000000..3a4c77d --- /dev/null +++ b/Options/Applicative/Arrows.hs @@ -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 diff --git a/optparse-applicative.cabal b/optparse-applicative.cabal index 18e77f1..f38806e 100644 --- a/optparse-applicative.cabal +++ b/optparse-applicative.cabal @@ -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,