selective 0.4.1 → 0.4.1.1

raw patch · 3 files changed

+54/−10 lines, 3 files

Files

selective.cabal +2/−3
src/Control/Selective/Multi.hs +3/−3
test/Sketch.hs +49/−4

selective.cabal view

@@ -1,5 +1,5 @@ name:          selective-version:       0.4.1+version:       0.4.1.1 synopsis:      Selective applicative functors license:       MIT license-file:  LICENSE@@ -49,8 +49,7 @@                         GeneralizedNewtypeDeriving,                         RankNTypes,                         StandaloneDeriving,-                        TupleSections,-                        TypeApplications+                        TupleSections     GHC-options:        -Wall                         -fno-warn-name-shadowing                         -Wcompat

src/Control/Selective/Multi.hs view

@@ -119,7 +119,7 @@  -- | A class of tags that can be enumerated. ----- An valid instance must list every tag in the resulting list exactly once.+-- A valid instance must list every tag in the resulting list exactly once. class Enumerable t where     enumerate :: [Some t] @@ -203,11 +203,11 @@  -- | Recover the application operator '<*>' from 'matchOne'. ap :: ApplicativeS f => f a -> f (a -> b) -> f b-ap x f = matchOne (inject One <$> x) (\One -> f)+ap x f = matchOne (Sigma One <$> x) (\One -> f)  -- | Every 'Applicative' is also an 'ApplicativeS'. matchA :: (Applicative f, t ~ One x) => f (Sigma t) -> (forall x. t x -> f (x -> a)) -> f a-matchA x pi = (\case (Sigma One x) -> x) <$> x <**> pi One+matchA x pi = (\(Sigma One x) -> x) <$> x <**> pi One  -- | An alternative definition of monads, as witnessed by 'bind' and 'matchM'. -- This class is almost like 'Selective' but has no the constraint on @t@.

test/Sketch.hs view

@@ -1,6 +1,6 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveFunctor, EmptyCase, FlexibleInstances, GADTs, RankNTypes #-} {-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables, TupleSections #-}-{-# LANGUAGE TypeFamilies #-} module Sketch where  import Control.Arrow hiding (first, second)@@ -10,6 +10,9 @@ import Data.Bifunctor import Data.Bool import Data.Function+import Data.Functor+import Data.Functor.Identity+import Data.Functor.Const import Data.Semigroup (Semigroup (..)) import Data.Void @@ -301,7 +304,7 @@  -- Composition of Starry and Either monad -- See: https://duplode.github.io/posts/applicative-archery.html-class Applicative f => SelectiveStarry f where+class Applicative f => SelectiveS f where     (|.|) :: f (Either e (b -> c)) -> f (Either e (a -> b)) -> f (Either e (a -> c))  -- Composition of Monoidal and Either monad@@ -454,9 +457,11 @@ -- encoded in terms of the coproduct injections without losing the input -- @a@ itself. grdS :: Applicative f => f (a -> Bool) -> f a -> f (Either a a)-grdS f a = (selector <$> (f <*> a)) <*> a+grdS f a = selector <$> applyF f (dup <$> a)   where-      selector = bool Right Left+    dup x = (x, x)+    applyF fab faa = bimap <$> fab <*> pure id <*> faa+    selector (b, x) = bool (Right x) (Left x) b  -- | McCarthy's conditional, denoted p -> f,g is a well-known functional -- combinator, which suggests that, to reason about conditionals, one may@@ -588,7 +593,47 @@         case rx of Done       x -> runHaxl (f x) -- dynamic dependency on runtime value 'x'                    Blocked bx x -> return (Blocked bx (x >>= f)) +-- right' :: Choice p => p a b -> p (Either c a) (Either c b)+-- right' :: ... => (a -> f b) -> Either x a -> f (Either x b) +data P s t a b = P { match' :: s -> Either a t, build' :: b -> t }++fromP :: P s t a b -> Prism s t a b+fromP (P match build) f s = case match s of+    Left  a -> build <$> f a+    Right t -> pure t+++-- Choice p, Applicative f) => p a (f b) -> p s (f t)++-- (a -> f b) -> (Either a x -> f (Either b x))++type Lens      s t a b = forall f. Functor f     => (a -> f b) -> s -> f t+type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t+type Prism     s t a b = forall f. Selective f   => (a -> f b) -> s -> f t++_fst :: Lens (a, x) (b, x) a b+_fst f (a, x) = f a <&> (,x)++_snd :: Lens (x, a) (x, b) a b+_snd f (x, a) = (x,) <$> f a++_Left :: Prism (Either a x) (Either b x) a b+_Left f = \case Left  a -> Left <$> f a+                Right x -> pure (Right x)++view :: Lens s t a b -> s -> a+view lens s = getConst $ lens (\a -> Const a) s++update :: Lens s t a b -> b -> s -> t+update lens b s = runIdentity $ lens (\_a -> Identity b) s++match :: Prism s t a b -> s -> Either a t+match prism s = prism Left s++-- (a -> f s b) -> s -> f s t+build :: Prism s t a b -> b -> t+build prism b = either absurd id $ prism (\_a -> Right b) undefined   -- x <*? (y <*? z)