    module Data.List.Match.Private where

    import Data.Maybe    (fromJust, isNothing, )
    import Data.Maybe.HT (toMaybe, )
    import Data.Tuple.HT (mapFst, forcePair, )
    import Data.Bool.HT  (if', )

    import qualified Data.List as List

    import Control.Functor.HT (void, )

    import Prelude hiding (take, drop, splitAt, replicate, )

    -- $setup
    -- >>> import qualified Data.List.Match.Private as Match
    -- >>> import qualified Data.List as List
    -- >>>
    -- >>> import qualified Test.QuickCheck as QC
    -- >>>
    -- >>> newtype List = List [Integer] deriving (Show)
    -- >>> instance QC.Arbitrary List where
    -- >>>    arbitrary = fmap List QC.arbitrary
    -- >>>    shrink (List xs) = map List $ QC.shrink xs
    -- >>>
    -- >>> newtype Shape = Shape [Ordering] deriving (Show)
    -- >>> instance QC.Arbitrary Shape where
    -- >>>    arbitrary = fmap Shape QC.arbitrary
    -- >>>    shrink (Shape xs) = map Shape $ QC.shrink xs

    {- | Make a list as long as another one

    prop> \(Shape xs) (List ys) -> Match.take xs ys == List.take (length xs) ys
    -}
    {-
    @flip (zipWith const)@ is not as lazy,
    e.g. would be @take [] undefined = undefined@,
    but it should be @take [] undefined = []@.
    -}
    take :: [b] -> [a] -> [a]
    take :: forall b a. [b] -> [a] -> [a]
    take = (b -> a -> a) -> [b] -> [a] -> [a]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith ((a -> b -> a) -> b -> a -> a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip a -> b -> a
    forall a b. a -> b -> a
    const)

    {- | Drop as many elements as the first list is long

    prop> \(Shape xs) (List ys) -> Match.drop xs ys == List.drop (length xs) ys
    prop> \(Shape xs) (List ys) -> Match.take xs ys ++ Match.drop xs ys == ys
    -}
    drop :: [b] -> [a] -> [a]
    drop :: forall b a. [b] -> [a] -> [a]
    drop [b]
    xs [a]
    ys0 =
       ([a] -> b -> [a]) -> [a] -> [b] -> [a]
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\[a]
    ys b
    _ -> [a] -> [a]
    forall a. [a] -> [a]
    laxTail [a]
    ys) [a]
    ys0 [b]
    xs

    -- | prop> \(Shape xs) (List ys) -> Match.drop xs ys == dropRec xs ys
    {-
    Shares suffix with input,
    that is it is more efficient than the implementations below.
    -}
    dropRec :: [b] -> [a] -> [a]
    dropRec :: forall b a. [b] -> [a] -> [a]
    dropRec (b
    _:[b]
    xs) (a
    _:[a]
    ys) = [b] -> [a] -> [a]
    forall b a. [b] -> [a] -> [a]
    dropRec [b]
    xs [a]
    ys
    dropRec [b]
    _ [a]
    ys = [a]
    ys

    -- | prop> \(Shape xs) (List ys) -> Match.drop xs ys == drop0 xs ys
    drop0 :: [b] -> [a] -> [a]
    drop0 :: forall b a. [b] -> [a] -> [a]
    drop0 [b]
    xs [a]
    ys =
       -- catMaybes (
       (Maybe a -> a) -> [Maybe a] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map Maybe a -> a
    forall a. HasCallStack => Maybe a -> a
    fromJust ((Maybe a -> Bool) -> [Maybe a] -> [Maybe a]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Maybe a -> Bool
    forall a. Maybe a -> Bool
    isNothing
          (([b] -> a -> Maybe a) -> [[b]] -> [a] -> [Maybe a]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (Bool -> a -> Maybe a
    forall a. Bool -> a -> Maybe a
    toMaybe (Bool -> a -> Maybe a) -> ([b] -> Bool) -> [b] -> a -> Maybe a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [b] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) (([b] -> [b]) -> [b] -> [[b]]
    forall a. (a -> a) -> a -> [a]
    iterate [b] -> [b]
    forall a. [a] -> [a]
    laxTail [b]
    xs) [a]
    ys))

    -- | prop> \(Shape xs) (List ys) -> Match.drop xs ys == drop1 xs ys
    drop1 :: [b] -> [a] -> [a]
    drop1 :: forall b a. [b] -> [a] -> [a]
    drop1 [b]
    xs [a]
    ys =
       (([b], a) -> a) -> [([b], a)] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map ([b], a) -> a
    forall a b. (a, b) -> b
    snd ((([b], a) -> Bool) -> [([b], a)] -> [([b], a)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not (Bool -> Bool) -> (([b], a) -> Bool) -> ([b], a) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [b] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([b] -> Bool) -> (([b], a) -> [b]) -> ([b], a) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([b], a) -> [b]
    forall a b. (a, b) -> a
    fst) ([[b]] -> [a] -> [([b], a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (([b] -> [b]) -> [b] -> [[b]]
    forall a. (a -> a) -> a -> [a]
    iterate [b] -> [b]
    forall a. [a] -> [a]
    laxTail [b]
    xs) [a]
    ys))

    -- | prop> \(Shape xs) (List ys) -> Match.drop xs ys == drop2 xs ys
    drop2 :: [b] -> [a] -> [a]
    drop2 :: forall b a. [b] -> [a] -> [a]
    drop2 [b]
    xs [a]
    ys =
       ([b], [a]) -> [a]
    forall a b. (a, b) -> b
    snd (([b], [a]) -> [a]) -> ([b], [a]) -> [a]
    forall a b. (a -> b) -> a -> b
    $ [([b], [a])] -> ([b], [a])
    forall a. HasCallStack => [a] -> a
    head ([([b], [a])] -> ([b], [a])) -> [([b], [a])] -> ([b], [a])
    forall a b. (a -> b) -> a -> b
    $
       (([b], [a]) -> Bool) -> [([b], [a])] -> [([b], [a])]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not (Bool -> Bool) -> (([b], [a]) -> Bool) -> ([b], [a]) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [b] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([b] -> Bool) -> (([b], [a]) -> [b]) -> ([b], [a]) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([b], [a]) -> [b]
    forall a b. (a, b) -> a
    fst) ([([b], [a])] -> [([b], [a])]) -> [([b], [a])] -> [([b], [a])]
    forall a b. (a -> b) -> a -> b
    $
       [[b]] -> [[a]] -> [([b], [a])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (([b] -> [b]) -> [b] -> [[b]]
    forall a. (a -> a) -> a -> [a]
    iterate [b] -> [b]
    forall a. [a] -> [a]
    laxTail [b]
    xs) (([a] -> [a]) -> [a] -> [[a]]
    forall a. (a -> a) -> a -> [a]
    iterate [a] -> [a]
    forall a. [a] -> [a]
    laxTail [a]
    ys)

    {- |
    >>> laxTail ""
    ""
    >>> laxTail "a"
    ""
    >>> laxTail "ab"
    "b"
    -}
    laxTail :: [a] -> [a]
    laxTail :: forall a. [a] -> [a]
    laxTail [a]
    xt = case [a]
    xt of [] -> []; a
    _:[a]
    xs -> [a]
    xs

    -- | prop> \(List xs) -> Match.laxTail xs == Match.laxTail0 xs
    laxTail0 :: [a] -> [a]
    laxTail0 :: forall a. [a] -> [a]
    laxTail0 = Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    List.drop Int
    1

    {- |
    prop> \(Shape xs) (List ys) -> Match.splitAt xs ys == (Match.take xs ys, Match.drop xs ys)
    prop> \(Shape xs) (List ys) -> Match.splitAt xs ys == List.splitAt (length xs) ys
    -}
    splitAt :: [b] -> [a] -> ([a],[a])
    splitAt :: forall b a. [b] -> [a] -> ([a], [a])
    splitAt [b]
    nt [a]
    xt =
       ([a], [a]) -> ([a], [a])
    forall a b. (a, b) -> (a, b)
    forcePair (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
    forall a b. (a -> b) -> a -> b
    $
       case ([b]
    nt,[a]
    xt) of
          (b
    _:[b]
    ns, a
    x:[a]
    xs) -> ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
    forall a c b. (a -> c) -> (a, b) -> (c, b)
    mapFst (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :) (([a], [a]) -> ([a], [a])) -> ([a], [a]) -> ([a], [a])
    forall a b. (a -> b) -> a -> b
    $ [b] -> [a] -> ([a], [a])
    forall b a. [b] -> [a] -> ([a], [a])
    splitAt [b]
    ns [a]
    xs
          ([b]
    _, [a]
    xs) -> ([],[a]
    xs)

    -- | prop> \(Shape xs) (List ys) -> Match.takeRev xs ys == reverse (Match.take xs (reverse ys))
    takeRev :: [b] -> [a] -> [a]
    takeRev :: forall b a. [b] -> [a] -> [a]
    takeRev [b]
    ys [a]
    xs = [a] -> [a] -> [a]
    forall b a. [b] -> [a] -> [a]
    drop ([b] -> [a] -> [a]
    forall b a. [b] -> [a] -> [a]
    drop [b]
    ys [a]
    xs) [a]
    xs

    -- | prop> \(Shape xs) (List ys) -> Match.dropRev xs ys == reverse (Match.drop xs (reverse ys))
    dropRev :: [b] -> [a] -> [a]
    dropRev :: forall b a. [b] -> [a] -> [a]
    dropRev [b]
    ys [a]
    xs = [a] -> [a] -> [a]
    forall b a. [b] -> [a] -> [a]
    take ([b] -> [a] -> [a]
    forall b a. [b] -> [a] -> [a]
    drop [b]
    ys [a]
    xs) [a]
    xs

    {- |
    Check whether two lists with different element types have equal length.
    It holds

    prop> \(Shape xs) (List ys) -> equalLength xs ys == (length xs == length ys)

    but 'equalLength' is more efficient.
    -}
    equalLength :: [a] -> [b] -> Bool
    equalLength :: forall a b. [a] -> [b] -> Bool
    equalLength [a]
    xs [b]
    ys =
       [a] -> [()]
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void [a]
    xs [()] -> [()] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [b] -> [()]
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void [b]
    ys

    {- |
    Compare the length of two lists over different types.
    It holds

    prop> \(Shape xs) (List ys) -> compareLength xs ys == compare (length xs) (length ys)

    but 'compareLength' is more efficient.
    -}
    compareLength :: [a] -> [b] -> Ordering
    compareLength :: forall a b. [a] -> [b] -> Ordering
    compareLength [a]
    xs [b]
    ys =
       [()] -> [()] -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare ([a] -> [()]
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void [a]
    xs) ([b] -> [()]
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void [b]
    ys)

    {- | this one uses explicit recursion

    prop> \(Shape xs) (List ys) -> Match.compareLength xs ys == Match.compareLength0 xs ys
    -}
    compareLength0 :: [a] -> [b] -> Ordering
    compareLength0 :: forall a b. [a] -> [b] -> Ordering
    compareLength0 =
       let recourse :: [a] -> [a] -> Ordering
    recourse (a
    _:[a]
    xs) (a
    _:[a]
    ys) = [a] -> [a] -> Ordering
    recourse [a]
    xs [a]
    ys
           recourse []     []     = Ordering
    EQ
           recourse (a
    _:[a]
    _)  []     = Ordering
    GT
           recourse []     (a
    _:[a]
    _)  = Ordering
    LT
       in  [a] -> [b] -> Ordering
    forall a b. [a] -> [b] -> Ordering
    recourse

    {- | strict comparison

    prop> \(Shape xs) (List ys) -> Match.compareLength xs ys == Match.compareLength1 xs ys
    -}
    compareLength1 :: [a] -> [b] -> Ordering
    compareLength1 :: forall a b. [a] -> [b] -> Ordering
    compareLength1 [a]
    xs [b]
    ys =
       Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare ([a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs) ([b] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [b]
    ys)

    {- |
    @lessOrEqualLength x y@ is almost the same as @compareLength x y <= EQ@,
    but

    >>> lessOrEqualLength "" undefined
    True

    whereas @compareLength [] undefined <= EQ  =  undefined@.
    -}
    lessOrEqualLength :: [a] -> [b] -> Bool
    lessOrEqualLength :: forall a b. [a] -> [b] -> Bool
    lessOrEqualLength [] [b]
    _ = Bool
    True
    lessOrEqualLength [a]
    _ [] = Bool
    False
    lessOrEqualLength (a
    _:[a]
    xs) (b
    _:[b]
    ys) = [a] -> [b] -> Bool
    forall a b. [a] -> [b] -> Bool
    lessOrEqualLength [a]
    xs [b]
    ys

    {- |
    Returns the shorter one of two lists.
    It works also for infinite lists as much as possible.
    E.g.

    >>> shorterList (shorterList (repeat 'a') (repeat 'b')) "abc"
    "abc"

    The trick is, that the skeleton of the resulting list
    is constructed using 'zipWith' without touching the elements.
    The contents is then computed (only) if requested.
    -}
    shorterList :: [a] -> [a] -> [a]
    shorterList :: forall a. [a] -> [a] -> [a]
    shorterList [a]
    xs [a]
    ys =
       let useX :: Bool
    useX = [a] -> [a] -> Bool
    forall a b. [a] -> [b] -> Bool
    lessOrEqualLength [a]
    xs [a]
    ys
       in  (a -> a -> a) -> [a] -> [a] -> [a]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (Bool -> a -> a -> a
    forall a. Bool -> a -> a -> a
    if' Bool
    useX) [a]
    xs [a]
    ys

    {- |
    This is lazier than 'shorterList' in a different aspect:
    It returns a common prefix
    even if it is undefined, which list is the shorter one.
    However, it requires a proper 'Eq' instance
    and if elements are undefined, it may fail even earlier.

    >>> List.take 3 $ shorterListEq ("abc" ++ repeat 'a') ("abcdef" ++ repeat 'b')
    "abc"
    -}
    shorterListEq :: (Eq a) => [a] -> [a] -> [a]
    shorterListEq :: forall a. Eq a => [a] -> [a] -> [a]
    shorterListEq [a]
    xs [a]
    ys =
       let useX :: Bool
    useX = [a] -> [a] -> Bool
    forall a b. [a] -> [b] -> Bool
    lessOrEqualLength [a]
    xs [a]
    ys
       in  (a -> a -> a) -> [a] -> [a] -> [a]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\a
    x a
    y -> Bool -> a -> a -> a
    forall a. Bool -> a -> a -> a
    if' (a
    xa -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==a
    y Bool -> Bool -> Bool
    || Bool
    useX) a
    x a
    y) [a]
    xs [a]
    ys

    {- |
    Specialisation of 'Data.Functor.$>'.
    -}
    replicate :: [a] -> b -> [b]
    replicate :: forall a b. [a] -> b -> [b]
    replicate [a]
    xs b
    y =
       [a] -> [b] -> [b]
    forall b a. [b] -> [a] -> [a]
    take [a]
    xs (b -> [b]
    forall a. a -> [a]
    repeat b
    y)