quiver-sort (empty) → 0.1.0.0
raw patch · 6 files changed
+343/−0 lines, 6 filesdep +QuickCheckdep +basedep +binarysetup-changed
Dependencies added: QuickCheck, base, binary, directory, exceptions, hspec, quiver, quiver-binary, quiver-bytestring, quiver-groups, quiver-instances, quiver-interleave, quiver-sort, resourcet, temporary, transformers
Files
- LICENSE +21/−0
- README.md +9/−0
- Setup.hs +2/−0
- quiver-sort.cabal +62/−0
- src/Control/Quiver/Sort.hs +168/−0
- test/Spec.hs +81/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++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,9 @@+quiver-sort+===========++[](https://hackage.haskell.org/package/quiver-sort) [](https://travis-ci.org/ivan-m/quiver-sort)++Sort the values in a [Quiver], either in-memory for shorter ones or by+using temporary files for larger/longer Quivers.++[Quiver]: http://hackage.haskell.org/package/quiver
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ quiver-sort.cabal view
@@ -0,0 +1,62 @@+name: quiver-sort+version: 0.1.0.0+synopsis: Sort the values in a quiver+description:+ Allows sorting values within a Quiver, including using external+ files for large/long pipelines.+license: MIT+license-file: LICENSE+author: Ivan Lazar Miljenovic+maintainer: Ivan.Miljenovic@gmail.com+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-sort.git++library+ exposed-modules: Control.Quiver.Sort+ -- other-modules:+ build-depends: base >=4.8 && <4.9+ , directory+ , exceptions+ , quiver >= 1.1.3 && < 1.2+ , quiver-binary >= 0.1.1.0 && < 0.1.2+ , quiver-bytestring == 1.0.*+ , quiver-groups == 0.1.*+ , quiver-instances == 0.2.*+ , quiver-interleave == 0.2.*+ , resourcet == 1.1.*+ , temporary == 1.2.*+ , transformers+ hs-source-dirs: src+ default-language: Haskell2010++ ghc-options: -Wall++test-suite sorting-tests+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ build-depends: quiver-sort+ , base+ , binary+ , directory+ , exceptions+ , quiver+ , quiver-instances+ , resourcet+ , temporary+ , transformers++ , QuickCheck >= 2.5 && < 2.9+ , hspec >= 2.1 && < 2.3+ hs-source-dirs: test+ default-language: Haskell2010++ ghc-options: -Wall+ ghc-prof-options: -prof -auto
+ src/Control/Quiver/Sort.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}+{- |+ Module : Control.Quiver.Sort+ Description : Sort values in a Quiver+ Copyright : (c) Ivan Lazar Miljenovic+ License : MIT+ Maintainer : Ivan.Miljenovic@gmail.com++++ -}+module Control.Quiver.Sort (+ -- * In-memory sorting+ -- $memory+ spsort+ , spsortBy+ , spsortOn+ -- * File-based sorting+ -- $filesort+ , spfilesort+ , spfilesortBy+ ) where++import Control.Quiver.Binary+import Control.Quiver.ByteString+import Control.Quiver.Group+import Control.Quiver.Instances ()+import Control.Quiver.Interleave+import Control.Quiver.SP++import Control.Applicative (liftA2)+import Control.Exception (IOException, finally)+import Control.Monad (join)+import Control.Monad.Catch (MonadCatch (..), MonadMask)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Resource (MonadResource, allocate)+import Data.Bool (bool)+import Data.Function (on)+import Data.List (sortBy)+import Data.Maybe (fromMaybe)+import System.Directory (doesDirectoryExist, getPermissions,+ getTemporaryDirectory,+ removeDirectoryRecursive, writable)+import System.IO (hClose, openTempFile)+import System.IO.Temp (createTempDirectory)++--------------------------------------------------------------------------------++{- $memory++These Quivers require reading all the values from the quiver before+being able to sort them. As such, it is /highly/ recommended you only+use them for short streams.++-}++spsort :: (Ord a, Monad m) => SP a a m ()+spsort = spsortBy compare++-- | Use the specified comparison function to sort the values.+spsortBy :: (Monad m) => (a -> a -> Ordering) -> SP a a m ()+spsortBy f = (sortBy f <$> spfoldr (:) []) >>= spevery++-- | Use the provided function to be able to compare values.+spsortOn :: (Ord b, Monad m) => (a -> b) -> SP a a m ()+spsortOn f = sppure ((,) <*> f)+ >->> spsortBy (compare `on` snd)+ >->> sppure fst >&> snd++--------------------------------------------------------------------------------++{- $filesort++For large Quivers it may not be possible to sort the entire stream in+memory. As such, these functions work by sorting chunks of the stream+and storing them in temporary files before merging them all together.++-}++-- | Use external files to temporarily store partially sorted results+-- (splitting into chunks of the specified size if one is provided).+--+-- These files are stored inside the specified directory if provided;+-- if no such directory is provided then the system temporary+-- directory is used.+spfilesort :: (Binary a, Ord a, MonadResource m, MonadMask m) => Maybe Int -> Maybe FilePath+ -> P () a a () m (SPResult IOException)+spfilesort = spfilesortBy compare++-- | Use external files to temporarily store partially sorted (using+-- the comparison function) results (splitting into chunks of the+-- specified size if one is provided).+--+-- These files are stored inside the specified directory if provided;+-- if no such directory is provided then the system temporary+-- directory is used.+spfilesortBy :: (Binary a, MonadResource m, MonadMask m) => (a -> a -> Ordering) -> Maybe Int -> Maybe FilePath+ -> P () a a () m (SPResult IOException)+spfilesortBy cmp mchunks mdir = do mdir' <- join <$> liftIO (traverse checkDir mdir)+ getTmpDir mdir' "quiver-sort" pipeline+ where+ -- Make sure the directory exists and is writable.+ checkDir dir = do ex <- liftA2 (liftA2 (&&)) doesDirectoryExist (fmap writable . getPermissions) dir+ return (bool Nothing (Just dir) ex)++ getTmpDir = maybe withSystemTempDirectory withTempDirectory++ pipeline tmpDir = toFiles tmpDir >>= either spfailed (sortFromFiles cmp)++ toFiles tmpDir = sortToFiles chunkSize cmp tmpDir >->> spToList >&> uncurry (flip checkFailed)++ chunkSize = fromMaybe 10000 mchunks++sortToFiles :: (Binary a, MonadIO m) => Int -> (a -> a -> Ordering) -> FilePath+ -> SP a FilePath m IOException+sortToFiles chunkSize cmp tmpDir = spchunks chunkSize+ >->> spTraverseUntil sortChunk+ >&> snd+ where+ sortChunk as = liftIO $ do (fl,h) <- openTempFile tmpDir "quiver-sort-chunk"+ finally (checkFailed fl <$> sprun (pipeline h)) (hClose h)+ where+ pipeline h = spevery (sortBy cmp as) >->> spencode >->> qPut h >&> snd++sortFromFiles :: (Binary a, MonadIO m) => (a -> a -> Ordering) -> [FilePath]+ -> Producer a () m (SPResult IOException)+sortFromFiles cmp fls = spinterleave cmp (map readFl fls)+ where+ -- Assume decoding is successful for now.+ readFl fl = qhoist liftIO (qReadFile fl readSize) >->> spdecode >&> fst++ readSize = 4096++spTraverseUntil :: (Monad m) => (a -> m (Either e b)) -> SP a b m e+spTraverseUntil k = loop+ where+ loop = spconsume loop' spcomplete+ loop' a = qlift (k a) >>= either spfailed (>:> loop)++-- Ignore SPIncomplete values+checkFailed :: r -> SPResult e -> Either e r+checkFailed _ (Just (Just e)) = Left e+checkFailed r _ = Right r++spToList :: SQ a x f [a]+spToList = spfoldr (:) []++--------------------------------------------------------------------------------+-- Creating the temporary directory++withSystemTempDirectory :: (MonadResource m) =>+ String -- ^ Directory name template. See 'openTempFile'.+ -> (FilePath -> m a) -- ^ Callback that can use the directory+ -> m a+withSystemTempDirectory template action = liftIO getTemporaryDirectory >>= \tmpDir -> withTempDirectory tmpDir template action++withTempDirectory :: (MonadResource m) =>+ FilePath -- ^ Temp directory to create the directory in+ -> String -- ^ Directory name template. See 'openTempFile'.+ -> (FilePath -> m a) -- ^ Callback that can use the directory+ -> m a+withTempDirectory targetDir template withTmp = do+ (_release, tmpDir) <- allocate (createTempDirectory targetDir template)+ (ignoringIOErrors . removeDirectoryRecursive)+ withTmp tmpDir++ignoringIOErrors :: (MonadCatch m) => m () -> m ()+ignoringIOErrors ioe = ioe `catch` (\(_ :: IOError) -> return ())
+ test/Spec.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE RankNTypes #-}+{- |+ Module : Main+ Description : Tests for sorting+ Copyright : (c) Ivan Lazar Miljenovic+ License : MIT+ Maintainer : Ivan.Miljenovic@gmail.com++++ -}+module Main (main) where++import Control.Quiver.Sort++import Control.Applicative (liftA2)+import Control.Exception (evaluate)+import Control.Monad (void)+import Control.Monad.Catch (catchAll, throwM)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Resource (ResourceT, runResourceT)+import Control.Quiver.Instances ()+import Control.Quiver.SP+import Data.Binary (Binary)+import Data.Functor.Identity+import Data.List (sort)+import System.Directory (getDirectoryContents)+import System.IO.Temp (withSystemTempDirectory)++import Test.Hspec+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck++--------------------------------------------------------------------------------++main :: IO ()+main = hspec $ do+ describe "in-memory" $+ prop "same as list-based" $+ forAllShrink (arbitrary :: Gen [Int]) shrink $+ liftA2 (==) sort (spIdentityList spsort)+ describe "file-based" $ do+ prop "same as list-based" $+ forAllShrink (arbitrary :: Gen [Int]) shrink $ \as (Positive cs) ->+ ioProperty $ (== sort as) <$> fileSort cs as+ describe "cleans up temporary files" $ do+ it "on success" $+ fileSortCleanup (spevery [1::Int .. 10])++ it "on exception" $+ fileSortCleanup (spevery [1::Int .. 10] >> throwM (userError "Tainted Producer"))++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 (spList p as)++spList :: (Functor f) => P () a b () f e -> [a] -> Effect f [b]+spList p as = spevery as >->> p >->> spToList >&> snd++fileSort :: (Binary a, Ord a) => Int -> [a] -> IO [a]+fileSort cs as = runResourceT $ sprun $ spList (spfilesort (Just cs) Nothing) as++-- The provided producer is assumed to be short.+fileSortCleanup :: (Binary a, Ord a) => Producer a () IO e -> Expectation+fileSortCleanup prod = withSystemTempDirectory "test-quiver-sort-cleanup" $ \tmpDir -> do+ cnts0 <- getDirectoryContents tmpDir -- Should be [".", ".."]+ catchAll (runResourceT (sprun (pipeline tmpDir))) (const $ return ())+ (sort <$> getDirectoryContents tmpDir) `shouldReturn` sort cnts0+ where+ pipeline :: FilePath -> Effect (ResourceT IO) ()+ pipeline tmpDir = qhoist lift prod+ -- Use a chunk size of 1 to make sure files are+ -- created, even if an exception is thrown.+ >->> spfilesort (Just 1) (Just tmpDir)+ >->> sptraverse_ (lift . void . evaluate) -- Just to consume them all+ >&> const ()