{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

module Data.List.NonNonEmpty where

import Control.Lens
    ( Each, Reversing(..), Lens' )
import Data.Data ( Data )
import Data.List.NonEmpty ( NonEmpty((:|)) )
import qualified Data.List.NonEmpty as NonEmpty
import Data.Functor ( Functor(fmap), (<$>) )
import Data.Functor.Apply ( Apply((<.>)) )
import Data.Functor.Bind ( Bind((>>-)) )
import Data.Functor.Classes
    ( Eq1(..), Ord1(..), Show1(liftShowsPrec) )
import Data.Semigroup.Foldable ( Foldable1(foldMap1, toNonEmpty) )
import Data.Semigroup.Traversable ( Traversable1(traverse1) )
import GHC.Generics ( Generic, Generic1 )

data NonNonEmpty a =
  NonNonEmpty a (NonEmpty a)
  deriving (NonNonEmpty a -> NonNonEmpty a -> Bool
(NonNonEmpty a -> NonNonEmpty a -> Bool)
-> (NonNonEmpty a -> NonNonEmpty a -> Bool) -> Eq (NonNonEmpty a)
forall a. Eq a => NonNonEmpty a -> NonNonEmpty a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => NonNonEmpty a -> NonNonEmpty a -> Bool
== :: NonNonEmpty a -> NonNonEmpty a -> Bool
$c/= :: forall a. Eq a => NonNonEmpty a -> NonNonEmpty a -> Bool
/= :: NonNonEmpty a -> NonNonEmpty a -> Bool
Eq, Eq (NonNonEmpty a)
Eq (NonNonEmpty a) =>
(NonNonEmpty a -> NonNonEmpty a -> Ordering)
-> (NonNonEmpty a -> NonNonEmpty a -> Bool)
-> (NonNonEmpty a -> NonNonEmpty a -> Bool)
-> (NonNonEmpty a -> NonNonEmpty a -> Bool)
-> (NonNonEmpty a -> NonNonEmpty a -> Bool)
-> (NonNonEmpty a -> NonNonEmpty a -> NonNonEmpty a)
-> (NonNonEmpty a -> NonNonEmpty a -> NonNonEmpty a)
-> Ord (NonNonEmpty a)
NonNonEmpty a -> NonNonEmpty a -> Bool
NonNonEmpty a -> NonNonEmpty a -> Ordering
NonNonEmpty a -> NonNonEmpty a -> NonNonEmpty 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 (NonNonEmpty a)
forall a. Ord a => NonNonEmpty a -> NonNonEmpty a -> Bool
forall a. Ord a => NonNonEmpty a -> NonNonEmpty a -> Ordering
forall a. Ord a => NonNonEmpty a -> NonNonEmpty a -> NonNonEmpty a
$ccompare :: forall a. Ord a => NonNonEmpty a -> NonNonEmpty a -> Ordering
compare :: NonNonEmpty a -> NonNonEmpty a -> Ordering
$c< :: forall a. Ord a => NonNonEmpty a -> NonNonEmpty a -> Bool
< :: NonNonEmpty a -> NonNonEmpty a -> Bool
$c<= :: forall a. Ord a => NonNonEmpty a -> NonNonEmpty a -> Bool
<= :: NonNonEmpty a -> NonNonEmpty a -> Bool
$c> :: forall a. Ord a => NonNonEmpty a -> NonNonEmpty a -> Bool
> :: NonNonEmpty a -> NonNonEmpty a -> Bool
$c>= :: forall a. Ord a => NonNonEmpty a -> NonNonEmpty a -> Bool
>= :: NonNonEmpty a -> NonNonEmpty a -> Bool
$cmax :: forall a. Ord a => NonNonEmpty a -> NonNonEmpty a -> NonNonEmpty a
max :: NonNonEmpty a -> NonNonEmpty a -> NonNonEmpty a
$cmin :: forall a. Ord a => NonNonEmpty a -> NonNonEmpty a -> NonNonEmpty a
min :: NonNonEmpty a -> NonNonEmpty a -> NonNonEmpty a
Ord, Int -> NonNonEmpty a -> ShowS
[NonNonEmpty a] -> ShowS
NonNonEmpty a -> String
(Int -> NonNonEmpty a -> ShowS)
-> (NonNonEmpty a -> String)
-> ([NonNonEmpty a] -> ShowS)
-> Show (NonNonEmpty a)
forall a. Show a => Int -> NonNonEmpty a -> ShowS
forall a. Show a => [NonNonEmpty a] -> ShowS
forall a. Show a => NonNonEmpty a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> NonNonEmpty a -> ShowS
showsPrec :: Int -> NonNonEmpty a -> ShowS
$cshow :: forall a. Show a => NonNonEmpty a -> String
show :: NonNonEmpty a -> String
$cshowList :: forall a. Show a => [NonNonEmpty a] -> ShowS
showList :: [NonNonEmpty a] -> ShowS
Show)

deriving instance Data a => Data (NonNonEmpty a)
deriving instance Generic (NonNonEmpty a)
deriving instance Generic1 NonNonEmpty

instance Eq1 NonNonEmpty where
  liftEq :: forall a b.
(a -> b -> Bool) -> NonNonEmpty a -> NonNonEmpty b -> Bool
liftEq a -> b -> Bool
eq (NonNonEmpty a
h1 NonEmpty a
t1) (NonNonEmpty b
h2 NonEmpty b
t2) =
    a -> b -> Bool
eq a
h1 b
h2 Bool -> Bool -> Bool
&& (a -> b -> Bool) -> NonEmpty a -> NonEmpty b -> Bool
forall a b. (a -> b -> Bool) -> NonEmpty a -> NonEmpty b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq NonEmpty a
t1 NonEmpty b
t2

instance Ord1 NonNonEmpty where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> NonNonEmpty a -> NonNonEmpty b -> Ordering
liftCompare a -> b -> Ordering
cmp (NonNonEmpty a
h1 NonEmpty a
t1) (NonNonEmpty b
h2 NonEmpty b
t2) =
    a -> b -> Ordering
cmp a
h1 b
h2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (a -> b -> Ordering) -> NonEmpty a -> NonEmpty b -> Ordering
forall a b.
(a -> b -> Ordering) -> NonEmpty a -> NonEmpty b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp NonEmpty a
t1 NonEmpty b
t2

instance Show1 NonNonEmpty where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> NonNonEmpty a -> ShowS
liftShowsPrec Int -> a -> ShowS
shwP [a] -> ShowS
shwL Int
p (NonNonEmpty a
h NonEmpty a
t) =
    String -> ShowS
showString String
"NonNonEmpty " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
shwP Int
6 a
h ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NonEmpty a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NonEmpty a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
shwP [a] -> ShowS
shwL Int
p NonEmpty a
t

instance Semigroup (NonNonEmpty a) where
  NonNonEmpty a
h1 NonEmpty a
t1 <> :: NonNonEmpty a -> NonNonEmpty a -> NonNonEmpty a
<> NonNonEmpty a
h2 NonEmpty a
t2 =
     a -> NonEmpty a -> NonNonEmpty a
forall a. a -> NonEmpty a -> NonNonEmpty a
NonNonEmpty a
h1 (NonEmpty a
t1 NonEmpty a -> NonEmpty a -> NonEmpty a
forall a. Semigroup a => a -> a -> a
<> a -> NonEmpty a -> NonEmpty a
forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.cons a
h2 NonEmpty a
t2)

instance Functor NonNonEmpty where
  fmap :: forall a b. (a -> b) -> NonNonEmpty a -> NonNonEmpty b
fmap a -> b
f (NonNonEmpty a
h NonEmpty a
t) =
    b -> NonEmpty b -> NonNonEmpty b
forall a. a -> NonEmpty a -> NonNonEmpty a
NonNonEmpty (a -> b
f a
h) ((a -> b) -> NonEmpty a -> NonEmpty b
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f NonEmpty a
t)

instance Foldable NonNonEmpty where
  foldMap :: forall m a. Monoid m => (a -> m) -> NonNonEmpty a -> m
foldMap a -> m
f (NonNonEmpty a
h NonEmpty a
t) =
    a -> m
f a
h m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> NonEmpty a -> m
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f NonEmpty a
t

instance Foldable1 NonNonEmpty where
  foldMap1 :: forall m a. Semigroup m => (a -> m) -> NonNonEmpty a -> m
foldMap1 a -> m
f (NonNonEmpty a
h NonEmpty a
ts) =
    a -> m
f a
h m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> NonEmpty a -> m
forall m a. Semigroup m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f NonEmpty a
ts

instance Traversable NonNonEmpty where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonNonEmpty a -> f (NonNonEmpty b)
traverse a -> f b
f (NonNonEmpty a
h NonEmpty a
t) =
    b -> NonEmpty b -> NonNonEmpty b
forall a. a -> NonEmpty a -> NonNonEmpty a
NonNonEmpty (b -> NonEmpty b -> NonNonEmpty b)
-> f b -> f (NonEmpty b -> NonNonEmpty b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
h f (NonEmpty b -> NonNonEmpty b)
-> f (NonEmpty b) -> f (NonNonEmpty b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> NonEmpty a -> f (NonEmpty b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse a -> f b
f NonEmpty a
t

instance Traversable1 NonNonEmpty where
  traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> NonNonEmpty a -> f (NonNonEmpty b)
traverse1 a -> f b
f (NonNonEmpty a
h NonEmpty a
t) =
    b -> NonEmpty b -> NonNonEmpty b
forall a. a -> NonEmpty a -> NonNonEmpty a
NonNonEmpty (b -> NonEmpty b -> NonNonEmpty b)
-> f b -> f (NonEmpty b -> NonNonEmpty b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
h f (NonEmpty b -> NonNonEmpty b)
-> f (NonEmpty b) -> f (NonNonEmpty b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> (a -> f b) -> NonEmpty a -> f (NonEmpty b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse1 a -> f b
f NonEmpty a
t

instance Apply NonNonEmpty where
  <.> :: forall a b. NonNonEmpty (a -> b) -> NonNonEmpty a -> NonNonEmpty b
(<.>) =
    NonNonEmpty (a -> b) -> NonNonEmpty a -> NonNonEmpty b
forall a b. NonNonEmpty (a -> b) -> NonNonEmpty a -> NonNonEmpty b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

instance Applicative NonNonEmpty where
  NonNonEmpty a -> b
hf NonEmpty (a -> b)
tf <*> :: forall a b. NonNonEmpty (a -> b) -> NonNonEmpty a -> NonNonEmpty b
<*> NonNonEmpty a
hx NonEmpty a
tx =
    b -> NonEmpty b -> NonNonEmpty b
forall a. a -> NonEmpty a -> NonNonEmpty a
NonNonEmpty (a -> b
hf a
hx) (NonEmpty (a -> b)
tf NonEmpty (a -> b) -> NonEmpty a -> NonEmpty b
forall a b. NonEmpty (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NonEmpty a
tx)
  pure :: forall a. a -> NonNonEmpty a
pure =
    a -> NonNonEmpty a
forall a. a -> NonNonEmpty a
forall (m :: * -> *) a. Monad m => a -> m a
return

instance Bind NonNonEmpty where
  >>- :: forall a b. NonNonEmpty a -> (a -> NonNonEmpty b) -> NonNonEmpty b
(>>-) =
    NonNonEmpty a -> (a -> NonNonEmpty b) -> NonNonEmpty b
forall a b. NonNonEmpty a -> (a -> NonNonEmpty b) -> NonNonEmpty b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)

instance Monad NonNonEmpty where
  NonNonEmpty a
h NonEmpty a
t >>= :: forall a b. NonNonEmpty a -> (a -> NonNonEmpty b) -> NonNonEmpty b
>>= a -> NonNonEmpty b
f =
    a -> NonNonEmpty b
f a
h NonNonEmpty b -> NonNonEmpty b -> NonNonEmpty b
forall a. Semigroup a => a -> a -> a
<> (a -> NonNonEmpty b) -> NonEmpty a -> NonNonEmpty b
forall m a. Semigroup m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> NonNonEmpty b
f NonEmpty a
t
  return :: forall a. a -> NonNonEmpty a
return a
a =
    a -> NonEmpty a -> NonNonEmpty a
forall a. a -> NonEmpty a -> NonNonEmpty a
NonNonEmpty a
a (a -> NonEmpty a
forall a. a -> NonEmpty a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a)

head ::
  Lens'
    (NonNonEmpty a)
    a
head :: forall a (f :: * -> *).
Functor f =>
(a -> f a) -> NonNonEmpty a -> f (NonNonEmpty a)
head a -> f a
f (NonNonEmpty a
h NonEmpty a
t) =
  (a -> NonNonEmpty a) -> f a -> f (NonNonEmpty a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
h' -> a -> NonEmpty a -> NonNonEmpty a
forall a. a -> NonEmpty a -> NonNonEmpty a
NonNonEmpty a
h' NonEmpty a
t) (a -> f a
f a
h)

tail ::
  Lens'
    (NonNonEmpty a)
    (NonEmpty a)
tail :: forall a (f :: * -> *).
Functor f =>
(NonEmpty a -> f (NonEmpty a))
-> NonNonEmpty a -> f (NonNonEmpty a)
tail NonEmpty a -> f (NonEmpty a)
f (NonNonEmpty a
h NonEmpty a
t) =
  (NonEmpty a -> NonNonEmpty a)
-> f (NonEmpty a) -> f (NonNonEmpty a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> NonEmpty a -> NonNonEmpty a
forall a. a -> NonEmpty a -> NonNonEmpty a
NonNonEmpty a
h) (NonEmpty a -> f (NonEmpty a)
f NonEmpty a
t)

head2 ::
  Lens'
    (NonNonEmpty a)
    (a, a)
head2 :: forall a (f :: * -> *).
Functor f =>
((a, a) -> f (a, a)) -> NonNonEmpty a -> f (NonNonEmpty a)
head2 (a, a) -> f (a, a)
f (NonNonEmpty a
h1 (a
h2 :| [a]
t)) =
  ((a, a) -> NonNonEmpty a) -> f (a, a) -> f (NonNonEmpty a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
h1', a
h2') -> a -> NonEmpty a -> NonNonEmpty a
forall a. a -> NonEmpty a -> NonNonEmpty a
NonNonEmpty a
h1' (a
h2' a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
t)) ((a, a) -> f (a, a)
f (a
h1, a
h2))

tail2 ::
  Lens'
    (NonNonEmpty a)
    [a]
tail2 :: forall a (f :: * -> *).
Functor f =>
([a] -> f [a]) -> NonNonEmpty a -> f (NonNonEmpty a)
tail2 [a] -> f [a]
f (NonNonEmpty a
h1 (a
h2 :| [a]
t)) =
  ([a] -> NonNonEmpty a) -> f [a] -> f (NonNonEmpty a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[a]
t' -> a -> NonEmpty a -> NonNonEmpty a
forall a. a -> NonEmpty a -> NonNonEmpty a
NonNonEmpty a
h1 (a
h2 a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
t')) ([a] -> f [a]
f [a]
t)

instance Reversing (NonNonEmpty a) where
  reversing :: NonNonEmpty a -> NonNonEmpty a
reversing NonNonEmpty a
x =
    let a
h1 :| (a
h2 : [a]
tt) = NonEmpty a -> NonEmpty a
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse (NonNonEmpty a -> NonEmpty a
forall a. NonNonEmpty a -> NonEmpty a
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty NonNonEmpty a
x)
    in  a -> NonEmpty a -> NonNonEmpty a
forall a. a -> NonEmpty a -> NonNonEmpty a
NonNonEmpty a
h1 (a
h2 a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
tt)

instance Each (NonNonEmpty a) (NonNonEmpty b) a b where