elision 0.1.0.2 → 0.1.1.0

raw patch · 3 files changed

+106/−57 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• elision.cabal +4/−2
• example/Main.hs +5/−5
• src/Control/Arrow/Elision.hs +97/−50

@@ -1,6 +1,8 @@ name:                elision-version:             0.1.0.2-synopsis:            A data structure over two functions to be linked together at a later time.+version:             0.1.1.0+synopsis:            Arrows with holes.+description:         A framework for describing holes in transformations+                     and impure computations purely. homepage:            http://github.com/crough/elision#readme license:             BSD2 license-file:        LICENSE

@@ -29,16 +29,16 @@  -------------------------------------------------------------------------------- readLine :: Elision Tty () String-readLine = initial ReadLine+readLine = terminal ReadLine  putLine :: Elision Tty String ()-putLine = simple <<^ PutLine+putLine = basic <<^ PutLine  guestAccess :: Elision Auth Pass AuthLevel-guestAccess = simple <<^ Guest+guestAccess = basic <<^ Guest  adminAccess :: Elision Auth (User,Pass) AuthLevel-adminAccess = simple <<^ uncurry Admin+adminAccess = basic <<^ uncurry Admin  anyAccess :: Elision Auth (User,Pass) AuthLevel anyAccess = uncurry mappend ^<< adminAccess &&& (guestAccess <<^ snd)@@ -82,7 +82,7 @@      pure (user,pass)  interactiveAuth :: Elision (Auth // Tty) () AuthLevel-interactiveAuth = anyAccess </ getCredentials+interactiveAuth = anyAccess <</ getCredentials  main :: IO () main =

@@ -15,11 +15,12 @@        , Elision'           -- * Elision manipulation functions+       , apply+       , basic        , complete        , complete'        , elide-       , initial-       , simple+       , terminal        , unelide        , unelide' @@ -29,26 +30,37 @@        , (//)        , left'        , right'-       , (/>)-       , (</)+       , (/>>)+       , (<</) -         -- * Reexports-       , module Control.Arrow-       , module Data.Profunctor-       , apply+       -- * Arrow combinator re-exports+       , Arrow+       , ArrowApply+       , ArrowChoice+       , (***)+       , (&&&)+       , (|||)+       , (+++)+       , (<<<)+       , (<<^)+       , (^>>)+       , (>>^)+       , (^<<)        )        where  import Control.Applicative (Applicative (..)) import Control.Arrow       (Arrow (..), ArrowApply (..), ArrowChoice (..),-                            ArrowMonad, second, right, (&&&), (***), (+++), (<<<),-                            (<<^), (>>>), (>>^), (^<<), (^>>), (|||))-import Control.Category    (Category (..))-import Control.Monad       (Functor (..), Monad (..), (=<<))-import Data.Either         (Either (..), either)+                            (<<^), (>>^), (^<<), (^>>))+import Control.Category    (Category (..), (<<<), (>>>))+import Control.Monad       (Functor (..), Monad (..), (<=<), (=<<))+import Data.Either         (Either (..)) import Data.Function       (const, ($)) import Data.Profunctor     (Profunctor (..)) +infixr 2 //+infixr 1 />>, <</ + -------------------------------------------------------------------------------- -- | A lens-esque type that can be used to "skip" part of a function. --@@ -64,109 +76,144 @@   fmap = rmap  instance Applicative (Elision f a) where-  pure x    = Elision (const (const (pure x)))-  e0 <*> e1 = Elision $ \e' arg -> unelide e0 e' arg <*> unelide e1 e' arg+  pure x =+    Elision (const (const (pure x))) +  el0 <*> el1 =+    Elision $ \cont arg ->+      let run = complete cont arg+       in run el0 <*> run el1+ instance Monad (Elision f a) where-  e >>= fn = Elision $ \e' arg -> complete e' arg . fn =<< complete e' arg e+  el >>= fn =+    Elision $ \cont arg ->+      let run = complete cont arg+       in run . fn =<< run el  instance Profunctor (Elision f) where-  dimap l r e = Elision $ \e' -> dimap l (fmap r) (unelide e e')+  dimap l r el =+    Elision $ \cont ->+      let fn = unelide el cont+       in dimap l (fmap r) fn  instance Category (Elision f) where-  id      = Elision $ \_  arg -> pure arg-  e1 . e0 = Elision $ \e' arg -> unelide e1 e' =<< unelide e0 e' arg+  id =+    Elision (const pure) +  el1 . el0 =+    Elision (\cont -> unelide el1 cont <=< unelide el0 cont)+ instance Arrow (Elision f) where-  arr   fn = Elision $ \_ -> pure . fn-  first e  = Elision $ \e' (x,y) -> fmap (,y) (unelide e e' x)+  arr fn =+    Elision (const (pure . fn)) +  first el =+    Elision (\cont ~(x,y) -> fmap (,y) (unelide el cont x))+ instance ArrowChoice (Elision f) where-  left e = Elision $ \e' arg ->-    case arg of-      Left l  -> fmap Left (unelide e e' l)-      Right r -> pure (Right r)+  left el = Elision $ \cont ->+    fmap Left . unelide el cont ||| pure . Right  instance ArrowApply (Elision f) where-  app = Elision $ \e' (arr', arg) -> complete' e' (arr' <<^ const arg)+  app = Elision (\cont ~(el, arg) -> complete' cont (el `apply` arg))  -------------------------------------------------------------------------------- -- | The type of the simplist elision, where @unelide eli f = f@-type Elision' f a = Elision f (f a) a+type Elision' f a =+  Elision f (f a) a  -------------------------------------------------------------------------------- -- | Deconstruct an Elision, returning its inner type. unelide :: Monad m => Elision f a b -> (forall c. f c -> m c) -> a -> m b-unelide (Elision e) = e+unelide (Elision el) =+  el  -------------------------------------------------------------------------------- -- | Like 'unelide', but applies the unit type to the function immediately. unelide' :: Monad m => Elision f () b -> (forall c. f c -> m c) -> m b-unelide' e fn = unelide e fn ()+unelide' el fn =+  unelide el fn ()  -------------------------------------------------------------------------------- -- | Construct an interpreter for an elision out of a function an initial -- argument. complete :: Monad m => (forall c. f c -> m c) -> a -> Elision f a b -> m b-complete fn arg (Elision e) = e fn arg+complete fn arg (Elision el) =+  el fn arg  -------------------------------------------------------------------------------- -- | Like 'complete', but the unit type never has to be provided. complete' :: Monad m => (forall c. f c -> m c) -> Elision f () b -> m b-complete' fn = complete fn ()+complete' fn =+  complete fn ()  ----------------------------------------------------------------------------------- | The simplest elision, effectively the identity function.-simple :: Elision' f a-simple = Elision (\f x -> f x)+-- | Apply an argument to an arrow and close off the input.+apply :: Arrow a => a b c -> b -> a () c+apply arrow arg =+  arrow <<^ const arg  ----------------------------------------------------------------------------------- | Apply a value to an elision immediately.-initial :: f a -> Elision f () a-initial x = simple <<^ const x+-- | The simplest elision, effectively the identity function.+basic :: Elision' f a+basic =+  Elision (\f x -> f x)  -------------------------------------------------------------------------------- -- | Create an elision out of two functions to be completed at a later date. elide :: (a -> f c) -> (c -> b) -> Elision f a b-elide f g = Elision $ \e' x -> dimap f (fmap g) e' x+elide f g =+  dimap f g basic  --------------------------------------------------------------------------------+-- | Create an elision with the input fully applied.+terminal :: f a -> Elision f () a+terminal x =+  lmap (const x) basic++-------------------------------------------------------------------------------- -- | Either @f a@ or @g a@. newtype Sum f g a =   Sum { runSum :: Either (f a) (g a) }  -------------------------------------------------------------------------------- -- | A type synonym for 'Sum' to create harmony with the '//' function.-type a // b = Sum a b+type a // b =+  Sum a b  -------------------------------------------------------------------------------- -- | Create a function that can complete an elision of a sum out of two -- functions that can complete each individual parts. (//) :: (forall b. f b -> m b) -> (forall b. g b -> m b) -> Sum f g a -> m a-f // g = either f g . runSum+f // g =+  f ||| g <<^ runSum  -------------------------------------------------------------------------------- -- | Like 'left', but over the first type argument. left' :: Elision f a b -> Elision (f // g) a b-left' e = Elision $ \e' -> unelide e (e' . Sum . Left)+left' el =+  Elision (\cont -> unelide el (cont . Sum . Left))  -------------------------------------------------------------------------------- -- | Like 'right', but over the first type argument. right' :: Elision g a b -> Elision (f // g) a b-right' e = Elision $ \e' -> unelide e (e' . Sum . Right)+right' e =+  Elision $ \e' -> unelide e (e' . Sum . Right)  -------------------------------------------------------------------------------- -- | Send the output of the left to the input of right, and add their @f@ -- types together.-(/>) :: Elision f a b -> Elision g b c -> Elision (f // g) a c-a /> b = right' b . left' a+--+-- This is analogous to a lifted '(>>>)'.+(/>>) :: Elision f a b -> Elision g b c -> Elision (f // g) a c+a />> b =+  left' a >>> right' b  -------------------------------------------------------------------------------- -- | Send the output of the right to the input of the left, and add their @f@ -- types together.-(</) :: Elision f b c -> Elision g a b -> Elision (f // g) a c-b </ a = left' b . right' a--apply :: ArrowApply a => a b c -> b -> a () c-apply arrow arg =-  app <<^ const (arrow, arg)+--+-- This is analogous to a lifted '(>>>)'.+(<</) :: Elision f b c -> Elision g a b -> Elision (f // g) a c+b <</ a =+  left' b <<< right' a