module Data.NonEmpty.Class where

import qualified Data.Sequence as Seq
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Ix as Ix
import qualified Data.List.Key as Key
import qualified Data.List.HT as ListHT
import qualified Data.List as List
import qualified Control.DeepSeq as DeepSeq
import Data.Sequence (Seq, )
import Data.Map (Map, )
import Data.Set (Set, )
import Data.Traversable (Traversable, mapAccumL, mapAccumR)
import Control.Monad (liftM2, )
import Data.Tuple.HT (swap, )
import Data.Ord.HT (comparing, )

import qualified Test.QuickCheck as QC

import qualified Prelude as P
import Prelude hiding (Show, showsPrec, zipWith, zipWith3, reverse, )


class Empty f where
   empty :: f a

instance Empty [] where
   empty :: forall a. [a]
empty = []

instance Empty Maybe where
   empty :: forall a. Maybe a
empty = forall a. Maybe a
Nothing

instance Empty Set where
   empty :: forall a. Set a
empty = forall a. Set a
Set.empty

instance Empty (Map k) where
   empty :: forall a. Map k a
empty = forall k a. Map k a
Map.empty

instance Empty Seq where
   empty :: forall a. Seq a
empty = forall a. Seq a
Seq.empty


class Cons f where
   cons :: a -> f a -> f a

instance Cons [] where
   cons :: forall a. a -> [a] -> [a]
cons = (:)

instance Cons Seq where
   cons :: forall a. a -> Seq a -> Seq a
cons = forall a. a -> Seq a -> Seq a
(Seq.<|)


class Snoc f where
   snoc :: f a -> a -> f a

instance Snoc [] where
   snoc :: forall a. [a] -> a -> [a]
snoc = forall (f :: * -> *) a. (Cons f, Traversable f) => f a -> a -> f a
snocDefault

instance Snoc Seq where
   snoc :: forall a. Seq a -> a -> Seq a
snoc = forall a. Seq a -> a -> Seq a
(Seq.|>)

snocDefault :: (Cons f, Traversable f) => f a -> a -> f a
snocDefault :: forall (f :: * -> *) a. (Cons f, Traversable f) => f a -> a -> f a
snocDefault f a
xs a
x =
   forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (f :: * -> *) a. Cons f => a -> f a -> f a
cons forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumR (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)) a
x f a
xs


class ViewL f where
   viewL :: f a -> Maybe (a, f a)

instance ViewL [] where
   viewL :: forall a. [a] -> Maybe (a, [a])
viewL = forall a. [a] -> Maybe (a, [a])
ListHT.viewL

instance ViewL Maybe where
   viewL :: forall a. Maybe a -> Maybe (a, Maybe a)
viewL = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (a
a, forall a. Maybe a
Nothing))

instance ViewL Set where
   viewL :: forall a. Set a -> Maybe (a, Set a)
viewL = forall a. Set a -> Maybe (a, Set a)
Set.minView

instance ViewL Seq where
   viewL :: forall a. Seq a -> Maybe (a, Seq a)
viewL Seq a
x =
      case forall a. Seq a -> ViewL a
Seq.viewl Seq a
x of
         ViewL a
Seq.EmptyL -> forall a. Maybe a
Nothing
         a
y Seq.:< Seq a
ys -> forall a. a -> Maybe a
Just (a
y,Seq a
ys)
   -- viewL x = do y Seq.:< ys <- Just $ Seq.viewl x; Just (y,ys)


class ViewR f where
   viewR :: f a -> Maybe (f a, a)

instance ViewR [] where
   viewR :: forall a. [a] -> Maybe ([a], a)
viewR = forall a. [a] -> Maybe ([a], a)
ListHT.viewR

instance ViewR Maybe where
   viewR :: forall a. Maybe a -> Maybe (Maybe a, a)
viewR = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> (forall a. Maybe a
Nothing, a
a))

instance ViewR Set where
   viewR :: forall a. Set a -> Maybe (Set a, a)
viewR = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> Maybe (a, Set a)
Set.maxView

instance ViewR Seq where
   viewR :: forall a. Seq a -> Maybe (Seq a, a)
viewR Seq a
x =
      case forall a. Seq a -> ViewR a
Seq.viewr Seq a
x of
         ViewR a
Seq.EmptyR -> forall a. Maybe a
Nothing
         Seq a
ys Seq.:> a
y -> forall a. a -> Maybe a
Just (Seq a
ys,a
y)


class (ViewL f, ViewR f) => View f where
instance View [] where
instance View Maybe where
instance View Set where
instance View Seq where


{-
Default implementation of 'viewR' based on 'viewL' and 'Traversable'.
-}
viewRDefault :: (ViewL f, Traversable f) => f a -> Maybe (f a, a)
viewRDefault :: forall (f :: * -> *) a.
(ViewL f, Traversable f) =>
f a -> Maybe (f a, a)
viewRDefault =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. ViewL f => f a -> Maybe (a, f a)
viewL


class Singleton f where
   singleton :: a -> f a

instance Singleton [] where
   singleton :: forall a. a -> [a]
singleton a
x = [a
x]

instance Singleton Maybe where
   singleton :: forall a. a -> Maybe a
singleton a
x = forall a. a -> Maybe a
Just a
x

instance Singleton Set where
   singleton :: forall a. a -> Set a
singleton = forall a. a -> Set a
Set.singleton

instance Singleton Seq where
   singleton :: forall a. a -> Seq a
singleton = forall a. a -> Seq a
Seq.singleton


class Append f where
   append :: f a -> f a -> f a

instance Append [] where
   append :: forall a. [a] -> [a] -> [a]
append = forall a. [a] -> [a] -> [a]
(++)

instance Append Seq where
   append :: forall a. Seq a -> Seq a -> Seq a
append = forall a. Seq a -> Seq a -> Seq a
(Seq.><)

infixr 5 `cons`, `append`


{- |
It must hold:

> fmap f xs
>    = zipWith (\x _ -> f x) xs xs
>    = zipWith (\_ x -> f x) xs xs
-}
class Functor f => Zip f where
   zipWith :: (a -> b -> c) -> f a -> f b -> f c

instance Zip [] where
   zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith

instance Zip Maybe where
   zipWith :: forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
zipWith = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2

instance Zip Seq where
   zipWith :: forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith = forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith

zipWith3 :: (Zip f) => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
zipWith3 :: forall (f :: * -> *) a b c d.
Zip f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
zipWith3 a -> b -> c -> d
f f a
a f b
b f c
c = forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith forall a b. (a -> b) -> a -> b
($) (forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> b -> c -> d
f f a
a f b
b) f c
c

zipWith4 :: (Zip f) => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
zipWith4 :: forall (f :: * -> *) a b c d e.
Zip f =>
(a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
zipWith4 a -> b -> c -> d -> e
f f a
a f b
b f c
c f d
d = forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith forall a b. (a -> b) -> a -> b
($) (forall (f :: * -> *) a b c d.
Zip f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
zipWith3 a -> b -> c -> d -> e
f f a
a f b
b f c
c) f d
d

zip :: (Zip f) => f a -> f b -> f (a,b)
zip :: forall (f :: * -> *) a b. Zip f => f a -> f b -> f (a, b)
zip = forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith (,)

zip3 :: (Zip f) => f a -> f b -> f c -> f (a,b,c)
zip3 :: forall (f :: * -> *) a b c.
Zip f =>
f a -> f b -> f c -> f (a, b, c)
zip3 = forall (f :: * -> *) a b c d.
Zip f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
zipWith3 (,,)

zip4 :: (Zip f) => f a -> f b -> f c -> f d -> f (a,b,c,d)
zip4 :: forall (f :: * -> *) a b c d.
Zip f =>
f a -> f b -> f c -> f d -> f (a, b, c, d)
zip4 = forall (f :: * -> *) a b c d e.
Zip f =>
(a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
zipWith4 (,,,)


class Repeat f where
   {- |
   Create a container with as many copies as possible of a given value.
   That is, for a container with fixed size @n@,
   the call @repeat x@ will generate a container with @n@ copies of @x@.
   -}
   repeat :: a -> f a

instance Repeat [] where
   repeat :: forall a. a -> [a]
repeat = forall a. a -> [a]
List.repeat

instance Repeat Maybe where
   repeat :: forall a. a -> Maybe a
repeat = forall a. a -> Maybe a
Just


-- might be replaced by Mixed.iterate based on Traversable
class Repeat f => Iterate f where
   iterate :: (a -> a) -> a -> f a

instance Iterate [] where
   iterate :: forall a. (a -> a) -> a -> [a]
iterate = forall a. (a -> a) -> a -> [a]
List.iterate

instance Iterate Maybe where
   iterate :: forall a. (a -> a) -> a -> Maybe a
iterate a -> a
_ = forall a. a -> Maybe a
Just


{- |
We need to distinguish between 'Sort' and 'SortBy',
since there is an @instance Sort Set@
but there cannot be an @instance SortBy Set@.
-}
class Sort f where
   sort :: (Ord a) => f a -> f a

instance Sort [] where
   sort :: forall a. Ord a => [a] -> [a]
sort = forall a. Ord a => [a] -> [a]
List.sort

instance Sort Maybe where
   sort :: forall a. Ord a => Maybe a -> Maybe a
sort = forall a. a -> a
id

instance Sort Seq where
   sort :: forall a. Ord a => Seq a -> Seq a
sort = forall a. Ord a => Seq a -> Seq a
Seq.sort

instance Sort Set where
   sort :: forall a. Ord a => Set a -> Set a
sort = forall a. a -> a
id

{- |
Default implementation for 'sort' based on 'sortBy'.
-}
sortDefault :: (Ord a, SortBy f) => f a -> f a
sortDefault :: forall a (f :: * -> *). (Ord a, SortBy f) => f a -> f a
sortDefault = forall (f :: * -> *) a.
SortBy f =>
(a -> a -> Ordering) -> f a -> f a
sortBy forall a. Ord a => a -> a -> Ordering
compare


class Sort f => SortBy f where
   sortBy :: (a -> a -> Ordering) -> f a -> f a

instance SortBy [] where
   sortBy :: forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy = forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy

instance SortBy Maybe where
   sortBy :: forall a. (a -> a -> Ordering) -> Maybe a -> Maybe a
sortBy a -> a -> Ordering
_f = forall a. a -> a
id

instance SortBy Seq where
   sortBy :: forall a. (a -> a -> Ordering) -> Seq a -> Seq a
sortBy = forall a. (a -> a -> Ordering) -> Seq a -> Seq a
Seq.sortBy


class Sort f => SortKey f where
   sortKey :: (Ord b) => (a -> b) -> f a -> f a

instance SortKey [] where
   sortKey :: forall b a. Ord b => (a -> b) -> [a] -> [a]
sortKey = forall b a. Ord b => (a -> b) -> [a] -> [a]
Key.sort

instance SortKey Maybe where
   sortKey :: forall b a. Ord b => (a -> b) -> Maybe a -> Maybe a
sortKey a -> b
_f = forall a. a -> a
id

instance SortKey Seq where
   sortKey :: forall b a. Ord b => (a -> b) -> Seq a -> Seq a
sortKey = forall (f :: * -> *) b a.
(SortBy f, Functor f, Ord b) =>
(a -> b) -> f a -> f a
sortKeyGen

sortKeyGen :: (SortBy f, Functor f, Ord b) => (a -> b) -> f a -> f a
sortKeyGen :: forall (f :: * -> *) b a.
(SortBy f, Functor f, Ord b) =>
(a -> b) -> f a -> f a
sortKeyGen a -> b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
SortBy f =>
(a -> a -> Ordering) -> f a -> f a
sortBy (forall b a. Ord b => (a -> b) -> a -> a -> Ordering
comparing forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> (a -> b
f a
x, a
x))


class Reverse f where
   reverse :: f a -> f a

instance Reverse [] where reverse :: forall a. [a] -> [a]
reverse = forall a. [a] -> [a]
List.reverse
instance Reverse Maybe where reverse :: forall a. Maybe a -> Maybe a
reverse = forall a. a -> a
id
instance Reverse Seq where reverse :: forall a. Seq a -> Seq a
reverse = forall a. Seq a -> Seq a
Seq.reverse


class Show f where
   showsPrec :: P.Show a => Int -> f a -> ShowS

instance Show [] where
   showsPrec :: forall a. Show a => Int -> [a] -> ShowS
showsPrec Int
p [a]
xs =
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs
        then String -> ShowS
showString String
"[]"
        else Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
5) forall a b. (a -> b) -> a -> b
$
             forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (String -> ShowS
showString String
"[]") forall a b. (a -> b) -> a -> b
$
             forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> forall a. Show a => Int -> a -> ShowS
P.showsPrec Int
6 a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
":") [a]
xs

instance Show Maybe where
   showsPrec :: forall a. Show a => Int -> Maybe a -> ShowS
showsPrec = forall a. Show a => Int -> a -> ShowS
P.showsPrec

instance Show Seq where
   showsPrec :: forall a. Show a => Int -> Seq a -> ShowS
showsPrec = forall a. Show a => Int -> a -> ShowS
P.showsPrec

instance Show Set where
   showsPrec :: forall a. Show a => Int -> Set a -> ShowS
showsPrec = forall a. Show a => Int -> a -> ShowS
P.showsPrec


class Arbitrary f where
   arbitrary :: QC.Arbitrary a => QC.Gen (f a)
   shrink :: QC.Arbitrary a => f a -> [f a]

instance Arbitrary [] where
   arbitrary :: forall a. Arbitrary a => Gen [a]
arbitrary = forall a. Arbitrary a => Gen a
QC.arbitrary
   shrink :: forall a. Arbitrary a => [a] -> [[a]]
shrink = forall a. Arbitrary a => a -> [a]
QC.shrink

instance Arbitrary Seq where
   arbitrary :: forall a. Arbitrary a => Gen (Seq a)
arbitrary = forall a. Arbitrary a => Gen a
QC.arbitrary
   shrink :: forall a. Arbitrary a => Seq a -> [Seq a]
shrink = forall a. Arbitrary a => a -> [a]
QC.shrink

instance Arbitrary Maybe where
   arbitrary :: forall a. Arbitrary a => Gen (Maybe a)
arbitrary = forall a. Arbitrary a => Gen a
QC.arbitrary
   shrink :: forall a. Arbitrary a => Maybe a -> [Maybe a]
shrink = forall a. Arbitrary a => a -> [a]
QC.shrink

instance (QC.Arbitrary k, Ord k) => Arbitrary (Map k) where
   arbitrary :: forall a. Arbitrary a => Gen (Map k a)
arbitrary = forall a. Arbitrary a => Gen a
QC.arbitrary
   shrink :: forall a. Arbitrary a => Map k a -> [Map k a]
shrink = forall a. Arbitrary a => a -> [a]
QC.shrink


class (Arbitrary f) => Gen f where
   genOf :: QC.Gen a -> QC.Gen (f a)

instance Gen [] where
   genOf :: forall a. Gen a -> Gen [a]
genOf = forall a. Gen a -> Gen [a]
QC.listOf

instance Gen Seq where
   genOf :: forall a. Gen a -> Gen (Seq a)
genOf = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> Seq a
Seq.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Gen a -> Gen [a]
QC.listOf

instance Gen Maybe where
   genOf :: forall a. Gen a -> Gen (Maybe a)
genOf Gen a
gen = do
      Bool
b <- forall a. Arbitrary a => Gen a
QC.arbitrary
      if Bool
b then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just Gen a
gen else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

instance (QC.Arbitrary k, Ord k) => Gen (Map k) where
   genOf :: forall a. Gen a -> Gen (Map k a)
genOf Gen a
gen =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\k
k -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) k
k) Gen a
gen) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Arbitrary a => Gen a
QC.arbitrary


class NFData f where
   rnf :: DeepSeq.NFData a => f a -> ()

instance NFData Maybe where
   rnf :: forall a. NFData a => Maybe a -> ()
rnf = forall a. NFData a => a -> ()
DeepSeq.rnf

instance NFData [] where
   rnf :: forall a. NFData a => [a] -> ()
rnf = forall a. NFData a => a -> ()
DeepSeq.rnf

instance NFData Set where
   rnf :: forall a. NFData a => Set a -> ()
rnf = forall a. NFData a => a -> ()
DeepSeq.rnf

instance (DeepSeq.NFData k) => NFData (Map k) where
   rnf :: forall a. NFData a => Map k a -> ()
rnf = forall a. NFData a => a -> ()
DeepSeq.rnf


class Ix f where
   {-# MINIMAL range, (index | indexHorner), inRange #-}
   range :: (Ix.Ix i) => (f i, f i) -> [f i]
   index :: (Ix.Ix i) => (f i, f i) -> f i -> Int
   index =
      if Bool
True
         then forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) i.
(Ix f, Ix i) =>
(f i, f i) -> Int -> f i -> Int
indexHorner Int
0
         else forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) i.
(Ix f, Ix i) =>
(f i, f i) -> (Int, f i -> Int)
rangeSizeIndex
   inRange :: (Ix.Ix i) => (f i, f i) -> f i -> Bool
   rangeSize :: (Ix.Ix i) => (f i, f i) -> Int
   rangeSize b :: (f i, f i)
b@(f i
_l,f i
h) = if forall (f :: * -> *) i. (Ix f, Ix i) => (f i, f i) -> f i -> Bool
inRange (f i, f i)
b f i
h then forall (f :: * -> *) i. (Ix f, Ix i) => (f i, f i) -> f i -> Int
index (f i, f i)
b f i
h forall a. Num a => a -> a -> a
+ Int
1 else Int
0
   {- |
   The default implementation causes quadratic runtime
   on nested index tuple types.
   This affects the 'index' function, too.
   -}
   rangeSizeIndex :: (Ix.Ix i) => (f i, f i) -> (Int, f i -> Int)
   rangeSizeIndex (f i, f i)
b = (forall (f :: * -> *) i. (Ix f, Ix i) => (f i, f i) -> Int
rangeSize (f i, f i)
b, forall (f :: * -> *) i. (Ix f, Ix i) => (f i, f i) -> f i -> Int
index (f i, f i)
b)
   {- |
   A custom implementation of this function
   allows for an even more efficient implementation
   of 'index' on nested NonEmpty constructors.
   -}
   indexHorner :: (Ix.Ix i) => (f i, f i) -> Int -> f i -> Int
   indexHorner (f i, f i)
b =
      let size :: Int
size = forall (f :: * -> *) i. (Ix f, Ix i) => (f i, f i) -> Int
rangeSize (f i, f i)
b
      in \Int
offset f i
i -> Int
offset forall a. Num a => a -> a -> a
* Int
size forall a. Num a => a -> a -> a
+ forall (f :: * -> *) i. (Ix f, Ix i) => (f i, f i) -> f i -> Int
index (f i, f i)
b f i
i