{- |
Generalized version of utility-ht:"Data.List.Match".
-}
module Data.NonEmpty.Match (take, replicate) where

import qualified Data.NonEmpty.Class as C

import Control.Functor.HT (void, )

import Prelude hiding (take, replicate, )


{- | Make a list as long as another one -}
{-
@flip (zipWith const)@ is not as lazy,
e.g. would be @take [] undefined = undefined@,
but it should be @take [] undefined = []@.
-}
take :: (C.Zip f) => f b -> f a -> f a
take :: forall (f :: * -> *) b a. Zip f => f b -> f a -> f a
take = forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
C.zipWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> b -> a
const)


{- |
Check whether two lists with different element types have equal length.
It is equivalent to @length xs == length ys@ but more efficient.
-}
{-
I'd prefer a type constructor class Eq
-}
_equalLength :: (Functor f, Eq (f ())) => f a -> f b -> Bool
_equalLength :: forall (f :: * -> *) a b.
(Functor f, Eq (f ())) =>
f a -> f b -> Bool
_equalLength f a
xs f b
ys =
   forall (f :: * -> *) a. Functor f => f a -> f ()
void f a
xs forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a. Functor f => f a -> f ()
void f b
ys

{- |
Compare the length of two lists over different types.
It is equivalent to @(compare (length xs) (length ys))@
but more efficient.
-}
{-
I'd prefer a type constructor class Ord
-}
_compareLength :: (Functor f, Ord (f ())) => f a -> f b -> Ordering
_compareLength :: forall (f :: * -> *) a b.
(Functor f, Ord (f ())) =>
f a -> f b -> Ordering
_compareLength f a
xs f b
ys =
   forall a. Ord a => a -> a -> Ordering
compare (forall (f :: * -> *) a. Functor f => f a -> f ()
void f a
xs) (forall (f :: * -> *) a. Functor f => f a -> f ()
void f b
ys)


{- |
the same as @($>)@
-}
replicate :: (Functor f) => f a -> b -> f b
replicate :: forall (f :: * -> *) a b. Functor f => f a -> b -> f b
replicate f a
xs b
y = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const b
y) f a
xs