{-|
Description : Splitting lists on sublists
-}
module Language.Haskell.Formatter.Toolkit.Splitter (separate) where
import qualified Control.Applicative as Applicative
import qualified Data.List as List
import qualified Data.Monoid as Monoid
import qualified Language.Haskell.Formatter.Toolkit.ListTool as ListTool
import qualified Language.Haskell.Formatter.Toolkit.Visit as Visit

{-| Strategy to split a list on sublists. -}
data Splitter a = Splitter{Splitter a -> DelimiterPolicy
delimiterPolicy :: DelimiterPolicy,
                           Splitter a -> [[a]]
delimiterQueue :: [[a]]}
                    deriving (Splitter a -> Splitter a -> Bool
(Splitter a -> Splitter a -> Bool)
-> (Splitter a -> Splitter a -> Bool) -> Eq (Splitter a)
forall a. Eq a => Splitter a -> Splitter a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Splitter a -> Splitter a -> Bool
$c/= :: forall a. Eq a => Splitter a -> Splitter a -> Bool
== :: Splitter a -> Splitter a -> Bool
$c== :: forall a. Eq a => Splitter a -> Splitter a -> Bool
Eq, Eq (Splitter a)
Eq (Splitter a)
-> (Splitter a -> Splitter a -> Ordering)
-> (Splitter a -> Splitter a -> Bool)
-> (Splitter a -> Splitter a -> Bool)
-> (Splitter a -> Splitter a -> Bool)
-> (Splitter a -> Splitter a -> Bool)
-> (Splitter a -> Splitter a -> Splitter a)
-> (Splitter a -> Splitter a -> Splitter a)
-> Ord (Splitter a)
Splitter a -> Splitter a -> Bool
Splitter a -> Splitter a -> Ordering
Splitter a -> Splitter a -> Splitter a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Splitter a)
forall a. Ord a => Splitter a -> Splitter a -> Bool
forall a. Ord a => Splitter a -> Splitter a -> Ordering
forall a. Ord a => Splitter a -> Splitter a -> Splitter a
min :: Splitter a -> Splitter a -> Splitter a
$cmin :: forall a. Ord a => Splitter a -> Splitter a -> Splitter a
max :: Splitter a -> Splitter a -> Splitter a
$cmax :: forall a. Ord a => Splitter a -> Splitter a -> Splitter a
>= :: Splitter a -> Splitter a -> Bool
$c>= :: forall a. Ord a => Splitter a -> Splitter a -> Bool
> :: Splitter a -> Splitter a -> Bool
$c> :: forall a. Ord a => Splitter a -> Splitter a -> Bool
<= :: Splitter a -> Splitter a -> Bool
$c<= :: forall a. Ord a => Splitter a -> Splitter a -> Bool
< :: Splitter a -> Splitter a -> Bool
$c< :: forall a. Ord a => Splitter a -> Splitter a -> Bool
compare :: Splitter a -> Splitter a -> Ordering
$ccompare :: forall a. Ord a => Splitter a -> Splitter a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Splitter a)
Ord, Int -> Splitter a -> ShowS
[Splitter a] -> ShowS
Splitter a -> String
(Int -> Splitter a -> ShowS)
-> (Splitter a -> String)
-> ([Splitter a] -> ShowS)
-> Show (Splitter a)
forall a. Show a => Int -> Splitter a -> ShowS
forall a. Show a => [Splitter a] -> ShowS
forall a. Show a => Splitter a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Splitter a] -> ShowS
$cshowList :: forall a. Show a => [Splitter a] -> ShowS
show :: Splitter a -> String
$cshow :: forall a. Show a => Splitter a -> String
showsPrec :: Int -> Splitter a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Splitter a -> ShowS
Show)

{-| What to do with the delimiters? -}
data DelimiterPolicy = Drop
                     | Separate
                     | MergeLeft
                     | MergeRight
                         deriving (DelimiterPolicy -> DelimiterPolicy -> Bool
(DelimiterPolicy -> DelimiterPolicy -> Bool)
-> (DelimiterPolicy -> DelimiterPolicy -> Bool)
-> Eq DelimiterPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DelimiterPolicy -> DelimiterPolicy -> Bool
$c/= :: DelimiterPolicy -> DelimiterPolicy -> Bool
== :: DelimiterPolicy -> DelimiterPolicy -> Bool
$c== :: DelimiterPolicy -> DelimiterPolicy -> Bool
Eq, Eq DelimiterPolicy
Eq DelimiterPolicy
-> (DelimiterPolicy -> DelimiterPolicy -> Ordering)
-> (DelimiterPolicy -> DelimiterPolicy -> Bool)
-> (DelimiterPolicy -> DelimiterPolicy -> Bool)
-> (DelimiterPolicy -> DelimiterPolicy -> Bool)
-> (DelimiterPolicy -> DelimiterPolicy -> Bool)
-> (DelimiterPolicy -> DelimiterPolicy -> DelimiterPolicy)
-> (DelimiterPolicy -> DelimiterPolicy -> DelimiterPolicy)
-> Ord DelimiterPolicy
DelimiterPolicy -> DelimiterPolicy -> Bool
DelimiterPolicy -> DelimiterPolicy -> Ordering
DelimiterPolicy -> DelimiterPolicy -> DelimiterPolicy
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DelimiterPolicy -> DelimiterPolicy -> DelimiterPolicy
$cmin :: DelimiterPolicy -> DelimiterPolicy -> DelimiterPolicy
max :: DelimiterPolicy -> DelimiterPolicy -> DelimiterPolicy
$cmax :: DelimiterPolicy -> DelimiterPolicy -> DelimiterPolicy
>= :: DelimiterPolicy -> DelimiterPolicy -> Bool
$c>= :: DelimiterPolicy -> DelimiterPolicy -> Bool
> :: DelimiterPolicy -> DelimiterPolicy -> Bool
$c> :: DelimiterPolicy -> DelimiterPolicy -> Bool
<= :: DelimiterPolicy -> DelimiterPolicy -> Bool
$c<= :: DelimiterPolicy -> DelimiterPolicy -> Bool
< :: DelimiterPolicy -> DelimiterPolicy -> Bool
$c< :: DelimiterPolicy -> DelimiterPolicy -> Bool
compare :: DelimiterPolicy -> DelimiterPolicy -> Ordering
$ccompare :: DelimiterPolicy -> DelimiterPolicy -> Ordering
$cp1Ord :: Eq DelimiterPolicy
Ord, Int -> DelimiterPolicy -> ShowS
[DelimiterPolicy] -> ShowS
DelimiterPolicy -> String
(Int -> DelimiterPolicy -> ShowS)
-> (DelimiterPolicy -> String)
-> ([DelimiterPolicy] -> ShowS)
-> Show DelimiterPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DelimiterPolicy] -> ShowS
$cshowList :: [DelimiterPolicy] -> ShowS
show :: DelimiterPolicy -> String
$cshow :: DelimiterPolicy -> String
showsPrec :: Int -> DelimiterPolicy -> ShowS
$cshowsPrec :: Int -> DelimiterPolicy -> ShowS
Show)

{-| @separate d l@ splits @l@ on the delimiters @d@, which are matched in the
    given order. The delimiters are not kept.

    >>> separate ["pineapple", "pine"] "0pineapple1"
    ["0","1"]
    >>> separate ["pine", "pineapple"] "0pineapple1"
    ["0","apple1"] -}
separate :: Eq a => [[a]] -> [a] -> [[a]]
separate :: [[a]] -> [a] -> [[a]]
separate = Splitter a -> [a] -> [[a]]
forall a. Eq a => Splitter a -> [a] -> [[a]]
split (Splitter a -> [a] -> [[a]])
-> ([[a]] -> Splitter a) -> [[a]] -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DelimiterPolicy -> [[a]] -> Splitter a
forall a. DelimiterPolicy -> [[a]] -> Splitter a
createSplitter DelimiterPolicy
Drop
  where createSplitter :: DelimiterPolicy -> [[a]] -> Splitter a
createSplitter DelimiterPolicy
rawDelimiterPolicy [[a]]
rawDelimiterQueue
          = Splitter :: forall a. DelimiterPolicy -> [[a]] -> Splitter a
Splitter{delimiterPolicy :: DelimiterPolicy
delimiterPolicy = DelimiterPolicy
rawDelimiterPolicy,
                     delimiterQueue :: [[a]]
delimiterQueue = [[a]]
rawDelimiterQueue}

{-| @split s l@ splits @l@ according to the strategy @s@. -}
split :: Eq a => Splitter a -> [a] -> [[a]]
split :: Splitter a -> [a] -> [[a]]
split Splitter a
splitter [a]
list
  = case Splitter a -> DelimiterPolicy
forall a. Splitter a -> DelimiterPolicy
delimiterPolicy Splitter a
splitter of
        DelimiterPolicy
Drop -> Int -> [[a]] -> [[a]]
forall a. Int -> [a] -> [a]
ListTool.takeEvery Int
period [[a]]
parts
        DelimiterPolicy
Separate -> [[a]]
parts
        DelimiterPolicy
MergeLeft -> Int -> [[a]] -> [[a]]
forall a. Int -> [[a]] -> [[a]]
ListTool.concatenateRuns Int
period [[a]]
parts
        DelimiterPolicy
MergeRight -> Int -> Int -> [[a]] -> [[a]]
forall a. Int -> Int -> [[a]] -> [[a]]
ListTool.concatenateShiftedRuns Int
period Int
shift [[a]]
parts
          where shift :: Int
shift = Int
1
  where period :: Int
period = Int
2
        parts :: [[a]]
parts = [[a]] -> [a] -> [[a]]
forall a. Eq a => [[a]] -> [a] -> [[a]]
rawSplit (Splitter a -> [[a]]
forall a. Splitter a -> [[a]]
delimiterQueue Splitter a
splitter) [a]
list

{-| @rawSplit s l@ splits @l@ on the sublists @s@, keeping the separators.

    prop> odd . length $ separate ["apple", "pine"] l -}
rawSplit :: Eq a => [[a]] -> [a] -> [[a]]
rawSplit :: [[a]] -> [a] -> [[a]]
rawSplit [[a]]
delimiters = [[a]] -> [a] -> [a] -> [[a]]
move [] []
  where move :: [[a]] -> [a] -> [a] -> [[a]]
move [[a]]
parts [a]
left [] = [[a]] -> [[a]] -> [[a]]
forall a. Monoid a => a -> a -> a
Monoid.mappend [[a]]
parts [[a]
left]
        move [[a]]
parts [a]
left right :: [a]
right@(a
first : [a]
rest)
          = case [[a]] -> [a] -> Maybe ([a], [a])
forall a. Eq a => [[a]] -> [a] -> Maybe ([a], [a])
stripFirstPrefix [[a]]
delimiters [a]
right of
                Maybe ([a], [a])
Nothing -> [[a]] -> [a] -> [a] -> [[a]]
move [[a]]
parts ([a] -> [a] -> [a]
forall a. Monoid a => a -> a -> a
Monoid.mappend [a]
left [a
first]) [a]
rest
                Just ([a]
delimiter, [a]
suffix) -> [[a]] -> [a] -> [a] -> [[a]]
move
                                              ([[a]] -> [[a]] -> [[a]]
forall a. Monoid a => a -> a -> a
Monoid.mappend [[a]]
parts
                                                 [[a]
left, [a]
delimiter])
                                              []
                                              [a]
suffix

{-| @stripFirstPrefix p l@ returns the first element of @p@ which is a prefix of
    @l@ and the rest of @l@. It returns 'Nothing' if there is no such element.

    >>> stripFirstPrefix ["\LF", "\CR\LF", "\CR"] "\CR\LFpine"
    Just ("\r\n","pine")
    >>> stripFirstPrefix ["apple"] "pineapple"
    Nothing -}
stripFirstPrefix :: Eq a => [[a]] -> [a] -> Maybe ([a], [a])
stripFirstPrefix :: [[a]] -> [a] -> Maybe ([a], [a])
stripFirstPrefix [[a]]
prefixes [a]
list = ([a] -> Maybe ([a], [a])) -> [[a]] -> Maybe ([a], [a])
forall (t :: * -> *) a b.
(Functor t, Foldable t) =>
(a -> Maybe b) -> t a -> Maybe b
Visit.findJust [a] -> Maybe ([a], [a])
strip [[a]]
prefixes
  where strip :: [a] -> Maybe ([a], [a])
strip [a]
prefix = (,) [a]
prefix ([a] -> ([a], [a])) -> Maybe [a] -> Maybe ([a], [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Applicative.<$> [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix [a]
prefix [a]
list