diff --git a/Data/List/Split.hs b/Data/List/Split.hs new file mode 100644 --- /dev/null +++ b/Data/List/Split.hs @@ -0,0 +1,141 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.List.Split +-- Copyright : (c) Brent Yorgey, Louis Wasserman 2008 +-- License : BSD-style (see LICENSE) +-- Maintainer : Brent Yorgey +-- Stability : experimental +-- Portability : unportable (GADTs, Rank2Types) +-- +-- The "Data.List.Split" module contains a wide range of strategies +-- for splitting lists with respect to some sort of delimiter, mostly +-- implemented through a unified combinator interface. The goal is to +-- be flexible yet simple. Scroll past the Synopsis for usage, +-- examples, and detailed documentation of all exported functions. If +-- you want to learn about the implementation, see +-- "Data.List.Split.Internals". +-- +-- A darcs repository containing the source (including a module with +-- over 40 QuickCheck properties) can be found at +-- . +-- +----------------------------------------------------------------------------- +module Data.List.Split ( + + -- * Getting started + -- $started + + -- * Convenience functions + -- $conv + + + splitOn + , splitOneOf + , splitWhen + , sepBy + , sepByOneOf + , endBy + , endByOneOf + + , unintercalate + + -- * Other splitting methods + -- $other + , splitEvery + , chunk + , splitPlaces + + -- * Splitting combinators + -- $comb + + , Splitter + , defaultSplitter + , split + + -- ** Basic strategies + -- $basic + + , oneOf + , onSublist + , whenElt + + -- ** Strategy transformers + -- + -- $ Functions for altering splitting strategy + -- parameters. + , dropDelims + , keepDelimsL + , keepDelimsR + , condense + , dropInitBlank + , dropFinalBlank + + -- ** Derived combinators + -- + -- $ Combinators which can be defined in terms of + -- other combinators, but are provided for + -- convenience. + , dropBlanks + , startsWith + , startsWithOneOf + , endsWith + , endsWithOneOf + + ) where + +import Data.List.Split.Internals + +-- $started +-- To get started, you should take a look at the functions 'splitOn', +-- 'splitWhen', 'sepBy', 'endBy', 'splitEvery', 'splitPlaces', and +-- other functions listed in the next two sections. These functions +-- implement various common splitting operations, and one of them will +-- probably do the job 90\% of the time. For example: +-- +-- > > splitOn "x" "axbxc" +-- > ["a","b","c"] +-- > > splitOn "x" "axbxcx" +-- > ["a","b","c",""] +-- > > endBy ";" "foo;bar;baz;" +-- > ["foo","bar","baz"] +-- > > splitWhen (<0) [1,3,-4,5,7,-9,0,2] +-- > [[1,3],[5,7],[0,2]] +-- > > splitOneOf ";.," "foo,bar;baz.glurk" +-- > ["foo","bar","baz","glurk"] +-- > > splitEvery 3 ['a'..'z'] +-- > ["abc","def","ghi","jkl","mno","pqr","stu","vwx","yz"] +-- +-- If you want more flexibility, however, you can use the combinator +-- library in terms of which these functions are defined. For more +-- information, skip to the section labeled \"Splitting Combinators\". +-- +-- Note that the goal of this library is to be flexible yet simple. +-- It does not implement any particularly sophisticated list-splitting +-- methods, nor is it tuned for speed. If you find yourself wanting +-- something more complicated or optimized, it probably means you +-- should use a real parsing or regular expression library. + +-- $conv +-- These functions implement some common splitting strategies. Note +-- that all of the functions in this section drop delimiters from the +-- final output, since that is a more common use case even though it +-- is not the default. + +-- $other +-- Other useful splitting methods which are not implemented using the +-- combinator framework. + +-- $comb +-- The core of the library is the 'Splitter' type, which represents a +-- particular list-splitting strategy. All of the combinators revolve +-- around constructing or transforming 'Splitter' objects; once a +-- suitable 'Splitter' has been created, it can be run with the +-- 'split' function. For example: +-- +-- > > split (dropBlanks . condense $ whenElt (<0)) [1,2,4,-5,-6,4,9,-19,-30] +-- > [[1,2,4],[-5,-6],[4,9],[-19,-30]] + +-- $basic +-- All these basic strategies have the same parameters as the +-- 'defaultSplitter' except for the delimiter. + diff --git a/Data/List/Split/Internals.hs b/Data/List/Split/Internals.hs new file mode 100644 --- /dev/null +++ b/Data/List/Split/Internals.hs @@ -0,0 +1,454 @@ +{-# LANGUAGE GADTs, Rank2Types #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.List.Split.Internal +-- Copyright : (c) Brent Yorgey 2008 +-- License : BSD-style (see LICENSE) +-- Maintainer : byorgey@gmail.com +-- Stability : experimental +-- Portability : unportable (GADTs, Rank2Types) +-- +-- Implementation module for "Data.List.Split", a combinator library +-- for splitting lists. See the "Data.List.Split" documentation for +-- more description and examples. +-- +----------------------------------------------------------------------------- + +module Data.List.Split.Internals where + +import Data.List (genericSplitAt) + +-- * Types and utilities + +-- | A splitting strategy. +data Splitter a = Splitter { delimiter :: Delimiter a + -- ^ What delimiter to split on + , delimPolicy :: DelimPolicy + -- ^ What to do with delimiters (drop + -- from output, keep as separate + -- elements in output, or merge with + -- previous or following chunks) + , condensePolicy :: CondensePolicy + -- ^ What to do with multiple + -- consecutive delimiters + , initBlankPolicy :: EndPolicy + -- ^ Drop an initial blank? + , finalBlankPolicy :: EndPolicy + -- ^ Drop a final blank? + } + +-- | The default splitting strategy: keep delimiters in the output +-- as separate chunks, don't condense multiple consecutive +-- delimiters into one, keep initial and final blank chunks. +-- Default delimiter is the constantly false predicate. +-- +-- Note that 'defaultSplitter' should normally not be used; use +-- 'oneOf', 'onSublist', or 'whenElt' instead, which are the same as +-- the 'defaultSplitter' with just the delimiter overridden. +-- +-- The 'defaultSplitter' strategy with any delimiter gives a +-- maximally information-preserving splitting strategy, in the sense +-- that (a) taking the 'concat' of the output yields the original +-- list, and (b) given only the output list, we can reconstruct a +-- 'Splitter' which would produce the same output list again given +-- the original input list. This default strategy can be overridden +-- to allow discarding various sorts of information. +defaultSplitter :: Splitter a +defaultSplitter = Splitter { delimiter = DelimEltPred (const False) + , delimPolicy = Keep + , condensePolicy = KeepBlankFields + , initBlankPolicy = KeepBlank + , finalBlankPolicy = KeepBlank + } + +-- | A delimiter can either be a predicate on elements, or a list of +-- elements to be matched as a subsequence. +data Delimiter a where + DelimEltPred :: (a -> Bool) -> Delimiter a + DelimSublist :: Eq a => [a] -> Delimiter a + +-- | Try to match a delimiter at the start of a list, either failing +-- or decomposing the list into the portion which matched the delimiter +-- and the remainder. +matchDelim :: Delimiter a -> [a] -> Maybe ([a],[a]) +matchDelim (DelimEltPred p) (x:xs) | p x = Just ([x],xs) + | otherwise = Nothing +matchDelim (DelimEltPred _) [] = Nothing +matchDelim (DelimSublist []) xs = Just ([],xs) +matchDelim (DelimSublist _) [] = Nothing +matchDelim (DelimSublist (d:ds)) (x:xs) + | d == x = matchDelim (DelimSublist ds) xs >>= \(h,t) -> Just (d:h,t) + | otherwise = Nothing + +-- | What to do with delimiters? +data DelimPolicy = Drop -- ^ Drop delimiters from the output. + | Keep -- ^ Keep delimiters as separate chunks + -- of the output. + | KeepLeft -- ^ Keep delimiters in the output, + -- prepending them to the following + -- chunk. + | KeepRight -- ^ Keep delimiters in the output, + -- appending them to the previous chunk. + deriving (Eq, Show) + +-- | What to do with multiple consecutive delimiters? +data CondensePolicy = Condense -- ^ Condense into a single delimiter. + | KeepBlankFields -- ^ Insert blank chunks + -- between consecutive + -- delimiters. + deriving (Eq, Show) + +-- | What to do with a blank chunk at either end of the list +-- (i.e. when the list begins or ends with a delimiter). +data EndPolicy = DropBlank | KeepBlank + deriving (Eq, Show) + +-- | Tag chunks as delimiters or text. +data Chunk a = Delim [a] | Text [a] + deriving (Show, Eq) + +-- | Internal representation of a split list that tracks which pieces +-- are delimiters and which aren't. +type SplitList a = [Chunk a] + +-- | Untag a 'Chunk'. +fromElem :: Chunk a -> [a] +fromElem (Text as) = as +fromElem (Delim as) = as + +-- | Test whether a 'Chunk' is a delimiter. +isDelim :: Chunk a -> Bool +isDelim (Delim _) = True +isDelim _ = False + +-- | Test whether a 'Chunk' is text. +isText :: Chunk a -> Bool +isText (Text _) = True +isText _ = False + +-- | Standard build function. +build :: (forall b. (a -> b -> b) -> b -> b) -> [a] +build g = g (:) [] + +-- * Implementation + +-- | Given a delimiter to use, split a list into an internal +-- representation with chunks tagged as delimiters or text. This +-- transformation is lossless; in particular, @'concatMap' 'fromElem' +-- ('splitInternal' d l) == l@. +splitInternal :: Delimiter a -> [a] -> SplitList a +splitInternal _ [] = [] +splitInternal d xxs@(x:xs) = case matchDelim d xxs of + -- special case for blank delimiter + Just ([], (r:rs)) -> Delim [] : Text [r] : splitInternal d rs + Just (match,rest) -> Delim match : splitInternal d rest + _ -> x `consText` splitInternal d xs + where consText z (Text c : ys) = Text (z:c) : ys + consText z ys = Text [z] : ys + +-- | Given a split list in the internal tagged representation, produce +-- a new internal tagged representation corresponding to the final +-- output, according to the strategy defined by the given +-- 'Splitter'. +postProcess :: Splitter a -> SplitList a -> SplitList a +postProcess s = dropFinal (finalBlankPolicy s) + . dropInitial (initBlankPolicy s) + . doMerge (delimPolicy s) + . doDrop (delimPolicy s) + . insertBlanks + . doCondense (condensePolicy s) + +-- | Drop delimiters if the 'DelimPolicy' is 'Drop'. +doDrop :: DelimPolicy -> SplitList a -> SplitList a +doDrop Drop l = [ c | c@(Text _) <- l ] +doDrop _ l = l + +-- | Condense multiple consecutive delimiters into one if the +-- 'CondensePolicy' is 'Condense'. +doCondense :: CondensePolicy -> SplitList a -> SplitList a +doCondense KeepBlankFields ls = ls +doCondense Condense ls = condense' ls + where condense' [] = [] + condense' (c@(Text _) : l) = c : condense' l + condense' l = (Delim $ concatMap fromElem ds) : condense' rest + where (ds,rest) = span isDelim l + +-- | Insert blank chunks between any remaining consecutive delimiters, +-- and at the beginning or end if the first or last element is a +-- delimiter. +insertBlanks :: SplitList a -> SplitList a +insertBlanks [] = [Text []] +insertBlanks (d@(Delim _) : l) = Text [] : insertBlanks' (d:l) +insertBlanks l = insertBlanks' l + +-- | Insert blank chunks between consecutive delimiters. +insertBlanks' :: SplitList a -> SplitList a +insertBlanks' [] = [] +insertBlanks' (d1@(Delim _) : d2@(Delim _) : l) = d1 : Text [] : insertBlanks' (d2:l) +insertBlanks' [d@(Delim _)] = [d, Text []] +insertBlanks' (c : l) = c : insertBlanks' l + +-- | Merge delimiters into adjacent chunks according to the 'DelimPolicy'. +doMerge :: DelimPolicy -> SplitList a -> SplitList a +doMerge KeepLeft = mergeLeft +doMerge KeepRight = mergeRight +doMerge _ = id + +-- | Merge delimiters with adjacent chunks to the right (yes, that's +-- not a typo: the delimiters should end up on the left of the +-- chunks, so they are merged with chunks to their right). +mergeLeft :: SplitList a -> SplitList a +mergeLeft [] = [] +mergeLeft ((Delim d) : (Text c) : l) = Text (d++c) : mergeLeft l +mergeLeft (c : l) = c : mergeLeft l + +-- | Merge delimiters with adjacent chunks to the left. +mergeRight :: SplitList a -> SplitList a +mergeRight [] = [] +mergeRight ((Text c) : (Delim d) : l) = Text (c++d) : mergeRight l +mergeRight (c : l) = c : mergeRight l + +-- | Drop an initial blank chunk according to the given 'EndPolicy'. +dropInitial :: EndPolicy -> SplitList a -> SplitList a +dropInitial DropBlank (Text [] : l) = l +dropInitial _ l = l + +-- | Drop a final blank chunk according to the given 'EndPolicy'. +dropFinal :: EndPolicy -> SplitList a -> SplitList a +dropFinal _ [] = [] +dropFinal DropBlank l = case last l of + Text [] -> init l + _ -> l +dropFinal _ l = l + +-- * Combinators + +-- | Split a list according to the given splitting strategy. This is +-- how to \"run\" a 'Splitter' that has been built using the other +-- combinators. +split :: Splitter a -> [a] -> [[a]] +split s = map fromElem . postProcess s . splitInternal (delimiter s) + +-- ** Basic strategies +-- +-- $ All these basic strategies have the same parameters as the +-- 'defaultSplitter' except for the delimiters. + +-- | A splitting strategy that splits on any one of the given +-- elements. For example: +-- +-- > split (oneOf "xyz") "aazbxyzcxd" == ["aa","z","b","x","","y","","z","c","x","d"] +oneOf :: Eq a => [a] -> Splitter a +oneOf elts = defaultSplitter { delimiter = DelimEltPred (`elem` elts) } + +-- | A splitting strategy that splits on the given list, when it is +-- encountered as an exact subsequence. For example: +-- +-- > split (onSublist "xyz") "aazbxyzcxd" == ["aazb","xyz","cxd"] +-- +-- Note that splitting on the empty list is a special case, which +-- splits just before every element of the list being split. For example: +-- +-- > split (onSublist "") "abc" == ["","","a","","b","","c"] +-- > split (dropDelims . dropBlanks $ onSublist "") "abc" == ["a","b","c"] +-- +-- However, if you want to break a list into singleton elements like +-- this, you are better off using @'splitEvery' 1@, or better yet, +-- @'map' (:[])@. +onSublist :: Eq a => [a] -> Splitter a +onSublist lst = defaultSplitter { delimiter = DelimSublist lst } + +-- | A splitting strategy that splits on any elements that satisfy the +-- given predicate. For example: +-- +-- > split (whenElt (<0)) [2,4,-3,6,-9,1] == [[2,4],[-3],[6],[-9],[1]] +whenElt :: (a -> Bool) -> Splitter a +whenElt p = defaultSplitter { delimiter = DelimEltPred p } + +-- ** Strategy transformers + +-- | Drop delimiters from the output (the default is to keep +-- them). For example, +-- +-- > split (oneOf ":") "a:b:c" == ["a", ":", "b", ":", "c"] +-- > split (dropDelims $ oneOf ":") "a:b:c" == ["a", "b", "c"] +dropDelims :: Splitter a -> Splitter a +dropDelims s = s { delimPolicy = Drop } + +-- | Keep delimiters in the output by prepending them to adjacent +-- chunks. For example: +-- +-- > split (keepDelimsL $ oneOf "xyz") "aazbxyzcxd" == ["aa","zb","x","y","zc","xd"] +keepDelimsL :: Splitter a -> Splitter a +keepDelimsL s = s { delimPolicy = KeepLeft } + +-- | Keep delimiters in the output by appending them to adjacent +-- chunks. For example: +-- +-- > split (keepDelimsR $ oneOf "xyz") "aazbxyzcxd" == ["aaz","bx","y","z","cx","d"] +keepDelimsR :: Splitter a -> Splitter a +keepDelimsR s = s { delimPolicy = KeepRight } + +-- | Condense multiple consecutive delimiters into one. For example: +-- +-- > split (condense $ oneOf "xyz") "aazbxyzcxd" == ["aa","z","b","xyz","c","x","d"] +-- > split (dropDelims $ oneOf "xyz") "aazbxyzcxd" == ["aa","b","","","c","d"] +-- > split (condense . dropDelims $ oneOf "xyz") "aazbxyzcxd" == ["aa","b","c","d"] +condense :: Splitter a -> Splitter a +condense s = s { condensePolicy = Condense } + +-- | Don't generate a blank chunk if there is a delimiter at the +-- beginning. For example: +-- +-- > split (oneOf ":") ":a:b" == ["",":","a",":","b"] +-- > split (dropInitBlank $ oneOf ":") ":a:b" == [":","a",":","b"] +dropInitBlank :: Splitter a -> Splitter a +dropInitBlank s = s { initBlankPolicy = DropBlank } + +-- | Don't generate a blank chunk if there is a delimiter at the end. +-- For example: +-- +-- > split (oneOf ":") "a:b:" == ["a",":","b",":",""] +-- > split (dropFinalBlank $ oneOf ":") "a:b:" == ["a",":","b",":"] +dropFinalBlank :: Splitter a -> Splitter a +dropFinalBlank s = s { finalBlankPolicy = DropBlank } + +-- ** Derived combinators + +-- | Drop all blank chunks from the output. Equivalent to +-- @'dropInitBlank' . 'dropFinalBlank' . 'condense'@. For example: +-- +-- > split (oneOf ":") "::b:::a" == ["",":","",":","b",":","",":","",":","a"] +-- > split (dropBlanks $ oneOf ":") "::b:::a" == ["::","b",":::","a"] +dropBlanks :: Splitter a -> Splitter a +dropBlanks = dropInitBlank . dropFinalBlank . condense + +-- | Make a strategy that splits a list into chunks that all start +-- with the given subsequence (except possibly the first). +-- Equivalent to @'dropInitBlank' . 'keepDelimsL' . 'onSublist'@. +-- For example: +-- +-- > split (startsWith "app") "applyappicativeapplaudapproachapple" == ["apply","appicative","applaud","approach","apple"] +startsWith :: Eq a => [a] -> Splitter a +startsWith = dropInitBlank . keepDelimsL . onSublist + +-- | Make a strategy that splits a list into chunks that all start +-- with one of the given elements (except possibly the first). +-- Equivalent to @'dropInitBlank' . 'keepDelimsL' . 'oneOf'@. For +-- example: +-- +-- > split (startsWithOneOf ['A'..'Z']) "ACamelCaseIdentifier" == ["A","Camel","Case","Identifier"] +startsWithOneOf :: Eq a => [a] -> Splitter a +startsWithOneOf = dropInitBlank . keepDelimsL . oneOf + +-- | Make a strategy that splits a list into chunks that all end with +-- the given subsequence, except possibly the last. Equivalent to +-- @'dropFinalBlank' . 'keepDelimsR' . 'onSublist'@. For example: +-- +-- > split (endsWith "ly") "happilyslowlygnarlylily" == ["happily","slowly","gnarly","lily"] +endsWith :: Eq a => [a] -> Splitter a +endsWith = dropFinalBlank . keepDelimsR . onSublist + +-- | Make a strategy that splits a list into chunks that all end with +-- one of the given elements, except possibly the last. Equivalent +-- to @'dropFinalBlank' . 'keepDelimsR' . 'oneOf'@. For example: +-- +-- > split (condense $ endsWithOneOf ".,?! ") "Hi, there! How are you?" == ["Hi, ","there! ","How ","are ","you?"] +endsWithOneOf :: Eq a => [a] -> Splitter a +endsWithOneOf = dropFinalBlank . keepDelimsR . oneOf + +-- ** Convenience functions +-- +-- These functions implement some common splitting strategies. Note +-- that all of the functions in this section drop delimiters from +-- the final output, since that is a more common use case even +-- though it is not the default. + +-- | Split on any of the given elements. Equivalent to @'split' +-- . 'dropDelims' . 'oneOf'@. For example: +-- +-- > splitOneOf ";.," "foo,bar;baz.glurk" == ["foo","bar","baz","glurk"] +splitOneOf :: Eq a => [a] -> [a] -> [[a]] +splitOneOf = split . dropDelims . oneOf + +-- | Split on the given sublist. Equivalent to @'split' +-- . 'dropDelims' . 'onSublist'@. For example: +-- +-- > splitOn ".." "a..b...c....d.." == ["a","b",".c","","d",""] +splitOn :: Eq a => [a] -> [a] -> [[a]] +splitOn = split . dropDelims . onSublist + +-- | Split on elements satisfying the given predicate. Equivalent to +-- @'split' . 'dropDelims' . 'whenElt'@. For example: +-- +-- > splitWhen (<0) [1,3,-4,5,7,-9,0,2] == [[1,3],[5,7],[0,2]] +splitWhen :: (a -> Bool) -> [a] -> [[a]] +splitWhen = split . dropDelims . whenElt + +-- | A synonym for 'splitOn'. +sepBy :: Eq a => [a] -> [a] -> [[a]] +sepBy = splitOn + +-- | A synonym for 'splitOneOf'. +sepByOneOf :: Eq a => [a] -> [a] -> [[a]] +sepByOneOf = splitOneOf + +-- | Split into chunks terminated by the given subsequence. +-- Equivalent to @'split' . 'dropFinalBlank' . 'dropDelims' +-- . 'onSublist'@. For example: +-- +-- > endBy ";" "foo;bar;baz;" == ["foo","bar","baz"] +-- +-- Note also that the 'lines' function from "Data.List" is equivalent +-- to @'endBy' \"\\n\"@. +endBy :: Eq a => [a] -> [a] -> [[a]] +endBy = split . dropFinalBlank . dropDelims . onSublist + +-- | Split into chunks terminated by one of the given elements. +-- Equivalent to @'split' . 'dropFinalBlank' . 'dropDelims' . 'oneOf'@. +endByOneOf :: Eq a => [a] -> [a] -> [[a]] +endByOneOf = split . dropFinalBlank . dropDelims . oneOf + +-- | A synonym for 'sepBy' \/ 'splitOn'. +-- +-- Note that this is the right inverse of the 'intercalate' function +-- from "Data.List", that is, @'intercalate' x . 'unintercalate' x +-- == 'id'@. It is also the case that @'unintercalate' x +-- . 'intercalate' x@ is idempotent. @'unintercalate' x +-- . 'intercalate' x@ is the identity on certain lists, but it is +-- tricky to state the precise conditions under which this holds. +-- (For example, it is not enough to say that @x@ does not occur in +-- any elements of the input list. Working out why is left as an +-- exercise for the reader.) +unintercalate :: Eq a => [a] -> [a] -> [[a]] +unintercalate = sepBy + +-- * Other splitting methods + +-- | @'splitEvery' n@ splits a list into length-n pieces. The last +-- piece will be shorter if @n@ does not evenly divide the length of +-- the list. If @n <= 0@, @'splitEvery' n l@ returns an infinite list +-- of empty lists. +splitEvery :: Int -> [e] -> [[e]] +splitEvery i ls = map (take i) (build (splitter ls)) where + splitter [] _ n = n + splitter l c n = l `c` splitter (drop i l) c n + +-- | A common synonym for 'splitEvery'. +chunk :: Int -> [e] -> [[e]] +chunk = splitEvery + +-- | Split a list into chunks of the given lengths. For example: +-- +-- > splitPlaces [2,3,4] [1..20] == [[1,2],[3,4,5],[6,7,8,9]] +-- > splitPlaces [4,9] [1..10] == [[1,2,3,4],[5,6,7,8,9,10]] +-- +-- The behavior of @'splitPlaces' ls xs@ when @'sum' ls /= 'length' xs@ can +-- be inferred from the above examples and the fact that 'splitPlaces' +-- is total. +splitPlaces :: Integral a => [a] -> [e] -> [[e]] +splitPlaces is ys = build (splitPlacer is ys) where + splitPlacer [] _ _ n = n + splitPlacer _ [] _ n = n + splitPlacer (l:ls) xs c n = let (x1, x2) = genericSplitAt l xs + in x1 `c` splitPlacer ls x2 c n diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2008 Brent Yorgey, Louis Wasserman + +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 other 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. diff --git a/Properties.hs b/Properties.hs new file mode 100644 --- /dev/null +++ b/Properties.hs @@ -0,0 +1,302 @@ +{-# LANGUAGE FlexibleInstances, StandaloneDeriving #-} +module Properties where + +import Data.List.Split.Internals +import Test.QuickCheck + +import System.Environment +import Text.Printf +import Control.Monad + +import Data.Char +import Data.List (isInfixOf, isPrefixOf, isSuffixOf, tails, intercalate, genericTake) +import Data.Maybe (isJust) + +newtype Elt = Elt { unElt :: Char } + deriving (Eq) + +instance Show Elt where + show (Elt c) = show c + +instance Arbitrary Elt where + arbitrary = elements (map Elt "abcde") + +instance CoArbitrary Elt where + coarbitrary = coarbitrary . ord . unElt + +instance Show (Elt -> Bool) where + show p = "abcde -> " ++ map (toTF . p . Elt) "abcde" + where toTF b = if b then 'T' else 'F' + +instance Show (Delimiter Elt) where + show (DelimEltPred p) = show p + show (DelimSublist s) = show s + +deriving instance Show (Splitter Elt) + +instance (Arbitrary a, CoArbitrary a, Eq a) => Arbitrary (Delimiter a) where + arbitrary = oneof [ liftM DelimEltPred arbitrary + , liftM DelimSublist arbitrary + ] + +instance Arbitrary a => Arbitrary (Chunk a) where + arbitrary = oneof [ liftM Text (listOf arbitrary) + , liftM Delim (listOf arbitrary) + ] + +instance Arbitrary DelimPolicy where + arbitrary = elements [Drop, Keep, KeepLeft, KeepRight] + +instance Arbitrary CondensePolicy where + arbitrary = elements [Condense, KeepBlankFields] + +instance Arbitrary EndPolicy where + arbitrary = elements [DropBlank, KeepBlank] + +instance (Arbitrary a, CoArbitrary a, Eq a) => Arbitrary (Splitter a) where + arbitrary = liftM5 Splitter arbitrary arbitrary arbitrary arbitrary arbitrary + +main :: IO () +main = do + results <- mapM (\(s,t) -> printf "%-40s" s >> t) tests + when (not . all isSuccess $ results) $ fail "Not all tests passed!" + where + isSuccess (Success{}) = True + isSuccess _ = False + qc x = quickCheckWithResult (stdArgs { maxSuccess = 200 }) x + tests = [ ("default/id", qc prop_default_id) + , ("match/decompose", qc prop_match_decompose) + , ("match/yields delim", qc prop_match_yields_delim) + , ("splitInternal/lossless", qc prop_splitInternal_lossless) + , ("splitInternal/yields delims", qc prop_splitInternal_yields_delims) + , ("splitInternal/text", qc prop_splitInternal_text_not_delims) + , ("doCondense/no consec delims", qc prop_doCondense_no_consec_delims) + , ("insBlanks/no consec delims", qc prop_insBlanks_no_consec_delims) + , ("insBlanks/fl not delims", qc prop_insBlanks_fl_not_delim) + , ("mergeL/no delims", qc prop_mergeL_no_delims) + , ("mergeR/no delims", qc prop_mergeR_no_delims) + , ("oneOf", qc prop_oneOf) + , ("oneOf/not text", qc prop_oneOf_not_text) + , ("onSublist", qc prop_onSublist) + , ("onSublist/not text", qc prop_onSublist_not_text) + , ("whenElt", qc prop_whenElt) + , ("whenElt/not text", qc prop_whenElt_not_text) + , ("process/dropDelims", qc prop_dropDelims) + , ("process/keepDelimsL no delims", qc prop_keepDelimsL_no_delims) + , ("process/keepDelimsR no delims", qc prop_keepDelimsR_no_delims) + , ("process/keepDelimsL match", qc prop_keepDelimsL_match) + , ("process/keepDelimsR match", qc prop_keepDelimsR_match) + , ("condense/no consec delims", qc prop_condense_no_consec_delims) + , ("condense/all delims", qc prop_condense_all_delims) + , ("dropInitBlank", qc prop_dropInitBlank) + , ("dropFinalBlank", qc prop_dropFinalBlank) + , ("dropBlanks", qc prop_dropBlanks) + , ("startsWith", qc prop_startsWith) + , ("startsWithOneOf", qc prop_startsWithOneOf) + , ("endsWith", qc prop_endsWith) + , ("endsWithOneOf", qc prop_endsWithOneOf) + , ("unintercalate/right inv", qc prop_unintercalate_right_inv) + -- , ("unintercalate/left inv", qc prop_unintercalate_left_inv) + , ("unintercalate/idem", qc prop_unintercalate_intercalate_idem) + , ("splitEvery/lengths", qc prop_splitEvery_all_n) + , ("splitEvery/last <= n", qc prop_splitEvery_last_less_n) + , ("splitEvery/preserve", qc prop_splitEvery_preserve) + , ("splitPlaces/lengths", qc prop_splitPlaces_lengths) + , ("splitPlaces/last <= n", qc prop_splitPlaces_last_less_n) + , ("splitPlaces/preserve", qc prop_splitPlaces_preserve) + , ("lines", qc prop_lines) + ] + +prop_default_id :: [Elt] -> Bool +prop_default_id l = split defaultSplitter l == [l] + +prop_match_decompose :: Delimiter Elt -> [Elt] -> Bool +prop_match_decompose d l = maybe True ((==l) . uncurry (++)) $ matchDelim d l + +isDelimMatch :: Delimiter Elt -> [Elt] -> Bool +isDelimMatch d l = matchDelim d l == Just (l,[]) + +prop_match_yields_delim :: Delimiter Elt -> [Elt] -> Bool +prop_match_yields_delim d l = + case matchDelim d l of + Nothing -> True + Just (del,rest) -> isDelimMatch d del + +prop_splitInternal_lossless :: Delimiter Elt -> [Elt] -> Bool +prop_splitInternal_lossless d l = concatMap fromElem (splitInternal d l) == l + +prop_splitInternal_yields_delims :: Delimiter Elt -> [Elt] -> Bool +prop_splitInternal_yields_delims d l = + all (isDelimMatch d) $ [ del | (Delim del) <- splitInternal d l ] + +prop_splitInternal_text_not_delims :: Delimiter Elt -> [Elt] -> Bool +prop_splitInternal_text_not_delims d l = + all (not . isDelimMatch d) $ [ ch | (Text ch) <- splitInternal d l ] + +noConsecDelims :: SplitList Elt -> Bool +noConsecDelims [] = True +noConsecDelims [x] = True +noConsecDelims (Delim _ : Delim _ : _) = False +noConsecDelims (_ : xs) = noConsecDelims xs + +prop_doCondense_no_consec_delims :: SplitList Elt -> Bool +prop_doCondense_no_consec_delims l = noConsecDelims $ doCondense Condense l + +prop_insBlanks_no_consec_delims :: SplitList Elt -> Bool +prop_insBlanks_no_consec_delims l = noConsecDelims $ insertBlanks l + +prop_insBlanks_fl_not_delim :: SplitList Elt -> Bool +prop_insBlanks_fl_not_delim l = + case insertBlanks l of + [] -> True + xs -> (not . isDelim $ head xs) && (not . isDelim $ last xs) + +prop_mergeL_no_delims :: SplitList Elt -> Bool +prop_mergeL_no_delims = all (not . isDelim) . mergeLeft . insertBlanks + +prop_mergeR_no_delims :: SplitList Elt -> Bool +prop_mergeR_no_delims = all (not . isDelim) . mergeRight . insertBlanks + +getDelims :: Splitter Elt -> [Elt] -> [[Elt]] +getDelims s l = [ d | Delim d <- splitInternal (delimiter s) l ] + +getTexts :: Splitter Elt -> [Elt] -> [[Elt]] +getTexts s l = [ c | Text c <- splitInternal (delimiter s) l ] + +prop_oneOf :: [Elt] -> [Elt] -> Bool +prop_oneOf elts l = all ((==1) . length) ds && all ((`elem` elts) . head) ds + where ds = getDelims (oneOf elts) l + +prop_oneOf_not_text :: [Elt] -> [Elt] -> Bool +prop_oneOf_not_text elts l = all (not . (`elem` elts)) (concat cs) + where cs = getTexts (oneOf elts) l + +prop_onSublist :: [Elt] -> [Elt] -> Bool +prop_onSublist sub l = all (==sub) $ getDelims (onSublist sub) l + +prop_onSublist_not_text :: [Elt] -> [Elt] -> Property +prop_onSublist_not_text sub l = + (not . null $ sub) ==> + all (not . isInfixOf sub) $ getTexts (onSublist sub) l + +prop_whenElt :: (Elt -> Bool) -> [Elt] -> Bool +prop_whenElt p l = all ((==1) . length) ds && all (p . head) ds + where ds = getDelims (whenElt p) l + +prop_whenElt_not_text :: (Elt -> Bool) -> [Elt] -> Bool +prop_whenElt_not_text p l = all (not . p) (concat cs) + where cs = getTexts (whenElt p) l + +process :: Splitter Elt -> [Elt] -> SplitList Elt +process s = postProcess s . splitInternal (delimiter s) + +prop_dropDelims :: Splitter Elt -> [Elt] -> Bool +prop_dropDelims s l = all (not . isDelim) (process (dropDelims s) l) + +prop_keepDelimsL_no_delims :: Splitter Elt -> [Elt] -> Bool +prop_keepDelimsL_no_delims s l = all (not . isDelim) (process (keepDelimsL s) l) + +prop_keepDelimsL_match :: Splitter Elt -> NonEmptyList Elt -> Bool +prop_keepDelimsL_match s (NonEmpty l) = + all (isJust . matchDelim (delimiter s)) [ c | Text c <- tail p ] + where p = process (keepDelimsL s) l + +prop_keepDelimsR_no_delims :: Splitter Elt -> [Elt] -> Bool +prop_keepDelimsR_no_delims s l = all (not . isDelim) (process (keepDelimsR s) l) + +prop_keepDelimsR_match :: Splitter Elt -> NonEmptyList Elt -> Bool +prop_keepDelimsR_match s (NonEmpty l) = + all (any (isJust . matchDelim (delimiter s)) . tails) + [ c | Text c <- init p ] + where p = process (keepDelimsR s) l + +prop_condense_no_consec_delims :: Splitter Elt -> [Elt] -> Bool +prop_condense_no_consec_delims s l = noConsecDelims $ process (condense s) l + +prop_condense_all_delims :: Splitter Elt -> [Elt] -> Bool +prop_condense_all_delims s l = all allDelims p + where p = [ d | Delim d <- process (condense s) l ] + allDelims t = all isDelim (splitInternal (delimiter s) t) + +prop_dropInitBlank :: Splitter Elt -> NonEmptyList Elt -> Bool +prop_dropInitBlank s (NonEmpty l) = head p /= Text [] + where p = process (dropInitBlank $ s { delimPolicy = Keep } ) l + +prop_dropFinalBlank :: Splitter Elt -> NonEmptyList Elt -> Bool +prop_dropFinalBlank s (NonEmpty l) = last p /= Text [] + where p = process (dropFinalBlank $ s { delimPolicy = Keep } ) l + +prop_dropBlanks :: Splitter Elt -> [Elt] -> Bool +prop_dropBlanks s = null . filter (== (Text [])) . process (dropBlanks s) + +prop_startsWith :: [Elt] -> NonEmptyList Elt -> Bool +prop_startsWith s (NonEmpty l) = all (s `isPrefixOf`) (tail $ split (startsWith s) l) + +prop_startsWithOneOf :: [Elt] -> NonEmptyList Elt -> Bool +prop_startsWithOneOf elts (NonEmpty l) = all ((`elem` elts) . head) (tail $ split (startsWithOneOf elts) l) + +prop_endsWith :: [Elt] -> NonEmptyList Elt -> Bool +prop_endsWith s (NonEmpty l) = all (s `isSuffixOf`) (init $ split (endsWith s) l) + +prop_endsWithOneOf :: [Elt] -> NonEmptyList Elt -> Bool +prop_endsWithOneOf elts (NonEmpty l) = all ((`elem` elts) . last) (init $ split (endsWithOneOf elts) l) + +prop_unintercalate_right_inv :: [Elt] -> [Elt] -> Bool +prop_unintercalate_right_inv x l = intercalate x (unintercalate x l) == l + +{- This property fails: for example, + + unintercalate "dd" (intercalate "dd" ["d",""]) == ["","d"] + + so it's not enough just to say that the delimiter is not an infix of + any elements of l! + + +prop_unintercalate_left_inv :: [Elt] -> NonEmptyList [Elt] -> Property +prop_unintercalate_left_inv x (NonEmpty ls) = not (any (x `isInfixOf`) ls) ==> + unintercalate x (intercalate x ls) == ls +-} + +prop_unintercalate_intercalate_idem :: [Elt] -> [[Elt]] -> Bool +prop_unintercalate_intercalate_idem x ls = f (f ls) == f ls + where f = unintercalate x . intercalate x + +prop_splitEvery_all_n :: Positive Int -> NonEmptyList Elt -> Bool +prop_splitEvery_all_n (Positive n) (NonEmpty l) = all ((==n) . length) (init $ splitEvery n l) + +prop_splitEvery_last_less_n :: Positive Int -> NonEmptyList Elt -> Bool +prop_splitEvery_last_less_n (Positive n) (NonEmpty l) = (<=n) . length . last $ splitEvery n l + +prop_splitEvery_preserve :: Positive Int -> [Elt] -> Bool +prop_splitEvery_preserve (Positive n) l = concat (splitEvery n l) == l + +prop_splitPlaces_lengths :: [NonNegative Int] -> [Elt] -> Bool +prop_splitPlaces_lengths ps = and . mInit . zipWith (==) ps' . map length . splitPlaces ps' + where ps' = map unNN ps + +prop_splitPlaces_last_less_n :: NonEmptyList (NonNegative Int) -> NonEmptyList Elt -> Bool +prop_splitPlaces_last_less_n (NonEmpty ps) (NonEmpty l) = (head $ drop (length l' - 1) ps') >= length (last l') + where l' = splitPlaces ps' l + ps' = map unNN ps + +prop_splitPlaces_preserve :: [NonNegative Integer] -> [Elt] -> Bool +prop_splitPlaces_preserve ps l = concat (splitPlaces ps' l) == genericTake (sum ps') l + where ps' = map unNN ps + +unNN :: NonNegative a -> a +unNN (NonNegative x) = x + +mInit :: [a] -> [a] +mInit [] = [] +mInit [x] = [] +mInit (x:xs) = x : init xs + +newtype EltNL = EltNL { unEltNL :: Char } + deriving (Eq, Show) + +instance Arbitrary EltNL where + arbitrary = elements (map EltNL "abcde\n") + +prop_lines :: [EltNL] -> Bool +prop_lines s = lines s' == endBy "\n" s' + where s' = map unEltNL s diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,39 @@ + +Data.List.Split provides a wide range of strategies and a unified +combinator framework for splitting lists with respect to some sort of +delimiter. + +------------------------------------------------------------------------ + +Dependencies: + + There are no dependencies other than the base package. + Data.List.Split has been tested with GHC 6.8.3 and 6.10.1, but it + will likely work with older versions of GHC and other Haskell + compilers as well. + + The Properties.hs file depends on QuickCheck >= 2.1, but you don't + need it in order to build the library. + + +Build with Cabal: + + cabal install --prefix=$HOME --user + + Or, if you don't have the 'cabal' tool: + + runhaskell Setup.lhs configure --prefix=$HOME --user + runhaskell Setup.lhs build + runhaskell Setup.lhs install + + (Optionally, you can omit the --prefix and --user arguments to the + configure step, and run the install step with 'sudo' in order to + install the library systemwide.) + + +Building Haddock documentation (recommended): + + runhaskell Setup.lhs haddock + + Once the documentation has been built, you can access it by + pointing your browser to dist/doc/html/split/index.html. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/split.cabal b/split.cabal new file mode 100644 --- /dev/null +++ b/split.cabal @@ -0,0 +1,25 @@ +Name: split +Version: 0.1 +Stability: experimental +Description: Combinator library and utility functions for splitting lists. +Homepage: http://code.haskell.org/~byorgey/code/split +Synopsis: Combinator library for splitting lists. +License: BSD3 +License-file: LICENSE +Extra-source-files: README, Properties.hs +Author: Brent Yorgey +Maintainer: byorgey@cis.upenn.edu +Category: List +Build-type: Simple +Cabal-Version: >= 1.2 + +flag testing + description: Testing mode + default: False + +library + ghc-options: -Wall + if flag(testing) + ghc-options: -Werror + Build-Depends: base + Exposed-Modules: Data.List.Split, Data.List.Split.Internals