{-# OPTIONS -fno-warn-orphans #-}
{-# LANGUAGE EmptyDataDecls    #-}
{-# LANGUAGE StandaloneDeriving #-}

module Data.List where

import Prelude
import Data.Maybe

-- | The 'isPrefixOf' function takes two lists and returns 'True'
-- iff the first list is a prefix of the second.
isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool
isPrefixOf :: [a] -> [a] -> Bool
isPrefixOf [] [a]
_         =  Bool
True
isPrefixOf [a]
_  []        =  Bool
False
isPrefixOf (a
x:[a]
xs) (a
y:[a]
ys)=  a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y Bool -> Bool -> Bool
&& [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
xs [a]
ys

-- | The 'isSuffixOf' function takes two lists and returns 'True'
-- iff the first list is a suffix of the second.
-- Both lists must be finite.
isSuffixOf              :: (Eq a) => [a] -> [a] -> Bool
isSuffixOf :: [a] -> [a] -> Bool
isSuffixOf [a]
x [a]
y          =  [a] -> [a]
forall a. [a] -> [a]
reverse [a]
x [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [a] -> [a]
forall a. [a] -> [a]
reverse [a]
y

-- | The 'stripPrefix' function drops the given prefix from a list.
-- It returns 'Nothing' if the list did not start with the prefix
-- given, or 'Just' the list after the prefix, if it does.
--
-- > stripPrefix "foo" "foobar" == Just "bar"
-- > stripPrefix "foo" "foo" == Just ""
-- > stripPrefix "foo" "barfoo" == Nothing
-- > stripPrefix "foo" "barfoobaz" == Nothing
stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]
stripPrefix :: [a] -> [a] -> Maybe [a]
stripPrefix [] [a]
ys = [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
ys
stripPrefix (a
x:[a]
xs) (a
y:[a]
ys)
 | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [a]
xs [a]
ys
stripPrefix [a]
_ [a]
_ = Maybe [a]
forall a. Maybe a
Nothing

-- | Like 'stripPrefix', but drops the given suffix from the end.
stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
stripSuffix :: [a] -> [a] -> Maybe [a]
stripSuffix [a]
x [a]
y = ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall a b. (a -> b) -> Maybe a -> Maybe b
onJust [a] -> [a]
forall a. [a] -> [a]
reverse (Maybe [a] -> Maybe [a]) -> Maybe [a] -> Maybe [a]
forall t1 t. (t1 -> t) -> t1 -> t
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
x [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` [a] -> [a]
forall a. [a] -> [a]
reverse [a]
y

-- | Split lists at delimiter specified by a condition
--   Drops empty groups (similar to `words`)
splitWhen :: (a -> Bool) -> [a] -> [[a]]
splitWhen :: (a -> Bool) -> [a] -> [[a]]
splitWhen a -> Bool
p [a]
s = case (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
p [a]
s of
  [] -> []
  [a]
s' -> case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
s' of
    ([a]
w, [a]
s'') -> [a]
w [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen a -> Bool
p [a]
s''

-- | Split lists at the specified delimiter
--   Drops empty groups (similar to `words`)
splitOn :: Eq a => a -> [a] -> [[a]]
splitOn :: a -> [a] -> [[a]]
splitOn a
c = (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
c)

-- | The 'partition' function takes a predicate a list and returns
-- the pair of lists of elements which do and do not satisfy the
-- predicate, respectively; i.e.,
--
-- > partition p xs == (filter p xs, filter (not . p) xs)

partition :: (a -> Bool) -> [a] -> ([a],[a])
partition :: (a -> Bool) -> [a] -> ([a], [a])
partition a -> Bool
p [a]
xs = ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p [a]
xs, (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall t1 t t2. (t1 -> t) -> (t2 -> t1) -> t2 -> t
. a -> Bool
p) [a]
xs)
{-
-- Fay doesn't support irrefutable patterns
partition :: (a -> Bool) -> [a] -> ([a],[a])
partition p = foldr (select p) ([],[])
  where
    select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
    select p x ~(ts,fs) | p x       = (x:ts,fs)
                        | otherwise = (ts, x:fs)
-}

-- | The 'inits' function returns all initial segments of the argument,
-- shortest first.  For example,
--
-- > inits "abc" == ["","a","ab","abc"]
--
-- Note that 'inits' has the following strictness property:
-- @inits _|_ = [] : _|_@
inits                   :: [a] -> [[a]]
inits :: [a] -> [[a]]
inits [a]
xs                =  [] [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: case [a]
xs of
                                  []      -> []
                                  a
x : [a]
xs' -> ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [[a]]
forall a. [a] -> [[a]]
inits [a]
xs')

-- This one /isn't/ from Data.List
groupSortBy :: (a -> a -> Ordering) -> [a] -> [[a]]
groupSortBy :: (a -> a -> Ordering) -> [a] -> [[a]]
groupSortBy a -> a -> Ordering
f = (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\a
x a
y -> a -> a -> Ordering
f a
x a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ) ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall t1 t t2. (t1 -> t) -> (t2 -> t1) -> t2 -> t
. (a -> a -> Ordering) -> [a] -> [a]
forall t. (t -> t -> Ordering) -> [t] -> [t]
sortBy a -> a -> Ordering
f

-- | Classic group by.
groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy a -> a -> Bool
_  []           =  []
groupBy a -> a -> Bool
eq (a
x:[a]
xs)       =  case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (a -> a -> Bool
eq a
x) [a]
xs of
  ([a]
ys,[a]
zs) -> (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy a -> a -> Bool
eq [a]
zs

-- | Belongs in Control.Monad, right?
findM :: (a -> Fay (Maybe b)) -> [a] -> Fay (Maybe b)
findM :: (a -> Fay (Maybe b)) -> [a] -> Fay (Maybe b)
findM a -> Fay (Maybe b)
_ [] = Maybe b -> Fay (Maybe b)
forall a. a -> Fay a
return Maybe b
forall a. Maybe a
Nothing
findM a -> Fay (Maybe b)
f (a
x:[a]
xs) = do
  Maybe b
b <- a -> Fay (Maybe b)
f a
x
  case Maybe b
b of
    Maybe b
Nothing -> (a -> Fay (Maybe b)) -> [a] -> Fay (Maybe b)
forall a b. (a -> Fay (Maybe b)) -> [a] -> Fay (Maybe b)
findM a -> Fay (Maybe b)
f [a]
xs
    Just b
_ -> Maybe b -> Fay (Maybe b)
forall a. a -> Fay a
return Maybe b
b