lens-action-0.2.0.2/0000755000000000000000000000000012615765057012271 5ustar0000000000000000lens-action-0.2.0.2/.ghci0000644000000000000000000000012512615765057013202 0ustar0000000000000000:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h lens-action-0.2.0.2/.gitignore0000644000000000000000000000017512615765057014264 0ustar0000000000000000dist/ .hsenv/ docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# .cabal-sandbox/ cabal.sandbox.config codex.tags lens-action-0.2.0.2/CHANGELOG.markdown0000644000000000000000000000046212615765057015326 0ustar00000000000000000.2.0.2 --- * Migrate to new `phantom` definition in `contravariant` 0.2.0.1 --- * Add `Control.Lens.Action.Type` to exposed-modules list. 0.2 --- * `profunctors-5` and `lens-4.10` support 0.1.0.1 --- * Add `Control.Lens.Action.Type` to exposed-modules list. 0.1 ---- * Initial split from lens package lens-action-0.2.0.2/lens-action.cabal0000644000000000000000000000402312615765057015470 0ustar0000000000000000name: lens-action category: Data, Lenses, Generics version: 0.2.0.2 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/lens-action/ bug-reports: http://github.com/ekmett/lens-action/issues copyright: Copyright (C) 2012-2014 Edward A. Kmett build-type: Custom -- build-tools: cpphs tested-with: GHC == 7.8.3 synopsis: Monadic Getters and Folds description: This package contains combinators and types for working with monadic getters and folds as split off from the original lens package. extra-source-files: .ghci .gitignore CHANGELOG.markdown source-repository head type: git location: git://github.com/ekmett/lens-action.git -- You can disable the doctests test suite with -f-test-doctests flag test-doctests default: True manual: True library build-depends: lens >= 4.7 && < 5, base >= 4.5 && < 5, comonad >= 4 && < 5, contravariant >= 1.2.1 && < 2, profunctors >= 4 && < 6, mtl >= 2.0.1 && < 2.3, semigroups >= 0.8.4 && < 1, semigroupoids >= 4 && < 6, transformers >= 0.2 && < 0.5 exposed-modules: Control.Lens.Action Control.Lens.Action.Internal Control.Lens.Action.Reified Control.Lens.Action.Type cpp-options: -traditional ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields -fmax-simplifier-iterations=10 hs-source-dirs: src -- Verify the results of the examples test-suite doctests type: exitcode-stdio-1.0 main-is: doctests.hs ghc-options: -Wall -threaded hs-source-dirs: tests if !flag(test-doctests) buildable: False else build-depends: base, doctest >= 0.9.1, filepath, directory lens-action-0.2.0.2/LICENSE0000644000000000000000000000266012615765057013302 0ustar0000000000000000Copyright 2012-2014 Edward Kmett All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. lens-action-0.2.0.2/Setup.lhs0000644000000000000000000000402012615765057014075 0ustar0000000000000000#!/usr/bin/runhaskell \begin{code} {-# OPTIONS_GHC -Wall #-} module Main (main) where import Data.List ( nub ) import Data.Version ( showVersion ) import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName ) import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) ) import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles ) import Distribution.Simple.BuildPaths ( autogenModulesDir ) import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref)) import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) ) import Distribution.Text ( display ) import Distribution.Verbosity ( Verbosity, normal ) import System.FilePath ( () ) main :: IO () main = defaultMainWithHooks simpleUserHooks { buildHook = \pkg lbi hooks flags -> do generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi buildHook simpleUserHooks pkg lbi hooks flags } generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () generateBuildModule verbosity pkg lbi = do let dir = autogenModulesDir lbi createDirectoryIfMissingVerbose verbosity True dir withLibLBI pkg lbi $ \_ libcfg -> do withTestLBI pkg lbi $ \suite suitecfg -> do rewriteFile (dir "Build_" ++ testName suite ++ ".hs") $ unlines [ "module Build_" ++ testName suite ++ " where" , "deps :: [String]" , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg)) ] where formatdeps = map (formatone . snd) formatone p = case packageName p of PackageName n -> n ++ "-" ++ showVersion (packageVersion p) testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys \end{code} lens-action-0.2.0.2/src/0000755000000000000000000000000012615765057013060 5ustar0000000000000000lens-action-0.2.0.2/src/Control/0000755000000000000000000000000012615765057014500 5ustar0000000000000000lens-action-0.2.0.2/src/Control/Lens/0000755000000000000000000000000012615765057015401 5ustar0000000000000000lens-action-0.2.0.2/src/Control/Lens/Action.hs0000644000000000000000000001344612615765057017162 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Action -- Copyright : (C) 2012-14 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Action ( -- * Composable Actions Action , act , acts , perform , performs , liftAct , (^!) , (^!!) , (^!?) -- * Indexed Actions , IndexedAction , iact , iperform , iperforms , (^@!) , (^@!!) , (^@!?) -- * Folds with Effects , MonadicFold , IndexedMonadicFold -- * Implementation Details , Acting , IndexedActing , Effective ) where import Control.Comonad import Control.Lens.Internal.Fold import Control.Lens.Internal.Indexed import Control.Lens.Type import Control.Monad (liftM) import Control.Monad.Trans.Class import Data.Profunctor import Data.Profunctor.Rep #if MIN_VERSION_profunctors(5,0,0) import Data.Profunctor.Sieve #endif import Data.Profunctor.Unsafe import Control.Lens.Action.Internal import Control.Lens.Action.Type -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens infixr 8 ^!, ^!!, ^@!, ^@!!, ^!?, ^@!? -- | Used to evaluate an 'Action'. type Acting m r s a = LensLike (Effect m r) s s a a -- | Perform an 'Action'. -- -- @ -- 'perform' ≡ 'flip' ('^!') -- @ perform :: Monad m => Acting m a s a -> s -> m a perform l = getEffect #. l (Effect #. return) {-# INLINE perform #-} -- | Perform an 'Action' and modify the result. -- -- @ -- 'performs' :: 'Monad' m => 'Acting' m e s a -> (a -> e) -> s -> m e -- @ performs :: (Profunctor p, Monad m) => Over p (Effect m e) s t a b -> p a e -> s -> m e performs l f = getEffect #. l (rmap (Effect #. return) f) {-# INLINE performs #-} -- | Perform an 'Action'. -- -- >>> ["hello","world"]^!folded.act putStrLn -- hello -- world (^!) :: Monad m => s -> Acting m a s a -> m a a ^! l = getEffect (l (Effect #. return) a) {-# INLINE (^!) #-} -- | Perform a 'MonadicFold' and collect all of the results in a list. -- -- >>> ["ab","cd","ef"]^!!folded.acts -- ["ace","acf","ade","adf","bce","bcf","bde","bdf"] -- -- @ -- > [1,2]^!!folded.act (\i -> putStr (show i ++ ": ") >> getLine).each.to succ -- 1: aa -- 2: bb -- "bbcc" -- @ (^!!) :: Monad m => s -> Acting m [a] s a -> m [a] a ^!! l = getEffect (l (Effect #. return . return) a) {-# INLINE (^!!) #-} -- | Perform a 'MonadicFold' and collect the leftmost result. -- -- /Note:/ this still causes all effects for all elements. -- -- >>> [Just 1, Just 2, Just 3]^!?folded.acts -- Just (Just 1) -- >>> [Just 1, Nothing]^!?folded.acts -- Nothing (^!?) :: Monad m => s -> Acting m (Leftmost a) s a -> m (Maybe a) a ^!? l = liftM getLeftmost .# getEffect $ l (Effect #. return . LLeaf) a {-# INLINE (^!?) #-} -- | Construct an 'Action' from a monadic side-effect. -- -- >>> ["hello","world"]^!folded.act (\x -> [x,x ++ "!"]) -- ["helloworld","helloworld!","hello!world","hello!world!"] -- -- @ -- 'act' :: 'Monad' m => (s -> m a) -> 'Action' m s a -- 'act' sma afb a = 'effective' (sma a '>>=' 'ineffective' '.' afb) -- @ act :: Monad m => (s -> m a) -> IndexPreservingAction m s a act sma pafb = cotabulate $ \ws -> effective $ do a <- sma (extract ws) #if MIN_VERSION_profunctors(5,0,0) ineffective (cosieve pafb (a <$ ws)) #else ineffective (corep pafb (a <$ ws)) #endif {-# INLINE act #-} -- | A self-running 'Action', analogous to 'Control.Monad.join'. -- -- @ -- 'acts' ≡ 'act' 'id' -- @ -- -- >>> (1,"hello")^!_2.acts.to succ -- "ifmmp" -- -- @ -- > (1,getLine)^!!_2.acts.folded.to succ -- aa -- "bb" -- @ acts :: IndexPreservingAction m (m a) a acts = act id {-# INLINE acts #-} -- | Apply a 'Monad' transformer to an 'Action'. liftAct :: (MonadTrans trans, Monad m) => Acting m a s a -> IndexPreservingAction (trans m) s a liftAct l = act (lift . perform l) {-# INLINE liftAct #-} ----------------------------------------------------------------------------- -- Indexed Actions ---------------------------------------------------------------------------- -- | Used to evaluate an 'IndexedAction'. type IndexedActing i m r s a = Over (Indexed i) (Effect m r) s s a a -- | Perform an 'IndexedAction'. -- -- @ -- 'iperform' ≡ 'flip' ('^@!') -- @ iperform :: Monad m => IndexedActing i m (i, a) s a -> s -> m (i, a) iperform l = getEffect #. l (Indexed $ \i a -> Effect (return (i, a))) {-# INLINE iperform #-} -- | Perform an 'IndexedAction' and modify the result. iperforms :: Monad m => IndexedActing i m e s a -> (i -> a -> e) -> s -> m e iperforms l = performs l .# Indexed {-# INLINE iperforms #-} -- | Perform an 'IndexedAction'. (^@!) :: Monad m => s -> IndexedActing i m (i, a) s a -> m (i, a) s ^@! l = getEffect (l (Indexed $ \i a -> Effect (return (i, a))) s) {-# INLINE (^@!) #-} -- | Obtain a list of all of the results of an 'IndexedMonadicFold'. (^@!!) :: Monad m => s -> IndexedActing i m [(i, a)] s a -> m [(i, a)] s ^@!! l = getEffect (l (Indexed $ \i a -> Effect (return [(i, a)])) s) {-# INLINE (^@!!) #-} -- | Perform an 'IndexedMonadicFold' and collect the 'Leftmost' result. -- -- /Note:/ this still causes all effects for all elements. (^@!?) :: Monad m => s -> IndexedActing i m (Leftmost (i, a)) s a -> m (Maybe (i, a)) a ^@!? l = liftM getLeftmost .# getEffect $ l (Indexed $ \i -> Effect #. return . LLeaf . (,) i) a {-# INLINE (^@!?) #-} -- | Construct an 'IndexedAction' from a monadic side-effect. iact :: Monad m => (s -> m (i, a)) -> IndexedAction i m s a iact smia iafb s = effective $ do (i, a) <- smia s ineffective (indexed iafb i a) {-# INLINE iact #-} lens-action-0.2.0.2/src/Control/Lens/Action/0000755000000000000000000000000012615765057016616 5ustar0000000000000000lens-action-0.2.0.2/src/Control/Lens/Action/Internal.hs0000644000000000000000000000732612615765057020736 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Action -- Copyright : (C) 2012-2014 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Action.Internal ( -- ** Actions Effective(..) , Effect(..) ) where import Control.Applicative import Control.Applicative.Backwards import Control.Monad import Data.Functor.Bind import Data.Functor.Contravariant import Data.Functor.Identity import Data.Profunctor.Unsafe import Data.Semigroup import Control.Lens.Internal.Getter ------------------------------------------------------------------------------- -- Programming with Effects ------------------------------------------------------------------------------- -- | An 'Effective' 'Functor' ignores its argument and is isomorphic to a 'Monad' wrapped around a value. -- -- That said, the 'Monad' is possibly rather unrelated to any 'Applicative' structure. class (Monad m, Functor f, Contravariant f) => Effective m r f | f -> m r where effective :: m r -> f a ineffective :: f a -> m r instance Effective m r f => Effective m (Dual r) (Backwards f) where effective = Backwards . effective . liftM getDual {-# INLINE effective #-} ineffective = liftM Dual . ineffective . forwards {-# INLINE ineffective #-} instance Effective Identity r (Const r) where effective = Const #. runIdentity {-# INLINE effective #-} ineffective = Identity #. getConst {-# INLINE ineffective #-} instance Effective m r f => Effective m r (AlongsideLeft f b) where effective = AlongsideLeft . effective {-# INLINE effective #-} ineffective = ineffective . getAlongsideLeft {-# INLINE ineffective #-} instance Effective m r f => Effective m r (AlongsideRight f b) where effective = AlongsideRight . effective {-# INLINE effective #-} ineffective = ineffective . getAlongsideRight {-# INLINE ineffective #-} ------------------------------------------------------------------------------ -- Effect ------------------------------------------------------------------------------ -- | Wrap a monadic effect with a phantom type argument. newtype Effect m r a = Effect { getEffect :: m r } -- type role Effect representational nominal phantom instance Functor (Effect m r) where fmap _ (Effect m) = Effect m {-# INLINE fmap #-} instance Contravariant (Effect m r) where contramap _ (Effect m) = Effect m {-# INLINE contramap #-} instance Monad m => Effective m r (Effect m r) where effective = Effect {-# INLINE effective #-} ineffective = getEffect {-# INLINE ineffective #-} instance (Apply m, Semigroup r) => Semigroup (Effect m r a) where Effect ma <> Effect mb = Effect (liftF2 (<>) ma mb) {-# INLINE (<>) #-} instance (Monad m, Monoid r) => Monoid (Effect m r a) where mempty = Effect (return mempty) {-# INLINE mempty #-} Effect ma `mappend` Effect mb = Effect (liftM2 mappend ma mb) {-# INLINE mappend #-} instance (Apply m, Semigroup r) => Apply (Effect m r) where Effect ma <.> Effect mb = Effect (liftF2 (<>) ma mb) {-# INLINE (<.>) #-} instance (Monad m, Monoid r) => Applicative (Effect m r) where pure _ = Effect (return mempty) {-# INLINE pure #-} Effect ma <*> Effect mb = Effect (liftM2 mappend ma mb) {-# INLINE (<*>) #-} lens-action-0.2.0.2/src/Control/Lens/Action/Reified.hs0000644000000000000000000001050312615765057020520 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Action.Reified -- Copyright : (C) 2012-14 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Action.Reified where import Control.Applicative import Control.Arrow import qualified Control.Category as Cat import Control.Lens hiding ((<.>)) import Control.Monad import Control.Monad.Reader.Class import Data.Functor.Contravariant import Data.Functor.Bind import Data.Functor.Plus import Data.Profunctor import Data.Semigroup import Control.Lens.Action ------------------------------------------------------------------------------ -- MonadicFold ------------------------------------------------------------------------------ -- | Reify a 'MonadicFold' so it can be stored safely in a container. -- newtype ReifiedMonadicFold m s a = MonadicFold { runMonadicFold :: MonadicFold m s a } instance Profunctor (ReifiedMonadicFold m) where dimap f g l = MonadicFold (to f . runMonadicFold l . to g) {-# INLINE dimap #-} rmap g l = MonadicFold (runMonadicFold l . to g) {-# INLINE rmap #-} lmap f l = MonadicFold (to f . runMonadicFold l) {-# INLINE lmap #-} instance Strong (ReifiedMonadicFold m) where first' l = MonadicFold $ \f (s,c) -> phantom $ runMonadicFold l (dimap (flip (,) c) phantom f) s {-# INLINE first' #-} second' l = MonadicFold $ \f (c,s) -> phantom $ runMonadicFold l (dimap ((,) c) phantom f) s {-# INLINE second' #-} instance Choice (ReifiedMonadicFold m) where left' (MonadicFold l) = MonadicFold $ to tuplify.beside (folded.l.to Left) (folded.to Right) where tuplify (Left lval) = (Just lval,Nothing) tuplify (Right rval) = (Nothing,Just rval) {-# INLINE left' #-} instance Cat.Category (ReifiedMonadicFold m) where id = MonadicFold id l . r = MonadicFold (runMonadicFold r . runMonadicFold l) {-# INLINE (.) #-} instance Arrow (ReifiedMonadicFold m) where arr f = MonadicFold (to f) {-# INLINE arr #-} first = first' {-# INLINE first #-} second = second' {-# INLINE second #-} instance ArrowChoice (ReifiedMonadicFold m) where left = left' {-# INLINE left #-} right = right' {-# INLINE right #-} instance ArrowApply (ReifiedMonadicFold m) where app = MonadicFold $ \cHandler (argFold,b) -> runMonadicFold (pure b >>> argFold) cHandler (argFold,b) {-# INLINE app #-} instance Functor (ReifiedMonadicFold m s) where fmap f l = MonadicFold (runMonadicFold l.to f) {-# INLINE fmap #-} instance Apply (ReifiedMonadicFold m s) where mf <.> ma = mf &&& ma >>> (MonadicFold $ to (uncurry ($))) {-# INLINE (<.>) #-} instance Applicative (ReifiedMonadicFold m s) where pure a = MonadicFold $ folding $ \_ -> [a] {-# INLINE pure #-} mf <*> ma = mf <.> ma {-# INLINE (<*>) #-} instance Alternative (ReifiedMonadicFold m s) where empty = MonadicFold ignored {-# INLINE empty #-} MonadicFold ma <|> MonadicFold mb = MonadicFold $ to (\x->(x,x)).beside ma mb {-# INLINE (<|>) #-} instance Bind (ReifiedMonadicFold m s) where ma >>- f = ((ma >>^ f) &&& returnA) >>> app {-# INLINE (>>-) #-} instance Monad (ReifiedMonadicFold m s) where return a = MonadicFold $ folding $ \_ -> [a] {-# INLINE return #-} ma >>= f = ((ma >>^ f) &&& returnA) >>> app {-# INLINE (>>=) #-} instance MonadReader s (ReifiedMonadicFold m s) where ask = returnA {-# INLINE ask #-} local f ma = f ^>> ma {-# INLINE local #-} instance MonadPlus (ReifiedMonadicFold m s) where mzero = empty {-# INLINE mzero #-} mplus = (<|>) {-# INLINE mplus #-} instance Semigroup (ReifiedMonadicFold m s a) where (<>) = (<|>) {-# INLINE (<>) #-} instance Monoid (ReifiedMonadicFold m s a) where mempty = MonadicFold ignored {-# INLINE mempty #-} mappend = (<|>) {-# INLINE mappend #-} instance Alt (ReifiedMonadicFold m s) where () = (<|>) {-# INLINE () #-} instance Plus (ReifiedMonadicFold m s) where zero = MonadicFold ignored {-# INLINE zero #-} lens-action-0.2.0.2/src/Control/Lens/Action/Type.hs0000644000000000000000000000772012615765057020101 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Action.Type -- Copyright : (C) 2012-14 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- module Control.Lens.Action.Type ( -- * Getters and Folds Action , MonadicFold , RelevantMonadicFold -- * Indexed , IndexedAction , IndexedMonadicFold , IndexedRelevantMonadicFold -- * Index-Preserving , IndexPreservingAction , IndexPreservingMonadicFold , IndexPreservingRelevantMonadicFold ) where import Control.Applicative (Applicative) import Control.Lens (Conjoined, Indexable) import Data.Functor.Apply (Apply) import Prelude () import Control.Lens.Action.Internal (Effective) ------------------------------------------------------------------------------- -- Actions ------------------------------------------------------------------------------- -- | An 'Action' is a 'Getter' enriched with access to a 'Monad' for side-effects. -- -- Every 'Getter' can be used as an 'Action'. -- -- You can compose an 'Action' with another 'Action' using ('Prelude..') from the @Prelude@. type Action m s a = forall f r. Effective m r f => (a -> f a) -> s -> f s -- | An 'IndexedAction' is an 'IndexedGetter' enriched with access to a 'Monad' for side-effects. -- -- Every 'Getter' can be used as an 'Action'. -- -- You can compose an 'Action' with another 'Action' using ('Prelude..') from the @Prelude@. type IndexedAction i m s a = forall p f r. (Indexable i p, Effective m r f) => p a (f a) -> s -> f s -- | An 'IndexPreservingAction' can be used as a 'Action', but when composed with an 'IndexedTraversal', -- 'IndexedFold', or 'IndexedLens' yields an 'IndexedMonadicFold', 'IndexedMonadicFold' or 'IndexedAction' respectively. type IndexPreservingAction m s a = forall p f r. (Conjoined p, Effective m r f) => p a (f a) -> p s (f s) ------------------------------------------------------------------------------- -- MonadicFolds ------------------------------------------------------------------------------- -- | A 'MonadicFold' is a 'Fold' enriched with access to a 'Monad' for side-effects. -- -- A 'MonadicFold' can use side-effects to produce parts of the structure being folded (e.g. reading them from file). -- -- Every 'Fold' can be used as a 'MonadicFold', that simply ignores the access to the 'Monad'. -- -- You can compose a 'MonadicFold' with another 'MonadicFold' using ('Prelude..') from the @Prelude@. type MonadicFold m s a = forall f r. (Effective m r f, Applicative f) => (a -> f a) -> s -> f s type RelevantMonadicFold m s a = forall f r. (Effective m r f, Apply f) => (a -> f a) -> s -> f s -- | An 'IndexedMonadicFold' is an 'IndexedFold' enriched with access to a 'Monad' for side-effects. -- -- Every 'IndexedFold' can be used as an 'IndexedMonadicFold', that simply ignores the access to the 'Monad'. -- -- You can compose an 'IndexedMonadicFold' with another 'IndexedMonadicFold' using ('Prelude..') from the @Prelude@. type IndexedMonadicFold i m s a = forall p f r. (Indexable i p, Effective m r f, Applicative f) => p a (f a) -> s -> f s type IndexedRelevantMonadicFold i m s a = forall p f r. (Indexable i p, Effective m r f, Apply f) => p a (f a) -> s -> f s -- | An 'IndexPreservingFold' can be used as a 'Fold', but when composed with an 'IndexedTraversal', -- 'IndexedFold', or 'IndexedLens' yields an 'IndexedFold' respectively. type IndexPreservingMonadicFold m s a = forall p f r. (Conjoined p, Effective m r f, Applicative f) => p a (f a) -> p s (f s) type IndexPreservingRelevantMonadicFold m s a = forall p f r. (Conjoined p, Effective m r f, Apply f) => p a (f a) -> p s (f s) lens-action-0.2.0.2/tests/0000755000000000000000000000000012615765057013433 5ustar0000000000000000lens-action-0.2.0.2/tests/doctests.hsc0000644000000000000000000000450112615765057015762 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- | -- Module : Main (doctests) -- Copyright : (C) 2012-14 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- This module provides doctests for a project based on the actual versions -- of the packages it was built with. It requires a corresponding Setup.lhs -- to be added to the project ----------------------------------------------------------------------------- module Main where import Build_doctests (deps) import Control.Applicative import Control.Monad import Data.List import System.Directory import System.FilePath import Test.DocTest ##if defined(mingw32_HOST_OS) ##if defined(i386_HOST_ARCH) ##define USE_CP import Control.Applicative import Control.Exception import Foreign.C.Types foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt ##elif defined(x86_64_HOST_ARCH) ##define USE_CP import Control.Applicative import Control.Exception import Foreign.C.Types foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt ##endif ##endif -- | Run in a modified codepage where we can print UTF-8 values on Windows. withUnicode :: IO a -> IO a ##ifdef USE_CP withUnicode m = do cp <- c_GetConsoleCP (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp ##else withUnicode m = m ##endif main :: IO () main = withUnicode $ getSources >>= \sources -> doctest $ "-isrc" : "-idist/build/autogen" : "-optP-include" : "-optPdist/build/autogen/cabal_macros.h" : "-hide-all-packages" : map ("-package="++) deps ++ sources getSources :: IO [FilePath] getSources = filter (isSuffixOf ".hs") <$> go "src" where go dir = do (dirs, files) <- getFilesAndDirectories dir (files ++) . concat <$> mapM go dirs getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) getFilesAndDirectories dir = do c <- map (dir ) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c