quiver-groups (empty) → 0.1.0.0

raw patch · 6 files changed

+263/−0 lines, 6 filesdep +QuickCheckdep +basedep +dlistsetup-changed

Dependencies added: QuickCheck, base, dlist, hspec, quiver, quiver-groups

Files

LICENSE +20/−0
README.md +14/−0
Setup.hs +2/−0
quiver-groups.cabal +46/−0
src/Control/Quiver/Group.hs +101/−0
test/PropTests.hs +80/−0

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2016 Ivan Lazar Miljenovic++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ README.md view

@@ -0,0 +1,14 @@+quiver-groups+=============++[![Hackage](https://img.shields.io/hackage/v/quiver-groups.svg)](https://hackage.haskell.org/package/quiver-groups) [![Build Status](https://travis-ci.org/ivan-m/quiver-groups.svg)](https://travis-ci.org/ivan-m/quiver-groups)++This library allows you to group/accumulate values within the context+of a [Quiver] stream-processor.++Not only are analogues of the [Data.List] `group` and `groupBy`+functions provided, but also a chunking function and support for+custom accumulation parameters.++[Quiver]: http://hackage.haskell.org/package/quiver+[Data.List]: http://hackage.haskell.org/package/base/docs/Data-List.html

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ quiver-groups.cabal view

@@ -0,0 +1,46 @@+name:                quiver-groups+version:             0.1.0.0+synopsis:            Group and chunk values within a Quiver+description:         Customisable Quiver grouping and chunking functions.+license:             MIT+license-file:        LICENSE+author:              Ivan Lazar Miljenovic+maintainer:          Ivan.Miljenovic@gmail.com+-- copyright:+category:            Control+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++tested-with:   GHC == 7.10.2, GHC == 7.11.*++source-repository head+    type:         git+    location:     https://github.com/ivan-m/quiver-groups.git++library+  exposed-modules:     Control.Quiver.Group+  -- other-modules:+  build-depends:       base >=4.8 && <4.9+                     , quiver >= 1.1.3 && < 1.2+                     , dlist >= 0.5 && < 0.8+  hs-source-dirs:      src+  default-language:    Haskell2010++  ghc-options:         -Wall++test-suite properties+  type:                exitcode-stdio-1.0+  main-is:             PropTests.hs+  build-depends:       quiver-groups+                     , base+                     , quiver++                     , QuickCheck >= 2.5 && < 2.9+                       -- Just to make it nicer to write+                     , hspec >= 2.1 && < 2.3+  hs-source-dirs:      test+  default-language:    Haskell2010++  ghc-options:         -Wall+  ghc-prof-options:    -prof -auto

+ src/Control/Quiver/Group.hs view

@@ -0,0 +1,101 @@+{-# LANGUAGE RankNTypes #-}+{- |+   Module      : Control.Quiver.Group+   Description : Group and chunk values within a Quiver+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : MIT+   Maintainer  : Ivan.Miljenovic@gmail.com++++ -}+module Control.Quiver.Group where++import Control.Quiver.SP++import           Control.Arrow (second)+import qualified Data.DList    as D++--------------------------------------------------------------------------------++-- | Accumulate values within a Quiver.+spaccum :: (a -> p)+              -- ^ Create the initial partial accumulation @p@.+           -> (p -> a -> Either p (g, Maybe a))+              -- ^ Attempt to add a new value to a partial+              -- accumulation; returns either an updated partial+              -- accumulation or else a completed accumulation @g@ as+              -- well as optionally the initial value (if it was /not/+              -- added to the completed accumulation).+           -> (p -> Maybe g)+              -- ^ Attempt to convert the final partial accumulation+              -- to a complete accumulation.  If this function returns+              -- @'Nothing'@ then the final partial accumulation is+              -- returned using 'spfailed'.+           -> SP a g f p+spaccum mkInit addA finalise = createNewAccum+  where+    createNewAccum = spconsume newAccumFrom spcomplete++    newAccumFrom = accumPartial . mkInit++    accumPartial p = spconsume (withValue . addA p) (finalisePartial p)++    withValue epa = case epa of+                      Left p        -> accumPartial p+                      Right (g,ma') -> produce g+                                               (const (maybe createNewAccum newAccumFrom ma'))+                                               spincomplete++    finalisePartial p = maybe (spfailed p) spemit (finalise p)++-- | As with 'spaccum' but the finalisation function always succeeds+spaccum' :: (Functor f) => (a -> p) -> (p -> a -> Either p (g, Maybe a)) -> (p -> g) -> SP a g f ()+spaccum' mkInit addA finalise = spaccum mkInit addA (Just . finalise) >&> fmap (fmap (const ()))+{-# ANN spaccum' "HLint: ignore Use void" #-}+-- Don't want to use 'void' to make sure the 'SPResult' is maintained.++--------------------------------------------------------------------------------++-- | Collect consecutive equal elements together.+spgroup :: (Eq a, Functor f) => SP a [a] f ()+spgroup = spgroupBy (==)++-- | Collect consecutive elements together that satisfy the provided+-- function.+spgroupBy :: (Functor f) => (a -> a -> Bool) -> SP a [a] f ()+spgroupBy f = spaccum' mkInit addA finalise+  where+    mkInit a = (a, D.singleton a)++    addA p@(a, d) a'+      | f a a'    = Left (second (`D.snoc` a') p)+      | otherwise = Right (D.toList d, Just a')++    finalise = D.toList . snd++--------------------------------------------------------------------------------++-- | Collect the elements into lists of the specified size (though the+-- last such may be shorter).+--+-- A size that is @<= 0@ will return 'spcomplete' (that is, no outputs+-- will be produced).+spchunks :: (Functor f) => Int -> SP a [a] f ()+spchunks n+  | n <= 0    = spcomplete+  | n == 1    = sppure (:[]) -- Required for the INVARIANT below to be correct+  | otherwise = spaccum' mkInit addA finalise+  where+    mkInit a = (n', D.singleton a)+    n' = pred n -- n' is >= 1++    -- INVARIANT: c >= 1+    addA (c,d) a+      | c' <= 0   = Right (D.toList d', Nothing)+      | otherwise = Left (c', d')+      where+        c' = pred c+        d' = d `D.snoc` a++    finalise = D.toList . snd

+ test/PropTests.hs view

@@ -0,0 +1,80 @@+{-# LANGUAGE RankNTypes #-}+{- |+   Module      : Main+   Description : Properties for quiver-groups+   Copyright   : (c) Ivan Lazar Miljenovic+   License     : MIT+   Maintainer  : Ivan.Miljenovic@gmail.com++++ -}+module Main (main) where++import Control.Quiver.Group++import Control.Applicative   (liftA2)+import Control.Quiver.SP+import Data.Functor.Identity+import Data.List             (group)++import Test.Hspec+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck++--------------------------------------------------------------------------------++main :: IO ()+main = hspec $ do+  describe "spgroup" $ do+    prop "keeps elements" $+      propInts ((==) <*> concat . spIdentityList spgroup)+    prop "same as list-based" $+      propInts (liftA2 (==) group (spIdentityList spgroup))++  describe "spchunks" $ do+    prop "keeps elements" $+      propInts $ \as (Positive n) ->+        concat (spIdentityList (spchunks n) as) == as+    prop "size == 0" $+      propInts (null . spIdentityList (spchunks 0))+    prop "size == 1" $+      propInts (all isSingleton . spIdentityList (spchunks 1))+    prop "size > 1" $+      propInts $ \as (GTOne n) -> initLast (==n) (<=n)+                                  . map length+                                  $ spIdentityList (spchunks n) as++spToList :: SQ a x f [a]+spToList = spfoldr (:) []++spIdentity :: SQ a b Identity c -> c+spIdentity = runIdentity . sprun++spIdentityList :: SQ a b Identity e -> [a] -> [b]+spIdentityList p as = spIdentity (spevery as >->> p >->> spToList >&> snd)++propInts :: (Testable prop) => ([Int] -> prop) -> Property+propInts = forAllShrink arbitrary shrink++isSingleton :: [a] -> Bool+isSingleton [_] = True+isSingleton _   = False++initLast :: (a -> Bool) -> (a -> Bool) -> [a] -> Bool+initLast i l = go+  where+    go []     = True+    go [a]    = l a+    go (a:as) = i a && go as++newtype GTOne a = GTOne a+                deriving (Eq, Ord, Show, Read)++instance Functor GTOne where+  fmap f (GTOne a) = GTOne (f a)++instance (Num a, Ord a, Arbitrary a) => Arbitrary (GTOne a) where+  arbitrary = GTOne <$> ((abs <$> arbitrary) `suchThat` (>1))++  shrink (GTOne a) = [ GTOne a' | a' <- shrink a, a' > 1 ]