{-# OPTIONS_HADDOCK prune #-}
module Data.List.Split.Internals where
import Data.List (genericSplitAt)
data Splitter a = Splitter { delimiter :: Delimiter a
, delimPolicy :: DelimPolicy
, condensePolicy :: CondensePolicy
, initBlankPolicy :: EndPolicy
, finalBlankPolicy :: EndPolicy
}
defaultSplitter :: Splitter a
defaultSplitter = Splitter { delimiter = Delimiter [const False]
, delimPolicy = Keep
, condensePolicy = KeepBlankFields
, initBlankPolicy = KeepBlank
, finalBlankPolicy = KeepBlank
}
newtype Delimiter a = Delimiter [a -> Bool]
matchDelim :: Delimiter a -> [a] -> Maybe ([a],[a])
matchDelim (Delimiter []) xs = Just ([],xs)
matchDelim (Delimiter _) [] = Nothing
matchDelim (Delimiter (p:ps)) (x:xs)
| p x = matchDelim (Delimiter ps) xs >>= \(h,t) -> Just (x:h,t)
| otherwise = Nothing
data DelimPolicy = Drop
| Keep
| KeepLeft
| KeepRight
deriving (Eq, Show)
data CondensePolicy = Condense
| DropBlankFields
| KeepBlankFields
deriving (Eq, Show)
data EndPolicy = DropBlank | KeepBlank
deriving (Eq, Show)
data Chunk a = Delim [a] | Text [a]
deriving (Show, Eq)
type SplitList a = [Chunk a]
fromElem :: Chunk a -> [a]
fromElem (Text as) = as
fromElem (Delim as) = as
isDelim :: Chunk a -> Bool
isDelim (Delim _) = True
isDelim _ = False
isText :: Chunk a -> Bool
isText (Text _) = True
isText _ = False
splitInternal :: Delimiter a -> [a] -> SplitList a
splitInternal _ [] = []
splitInternal d xxs
| null xs = toSplitList match
| otherwise = Text xs : toSplitList match
where
(xs,match) = breakDelim d xxs
toSplitList Nothing = []
toSplitList (Just ([],r:rs)) = Delim [] : Text [r] : splitInternal d rs
toSplitList (Just (delim,rest)) = Delim delim : splitInternal d rest
breakDelim :: Delimiter a -> [a] -> ([a],Maybe ([a],[a]))
breakDelim (Delimiter []) xs = ([],Just ([],xs))
breakDelim _ [] = ([],Nothing)
breakDelim d xxs@(x:xs) =
case matchDelim d xxs of
Nothing -> let (ys,match) = breakDelim d xs in (x:ys,match)
Just match -> ([], Just match)
postProcess :: Splitter a -> SplitList a -> SplitList a
postProcess s = dropFinal (finalBlankPolicy s)
. dropInitial (initBlankPolicy s)
. doMerge (delimPolicy s)
. doDrop (delimPolicy s)
. insertBlanks (condensePolicy s)
. doCondense (condensePolicy s)
doDrop :: DelimPolicy -> SplitList a -> SplitList a
doDrop Drop l = [ c | c@(Text _) <- l ]
doDrop _ l = l
doCondense :: CondensePolicy -> SplitList a -> SplitList a
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
doCondense _ ls = ls
insertBlanks :: CondensePolicy -> SplitList a -> SplitList a
insertBlanks _ [] = [Text []]
insertBlanks cp (d@(Delim _) : l) = Text [] : insertBlanks' cp (d:l)
insertBlanks cp l = insertBlanks' cp l
insertBlanks' :: CondensePolicy -> SplitList a -> SplitList a
insertBlanks' _ [] = []
insertBlanks' cp@DropBlankFields (d1@(Delim _) : d2@(Delim _) : l)
= d1 : insertBlanks' cp (d2:l)
insertBlanks' cp (d1@(Delim _) : d2@(Delim _) : l)
= d1 : Text [] : insertBlanks' cp (d2:l)
insertBlanks' _ [d@(Delim _)] = [d, Text []]
insertBlanks' cp (c : l) = c : insertBlanks' cp l
doMerge :: DelimPolicy -> SplitList a -> SplitList a
doMerge KeepLeft = mergeLeft
doMerge KeepRight = mergeRight
doMerge _ = id
mergeLeft :: SplitList a -> SplitList a
mergeLeft [] = []
mergeLeft ((Delim d) : (Text c) : l) = Text (d++c) : mergeLeft l
mergeLeft (c : l) = c : mergeLeft l
mergeRight :: SplitList a -> SplitList a
mergeRight [] = []
mergeRight ((Text c) : l) = Text (c++d) : mergeRight lTail
where (d, lTail) = case l of
Delim d' : l' -> (d', l')
_ -> ([], l)
mergeRight (c : l) = c : mergeRight l
dropInitial :: EndPolicy -> SplitList a -> SplitList a
dropInitial DropBlank (Text [] : l) = l
dropInitial _ l = l
dropFinal :: EndPolicy -> SplitList a -> SplitList a
dropFinal _ [] = []
dropFinal DropBlank l = dropFinal' l
where dropFinal' [] = []
dropFinal' [Text []] = []
dropFinal' (x:xs) = x:dropFinal' xs
dropFinal _ l = l
split :: Splitter a -> [a] -> [[a]]
split s = map fromElem . postProcess s . splitInternal (delimiter s)
oneOf :: Eq a => [a] -> Splitter a
oneOf elts = defaultSplitter { delimiter = Delimiter [(`elem` elts)] }
onSublist :: Eq a => [a] -> Splitter a
onSublist lst = defaultSplitter { delimiter = Delimiter (map (==) lst) }
whenElt :: (a -> Bool) -> Splitter a
whenElt p = defaultSplitter { delimiter = Delimiter [p] }
dropDelims :: Splitter a -> Splitter a
dropDelims s = s { delimPolicy = Drop }
keepDelimsL :: Splitter a -> Splitter a
keepDelimsL s = s { delimPolicy = KeepLeft }
keepDelimsR :: Splitter a -> Splitter a
keepDelimsR s = s { delimPolicy = KeepRight }
condense :: Splitter a -> Splitter a
condense s = s { condensePolicy = Condense }
dropInitBlank :: Splitter a -> Splitter a
dropInitBlank s = s { initBlankPolicy = DropBlank }
dropFinalBlank :: Splitter a -> Splitter a
dropFinalBlank s = s { finalBlankPolicy = DropBlank }
dropInnerBlanks :: Splitter a -> Splitter a
dropInnerBlanks s = s { condensePolicy = DropBlankFields }
dropBlanks :: Splitter a -> Splitter a
dropBlanks = dropInitBlank . dropFinalBlank . condense
startsWith :: Eq a => [a] -> Splitter a
startsWith = dropInitBlank . keepDelimsL . onSublist
startsWithOneOf :: Eq a => [a] -> Splitter a
startsWithOneOf = dropInitBlank . keepDelimsL . oneOf
endsWith :: Eq a => [a] -> Splitter a
endsWith = dropFinalBlank . keepDelimsR . onSublist
endsWithOneOf :: Eq a => [a] -> Splitter a
endsWithOneOf = dropFinalBlank . keepDelimsR . oneOf
splitOneOf :: Eq a => [a] -> [a] -> [[a]]
splitOneOf = split . dropDelims . oneOf
splitOn :: Eq a => [a] -> [a] -> [[a]]
splitOn = split . dropDelims . onSublist
splitWhen :: (a -> Bool) -> [a] -> [[a]]
splitWhen = split . dropDelims . whenElt
{-# DEPRECATED sepBy "Use splitOn." #-}
sepBy :: Eq a => [a] -> [a] -> [[a]]
sepBy = splitOn
{-# DEPRECATED sepByOneOf "Use splitOneOf." #-}
sepByOneOf :: Eq a => [a] -> [a] -> [[a]]
sepByOneOf = splitOneOf
endBy :: Eq a => [a] -> [a] -> [[a]]
endBy = split . dropFinalBlank . dropDelims . onSublist
endByOneOf :: Eq a => [a] -> [a] -> [[a]]
endByOneOf = split . dropFinalBlank . dropDelims . oneOf
{-# DEPRECATED unintercalate "Use splitOn." #-}
unintercalate :: Eq a => [a] -> [a] -> [[a]]
unintercalate = splitOn
wordsBy :: (a -> Bool) -> [a] -> [[a]]
wordsBy = split . dropBlanks . dropDelims . whenElt
linesBy :: (a -> Bool) -> [a] -> [[a]]
linesBy = split . dropFinalBlank . dropDelims . whenElt
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build g = g (:) []
chunksOf :: Int -> [e] -> [[e]]
chunksOf i ls = map (take i) (build (splitter ls)) where
splitter :: [e] -> ([e] -> a -> a) -> a -> a
splitter [] _ n = n
splitter l c n = l `c` splitter (drop i l) c n
{-# DEPRECATED chunk "Use chunksOf." #-}
chunk :: Int -> [e] -> [[e]]
chunk = chunksOf
{-# DEPRECATED splitEvery "Use chunksOf." #-}
splitEvery :: Int -> [e] -> [[e]]
splitEvery = chunksOf
splitPlaces :: Integral a => [a] -> [e] -> [[e]]
splitPlaces is ys = build (splitPlacer is ys) where
splitPlacer :: Integral i => [i] -> [b] -> ([b] -> t -> t) -> t -> t
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
splitPlacesBlanks :: Integral a => [a] -> [e] -> [[e]]
splitPlacesBlanks is ys = build (splitPlacer is ys) where
splitPlacer :: Integral i => [i] -> [b] -> ([b] -> t -> t) -> t -> t
splitPlacer [] _ _ n = n
splitPlacer (l:ls) xs c n = let (x1, x2) = genericSplitAt l xs
in x1 `c` splitPlacer ls x2 c n
chop :: ([a] -> (b, [a])) -> [a] -> [b]
chop _ [] = []
chop f as = b : chop f as'
where (b, as') = f as