{- Copyright (C) 2015 Martin Linnemann <theCodingMarlin@googlemail.com> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | Module : Text.Pandoc.Readers.Odt.Arrows.Utils Copyright : Copyright (C) 2015 Martin Linnemann License : GNU GPL, version 2 or above Maintainer : Martin Linnemann <theCodingMarlin@googlemail.com> Stability : alpha Portability : portable Utility functions for Arrows (Kleisli monads). Some general notes on notation: * "^" is meant to stand for a pure function that is lifted into an arrow based on its usage for that purpose in "Control.Arrow". * "?" is meant to stand for the usage of a 'FallibleArrow' or a pure function with an equivalent return value. * "_" stands for the dropping of a value. -} -- We export everything module Text.Pandoc.Readers.Odt.Arrows.Utils where import Control.Arrow import Control.Monad (join) import Text.Pandoc.Readers.Odt.Generic.Fallible import Text.Pandoc.Readers.Odt.Generic.Utils and2 :: (Arrow a) => a b c -> a b c' -> a b (c,c') and2 = (&&&) and3 :: (Arrow a) => a b c0->a b c1->a b c2 -> a b (c0,c1,c2 ) and4 :: (Arrow a) => a b c0->a b c1->a b c2->a b c3 -> a b (c0,c1,c2,c3 ) and5 :: (Arrow a) => a b c0->a b c1->a b c2->a b c3->a b c4 -> a b (c0,c1,c2,c3,c4 ) and6 :: (Arrow a) => a b c0->a b c1->a b c2->a b c3->a b c4->a b c5 -> a b (c0,c1,c2,c3,c4,c5 ) and3 a b c = (and2 a b ) &&& c >>^ \((z,y ) , x) -> (z,y,x ) and4 a b c d = (and3 a b c ) &&& d >>^ \((z,y,x ) , w) -> (z,y,x,w ) and5 a b c d e = (and4 a b c d ) &&& e >>^ \((z,y,x,w ) , v) -> (z,y,x,w,v ) and6 a b c d e f = (and5 a b c d e ) &&& f >>^ \((z,y,x,w,v ) , u) -> (z,y,x,w,v,u ) liftA2 :: (Arrow a) => (x -> y -> z) -> a b x -> a b y -> a b z liftA2 f a b = a &&& b >>^ uncurry f liftA3 :: (Arrow a) => (z->y->x -> r) -> a b z->a b y->a b x -> a b r liftA4 :: (Arrow a) => (z->y->x->w -> r) -> a b z->a b y->a b x->a b w -> a b r liftA5 :: (Arrow a) => (z->y->x->w->v -> r) -> a b z->a b y->a b x->a b w->a b v -> a b r liftA6 :: (Arrow a) => (z->y->x->w->v->u -> r) -> a b z->a b y->a b x->a b w->a b v->a b u -> a b r liftA3 fun a b c = and3 a b c >>^ uncurry3 fun liftA4 fun a b c d = and4 a b c d >>^ uncurry4 fun liftA5 fun a b c d e = and5 a b c d e >>^ uncurry5 fun liftA6 fun a b c d e f = and6 a b c d e f >>^ uncurry6 fun liftA :: (Arrow a) => (y -> z) -> a b y -> a b z liftA fun a = a >>^ fun -- | Duplicate a value to subsequently feed it into different arrows. -- Can almost always be replaced with '(&&&)', 'keepingTheValue', -- or even '(|||)'. -- Aequivalent to -- > returnA &&& returnA duplicate :: (Arrow a) => a b (b,b) duplicate = arr $ join (,) -- | Applies a function to the uncurried result-pair of an arrow-application. -- (The %-symbol was chosen to evoke an association with pairs.) (>>%) :: (Arrow a) => a x (b,c) -> (b -> c -> d) -> a x d a >>% f = a >>^ uncurry f infixr 2 >>% -- | Duplicate a value and apply an arrow to the second instance. -- Aequivalent to -- > \a -> duplicate >>> second a -- or -- > \a -> returnA &&& a keepingTheValue :: (Arrow a) => a b c -> a b (b,c) keepingTheValue a = returnA &&& a ( ^||| ) :: (ArrowChoice a) => (b -> d) -> a c d -> a (Either b c) d ( |||^ ) :: (ArrowChoice a) => a b d -> (c -> d) -> a (Either b c) d ( ^|||^ ) :: (ArrowChoice a) => (b -> d) -> (c -> d) -> a (Either b c) d l ^||| r = arr l ||| r l |||^ r = l ||| arr r l ^|||^ r = arr l ||| arr r infixr 2 ^||| , |||^, ^|||^ ( ^&&& ) :: (Arrow a) => (b -> c) -> a b c' -> a b (c,c') ( &&&^ ) :: (Arrow a) => a b c -> (b -> c') -> a b (c,c') l ^&&& r = arr l &&& r l &&&^ r = l &&& arr r infixr 3 ^&&&, &&&^ -- | Converts @Right a@ into @Just a@ and @Left _@ into @Nothing@. choiceToMaybe :: (ArrowChoice a) => a (Either l r) (Maybe r) choiceToMaybe = arr eitherToMaybe -- | Converts @Nothing@ into @Left ()@ and @Just a@ into @Right a@. maybeToChoice :: (ArrowChoice a) => a (Maybe b) (Fallible b) maybeToChoice = arr maybeToEither -- | Lifts a constant value into an arrow returnV :: (Arrow a) => c -> a x c returnV = arr.const -- | Defines Left as failure, Right as success type FallibleArrow a input failure success = a input (Either failure success) -- liftAsSuccess :: (ArrowChoice a) => a x success -> FallibleArrow a x failure success liftAsSuccess a = a >>^ Right -- | Execute the second arrow if the first succeeds (>>?) :: (ArrowChoice a) => FallibleArrow a x failure success -> FallibleArrow a success failure success' -> FallibleArrow a x failure success' a >>? b = a >>> Left ^||| b -- | Execute the lifted second arrow if the first succeeds (>>?^) :: (ArrowChoice a) => FallibleArrow a x failure success -> (success -> success') -> FallibleArrow a x failure success' a >>?^ f = a >>^ Left ^|||^ Right . f -- | Execute the lifted second arrow if the first succeeds (>>?^?) :: (ArrowChoice a) => FallibleArrow a x failure success -> (success -> Either failure success') -> FallibleArrow a x failure success' a >>?^? b = a >>> Left ^|||^ b -- | Execute the second arrow if the lifted first arrow succeeds (^>>?) :: (ArrowChoice a) => (x -> Either failure success) -> FallibleArrow a success failure success' -> FallibleArrow a x failure success' a ^>>? b = a ^>> Left ^||| b -- | Execute the second, non-fallible arrow if the first arrow succeeds (>>?!) :: (ArrowChoice a) => FallibleArrow a x failure success -> a success success' -> FallibleArrow a x failure success' a >>?! f = a >>> right f --- (>>?%) :: (ArrowChoice a) => FallibleArrow a x f (b,b') -> (b -> b' -> c) -> FallibleArrow a x f c a >>?% f = a >>?^ (uncurry f) --- (^>>?%) :: (ArrowChoice a) => (x -> Either f (b,b')) -> (b -> b' -> c) -> FallibleArrow a x f c a ^>>?% f = arr a >>?^ (uncurry f) --- (>>?%?) :: (ArrowChoice a) => FallibleArrow a x f (b,b') -> (b -> b' -> (Either f c)) -> FallibleArrow a x f c a >>?%? f = a >>?^? (uncurry f) infixr 1 >>?, >>?^, >>?^? infixr 1 ^>>?, >>?! infixr 1 >>?%, ^>>?%, >>?%? -- | An arrow version of a short-circuit (<|>) ifFailedDo :: (ArrowChoice a) => FallibleArrow a x f y -> FallibleArrow a x f y -> FallibleArrow a x f y ifFailedDo a b = keepingTheValue a >>> repackage ^>> (b |||^ Right) where repackage (x , Left _) = Left x repackage (_ , Right y) = Right y infixr 1 `ifFailedDo`