focus 0.1.5.2 → 1

raw patch · 3 files changed

+425/−98 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• focus.cabal +8/−13
• library/Focus.hs +348/−85
• library/Focus/Prelude.hs +69/−0

@@ -1,7 +1,7 @@ name:   focus version:-  0.1.5.2+  1 synopsis:   A general abstraction for manipulating elements of container data structures description:@@ -38,12 +38,6 @@   Simple cabal-version:   >=1.10-tested-with:-  GHC==7.6.3,-  GHC==7.8.4,-  GHC==7.10.3,-  GHC==8.0.1-  GHC==8.2.1  source-repository head   type:@@ -51,15 +45,16 @@   location:     git://github.com/nikita-volkov/focus.git - library   hs-source-dirs:     library-  exposed-modules:-    Focus-  build-depends:-    base >= 4.6 && < 5   default-extensions:-    DeriveFunctor, NoImplicitPrelude, TupleSections+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedLists, OverloadedStrings, PatternGuards, PatternSynonyms, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UnboxedTuples   default-language:     Haskell2010+  exposed-modules:+    Focus+  other-modules:+    Focus.Prelude+  build-depends:+    base >=4.6 && <5

@@ -1,115 +1,378 @@ module Focus where -import Prelude hiding (adjust, update, alter, insert, delete, lookup)-import Control.Monad+import Focus.Prelude hiding (adjust, update, alter, insert, delete, lookup)  --- |--- A general modification function for some match.--- By processing a 'Maybe' value it produces some value to emit and --- a 'Decision' to perform on the match.--- --- The interpretation of this function is up to the context APIs.-type Strategy a r = Maybe a -> (r, Decision a)+{-|+Abstraction over the modification of an element of a datastructure. --- |--- A monadic version of 'Strategy'.-type StrategyM m a r = Maybe a -> m (r, Decision a)+It is composable using the standard typeclasses, e.g.: --- |--- What to do with the focused value.--- --- The interpretation of the commands is up to the context APIs.-data Decision a =-  Keep |-  Remove |-  Replace a-  deriving (Functor)+>lookupAndDelete :: Monad m => Focus a m (Maybe a)+>lookupAndDelete = lookup <* delete+-}+data Focus element m result = Focus (m (result, Change element)) (element -> m (result, Change element)) +deriving instance Functor m => Functor (Focus element m) --- * Constructors for common pure patterns+instance Monad m => Applicative (Focus element m) where+  pure = return+  (<*>) = ap++instance Monad m => Monad (Focus element m) where+  return result = Focus (return (result, Leave)) (\ _ -> return (result, Leave))+  (>>=) (Focus aAbsent bPresent) bKleisli = let+    sendSome element = do+      (aResult, aChange) <- bPresent element+      case bKleisli aResult of+        Focus bAbsent bOnElement -> case aChange of+          Leave -> bOnElement element+          Remove -> bAbsent+          Set newElement -> bOnElement newElement+    sendNone = do+      (aResult, aChange) <- aAbsent+      case bKleisli aResult of+        Focus bAbsent bOnElement -> case aChange of+          Set newElement -> bOnElement newElement+          Leave -> bAbsent+          Remove -> bAbsent+    in Focus sendNone sendSome++{-|+What to do with the focused value.++The interpretation of the commands is up to the context APIs.+-}+data Change a = Leave | Remove | Set a deriving (Functor, Eq, Ord, Show)+++-- * Pure functions ------------------------- --- |--- Reproduces the behaviour of--- @Data.Map.<http://hackage.haskell.org/package/containers-0.5.5.1/docs/Data-Map-Lazy.html#v:adjust adjust>@.+-- ** Reading functions+-------------------------++{-|+Reproduces the behaviour of+@Data.Map.<http://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Map-Lazy.html#v:lookup lookup>@.+-}+{-# INLINE member #-}+member :: Monad m => Focus a m Bool+member = fmap (maybe False (const True)) lookup++{-|+Reproduces the behaviour of+@Data.Map.<http://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Map-Lazy.html#v:lookup lookup>@.+-}+{-# INLINE[1] lookup #-}+lookup :: Monad m => Focus a m (Maybe a)+lookup = cases (Nothing, Leave) (\ a -> (Just a, Leave))++{-|+Reproduces the behaviour of+@Data.Map.<http://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Map-Lazy.html#v:findWithDefault findWithDefault>@+with a better name.+-}+{-# INLINE[1] lookupWithDefault #-}+lookupWithDefault :: Monad m => a -> Focus a m a+lookupWithDefault a = cases (a, Leave) (\ a -> (a, Leave))++-- ** Modifying functions+-------------------------++{-|+Reproduces the behaviour of+@Data.Map.<http://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Map-Lazy.html#v:delete delete>@.+-}+{-# INLINE[1] delete #-}+delete :: Monad m => Focus a m ()+delete = unitCases Leave (const Remove)++{-|+Lookup an element and delete it if it exists.++Same as @'lookup' <* 'delete'@.+-}+{-# RULES+  "lookup <* delete" [~1] lookup <* delete = lookupAndDelete+  #-}+{-# INLINE lookupAndDelete #-}+lookupAndDelete :: Monad m => Focus a m (Maybe a)+lookupAndDelete = cases (Nothing, Leave) (\ element -> (Just element, Remove))++{-|+Reproduces the behaviour of+@Data.Map.<http://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Map-Lazy.html#v:insert insert>@.+-}+{-# INLINE insert #-}+insert :: Monad m => a -> Focus a m ()+insert a = unitCases (Set a) (const (Set a))++{-|+Reproduces the behaviour of+@Data.Map.<http://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Map-Lazy.html#v:insertWith insertWith>@+with a better name.+-}+{-# INLINE insertOrMerge #-}+insertOrMerge :: Monad m => (a -> a -> a) -> a -> Focus a m ()+insertOrMerge merge value = unitCases (Set value) (Set . merge value) ++{-|+Reproduces the behaviour of+@Data.Map.<http://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Map-Lazy.html#v:alter alter>@.+-}+{-# INLINE alter #-}+alter :: Monad m => (Maybe a -> Maybe a) -> Focus a m ()+alter fn = unitCases (maybe Leave Set (fn Nothing)) (maybe Leave Set . fn . Just)++{-|+Reproduces the behaviour of+@Data.Map.<http://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Map-Lazy.html#v:adjust adjust>@.+-} {-# INLINE adjust #-}-adjust :: (a -> a) -> Strategy a ()-adjust f = maybe ((), Keep) (\a -> ((), Replace (f a)))+adjust :: Monad m => (a -> a) -> Focus a m ()+adjust fn = unitCases Leave (Set . fn) --- |--- Reproduces the behaviour of--- @Data.Map.<http://hackage.haskell.org/package/containers-0.5.5.1/docs/Data-Map-Lazy.html#v:update update>@.+{-|+Reproduces the behaviour of+@Data.Map.<http://hackage.haskell.org/package/containers-0.6.0.1/docs/Data-Map-Lazy.html#v:update update>@.+-} {-# INLINE update #-}-update :: (a -> Maybe a) -> Strategy a ()-update f = maybe ((), Keep) (\a -> ((), maybe Remove Replace (f a)))+update :: Monad m => (a -> Maybe a) -> Focus a m ()+update fn = unitCases Leave (maybe Leave Set . fn) --- |--- Reproduces the behaviour of--- @Data.Map.<http://hackage.haskell.org/package/containers-0.5.5.1/docs/Data-Map-Lazy.html#v:alter alter>@.-{-# INLINE alter #-}-alter :: (Maybe a -> Maybe a) -> Strategy a ()-alter f = ((),) . maybe Remove Replace . f+-- ** Construction utils+------------------------- --- |--- Reproduces the behaviour of--- @Data.Map.<http://hackage.haskell.org/package/containers-0.5.5.1/docs/Data-Map-Lazy.html#v:insert insert>@.-{-# INLINE insert #-}-insert :: a -> Strategy a ()-insert a = const ((), Replace a)+{-|+Lift pure functions which handle the cases of presence and absence of the element.+-}+{-# INLINE cases #-}+cases :: Monad m => (b, Change a) -> (a -> (b, Change a)) -> Focus a m b+cases sendNone sendSome = Focus (return sendNone) (return . sendSome) --- |--- Reproduces the behaviour of--- @Data.Map.<http://hackage.haskell.org/package/containers-0.5.5.1/docs/Data-Map-Lazy.html#v:delete delete>@.-{-# INLINE delete #-}-delete :: Strategy a ()-delete = const ((), Remove)+{-|+Lift pure functions which handle the cases of presence and absence of the element and produce no result.+-}+{-# INLINE unitCases #-}+unitCases :: Monad m => Change a -> (a -> Change a) -> Focus a m ()+unitCases sendNone sendSome = cases ((), sendNone) (\ a -> ((), sendSome a)) --- |--- Reproduces the behaviour of--- @Data.Map.<http://hackage.haskell.org/package/containers-0.5.5.1/docs/Data-Map-Lazy.html#v:lookup lookup>@.-{-# INLINE lookup #-}-lookup :: Strategy a (Maybe a)-lookup r = (r, Keep) +-- * Monadic functions+------------------------- --- * Constructors for monadic patterns+-- ** Reading functions ------------------------- --- |--- A monadic version of 'adjust'.+{-|+A monadic version of 'lookupWithDefault'.+-}+{-# INLINE[1] lookupWithDefaultM #-}+lookupWithDefaultM :: Monad m => m a -> Focus a m a+lookupWithDefaultM aM = casesM (liftM2 (,) aM (return Leave)) (\ a -> return (a, Leave))++-- ** Modifying functions+-------------------------++{-|+A monadic version of 'insert'.+-}+{-# INLINE insertM #-}+insertM :: Monad m => m a -> Focus a m ()+insertM aM = unitCasesM (fmap Set aM) (const (fmap Set aM))++{-|+A monadic version of 'insertOrMerge'.+-}+{-# INLINE insertOrMergeM #-}+insertOrMergeM :: Monad m => (a -> a -> m a) -> m a -> Focus a m ()+insertOrMergeM merge aM = unitCasesM (fmap Set aM) (\ a' -> aM >>= \ a -> fmap Set (merge a a'))++{-|+A monadic version of 'alter'.+-}+{-# INLINE alterM #-}+alterM :: Monad m => (Maybe a -> m (Maybe a)) -> Focus a m ()+alterM fn = unitCasesM (fmap (maybe Leave Set) (fn Nothing)) (fmap (maybe Leave Set) . fn . Just)++{-|+A monadic version of 'adjust'.+-} {-# INLINE adjustM #-}-adjustM :: (Monad m) => (a -> m a) -> StrategyM m a ()-adjustM f = maybe (return ((), Keep)) (liftM (((),) . Replace) . f)+adjustM :: Monad m => (a -> m a) -> Focus a m ()+adjustM fn = updateM (fmap Just . fn) --- |--- A monadic version of 'update'.+{-|+A monadic version of 'update'.+-} {-# INLINE updateM #-}-updateM :: (Monad m) => (a -> m (Maybe a)) -> StrategyM m a ()-updateM f = maybe (return ((), Keep)) (liftM (((),) . maybe Remove Replace) . f)+updateM :: Monad m => (a -> m (Maybe a)) -> Focus a m ()+updateM fn = unitCasesM (return Leave) (fmap (maybe Leave Set) . fn) --- |--- A monadic version of 'alter'.-{-# INLINE alterM #-}-alterM :: (Monad m) => (Maybe a -> m (Maybe a)) -> StrategyM m a ()-alterM f = liftM (((),) . maybe Remove Replace) . f+-- ** Construction utils+------------------------- --- |--- A monadic version of 'insert'.-{-# INLINE insertM #-}-insertM :: (Monad m) => a -> StrategyM m a ()-insertM = fmap return . insert+{-|+Lift monadic functions which handle the cases of presence and absence of the element.+-}+{-# INLINE casesM #-}+casesM :: Monad m => m (b, Change a) -> (a -> m (b, Change a)) -> Focus a m b+casesM sendNone sendSome = Focus sendNone sendSome --- |--- A monadic version of 'delete'.-{-# INLINE deleteM #-}-deleteM :: (Monad m) => StrategyM m a ()-deleteM = fmap return delete+{-|+Lift monadic functions which handle the cases of presence and absence of the element and produce no result.+-}+{-# INLINE unitCasesM #-}+unitCasesM :: Monad m => m (Change a) -> (a -> m (Change a)) -> Focus a m ()+unitCasesM sendNone sendSome = Focus (fmap ((),) sendNone) (\ a -> fmap ((),) (sendSome a)) --- |--- A monadic version of 'lookup'.-{-# INLINE lookupM #-}-lookupM :: (Monad m) => StrategyM m a (Maybe a)-lookupM = fmap return lookup +-- * Composition+------------------------- +{-|+Map the Focus input.+-}+{-# INLINE mappingInput #-}+mappingInput :: Monad m => (a -> b) -> (b -> a) -> Focus a m x -> Focus b m x+mappingInput aToB bToA (Focus consealA revealA) = Focus consealB revealB where+  consealB = do+    (x, aChange) <- consealA+    return (x, fmap aToB aChange)+  revealB b = do+    (x, aChange) <- revealA (bToA b)+    return (x, fmap aToB aChange)+++-- * Change-inspecting functions+-------------------------++{-|+Extends the output with the input.+-}+{-# INLINE extractingInput #-}+extractingInput :: Monad m => Focus a m b -> Focus a m (b, Maybe a)+extractingInput (Focus absent present) =+  Focus newAbsent newPresent+  where+    newAbsent = do+      (b, change) <- absent+      return ((b, Nothing), change)+    newPresent element = do+      (b, change) <- present element+      return ((b, Just element), change)++{-|+Extends the output with the change performed.+-}+{-# INLINE extractingChange #-}+extractingChange :: Monad m => Focus a m b -> Focus a m (b, Change a)+extractingChange (Focus absent present) =+  Focus newAbsent newPresent+  where+    newAbsent = do+      (b, change) <- absent+      return ((b, change), change)+    newPresent element = do+      (b, change) <- present element+      return ((b, change), change)++{-|+Extends the output with a projection on the change that was performed.+-}+{-# INLINE projectingChange #-}+projectingChange :: Monad m => (Change a -> c) -> Focus a m b -> Focus a m (b, c)+projectingChange fn (Focus absent present) =+  Focus newAbsent newPresent+  where+    newAbsent = do+      (b, change) <- absent+      return ((b, fn change), change)+    newPresent element = do+      (b, change) <- present element+      return ((b, fn change), change)++{-|+Extends the output with a flag,+signaling whether a change, which is not 'Leave', has been introduced.+-}+{-# INLINE testingIfModifies #-}+testingIfModifies :: Monad m => Focus a m b -> Focus a m (b, Bool)+testingIfModifies =+  projectingChange $ \ case+    Leave -> False+    _ -> True++{-|+Extends the output with a flag,+signaling whether the 'Remove' change has been introduced.+-}+{-# INLINE testingIfRemoves #-}+testingIfRemoves :: Monad m => Focus a m b -> Focus a m (b, Bool)+testingIfRemoves =+  projectingChange $ \ case+    Remove -> True+    _ -> False++{-|+Extends the output with a flag,+signaling whether an item will be inserted.+That is, it didn't exist before and a 'Set' change is introduced.+-}+{-# INLINE testingIfInserts #-}+testingIfInserts :: Monad m => Focus a m b -> Focus a m (b, Bool)+testingIfInserts (Focus absent present) =+  Focus newAbsent newPresent+  where+    newAbsent = do+      (output, change) <- absent+      let testResult = case change of+            Set _ -> True+            _ -> False+          in return ((output, testResult), change)+    newPresent element = do+      (output, change) <- present element+      return ((output, False), change)++{-|+Extend the output with a flag, signaling how the size will be affected by the change.+-}+{-# INLINE testingSizeChange #-}+testingSizeChange :: Monad m => sizeChange {-^ Decreased -} -> sizeChange {-^ Didn't change -} -> sizeChange {-^ Increased -} -> Focus a m b -> Focus a m (b, sizeChange)+testingSizeChange dec none inc (Focus absent present) =+  Focus newAbsent newPresent+  where+    newAbsent = do+      (output, change) <- absent+      let sizeChange = case change of+            Set _ -> inc+            _ -> none+          in return ((output, sizeChange), change)+    newPresent element = do+      (output, change) <- present element+      let sizeChange = case change of+            Remove -> dec+            _ -> none+          in return ((output, sizeChange), change)+++-- * STM+-------------------------++{-|+Focus on the contents of a TVar.+-}+{-# INLINE onTVarValue #-}+onTVarValue :: Focus a STM b -> Focus (TVar a) STM b+onTVarValue (Focus concealA presentA) = Focus concealTVar presentTVar where+  concealTVar = concealA >>= traverse interpretAChange where+    interpretAChange = \ case+      Leave -> return Leave+      Set !a -> Set <$> newTVar a+      Remove -> return Leave+  presentTVar var = readTVar var >>= presentA >>= traverse interpretAChange where+    interpretAChange = \ case+      Leave -> return Leave+      Set !a -> writeTVar var a $> Leave+      Remove -> return Remove

@@ -0,0 +1,69 @@+module Focus.Prelude+(+  module Exports,+)+where++-- base+-------------------------+import Control.Applicative as Exports+import Control.Arrow as Exports+import Control.Category as Exports+import Control.Concurrent as Exports+import Control.Exception as Exports+import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.IO.Class as Exports+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.ST as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.Data as Exports+import Data.Dynamic as Exports+import Data.Either as Exports+import Data.Fixed as Exports+import Data.Foldable as Exports+import Data.Function as Exports hiding (id, (.))+import Data.Functor as Exports+import Data.Int as Exports+import Data.IORef as Exports+import Data.Ix as Exports+import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')+import Data.Maybe as Exports+import Data.Monoid as Exports hiding (Last(..), First(..))+import Data.Ord as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.STRef as Exports+import Data.String as Exports+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Unique as Exports+import Data.Version as Exports+import Data.Word as Exports+import Debug.Trace as Exports+import Foreign.ForeignPtr as Exports+import Foreign.Ptr as Exports+import Foreign.StablePtr as Exports+import Foreign.Storable as Exports hiding (sizeOf, alignment)+import GHC.Conc as Exports hiding (withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)+import GHC.Exts as Exports (lazy, inline, sortWith, groupWith)+import GHC.Generics as Exports (Generic)+import GHC.IO.Exception as Exports+import Numeric as Exports+import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))+import System.Environment as Exports+import System.Exit as Exports+import System.IO as Exports+import System.IO.Error as Exports+import System.IO.Unsafe as Exports+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (printf, hPrintf)+import Text.Read as Exports (Read(..), readMaybe, readEither)+import Unsafe.Coerce as Exports