module Data.Optional (
   T(Nil, Cons),
   (?:),
   fromEmpty,
   fromNonEmpty,
   ) where

import qualified Data.NonEmpty.Class as C
import qualified Data.NonEmpty as NonEmpty
import qualified Data.Empty as Empty
import Data.NonEmptyPrivate (Aux(Aux), snoc)

import qualified Data.Traversable as Trav
import qualified Data.Foldable as Fold
import Control.Applicative (pure, liftA2, )
import Control.DeepSeq (NFData, rnf, )

import qualified Test.QuickCheck as QC

import Control.Monad (return, )
import Data.Functor (fmap, )
import Data.Function (($), (.), )
import Data.Ord (Ord, Ordering(GT), (>), )
import qualified Prelude as P
import Prelude (Eq, uncurry, )


data T f a = Nil | Cons a (f a)
   deriving (T f a -> T f a -> Bool
(T f a -> T f a -> Bool) -> (T f a -> T f a -> Bool) -> Eq (T f a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a. (Eq a, Eq (f a)) => T f a -> T f a -> Bool
/= :: T f a -> T f a -> Bool
$c/= :: forall (f :: * -> *) a. (Eq a, Eq (f a)) => T f a -> T f a -> Bool
== :: T f a -> T f a -> Bool
$c== :: forall (f :: * -> *) a. (Eq a, Eq (f a)) => T f a -> T f a -> Bool
Eq, Eq (T f a)
Eq (T f a)
-> (T f a -> T f a -> Ordering)
-> (T f a -> T f a -> Bool)
-> (T f a -> T f a -> Bool)
-> (T f a -> T f a -> Bool)
-> (T f a -> T f a -> Bool)
-> (T f a -> T f a -> T f a)
-> (T f a -> T f a -> T f a)
-> Ord (T f a)
T f a -> T f a -> Bool
T f a -> T f a -> Ordering
T f a -> T f a -> T f 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 (f :: * -> *) a. (Ord a, Ord (f a)) => Eq (T f a)
forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
T f a -> T f a -> Bool
forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
T f a -> T f a -> Ordering
forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
T f a -> T f a -> T f a
min :: T f a -> T f a -> T f a
$cmin :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
T f a -> T f a -> T f a
max :: T f a -> T f a -> T f a
$cmax :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
T f a -> T f a -> T f a
>= :: T f a -> T f a -> Bool
$c>= :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
T f a -> T f a -> Bool
> :: T f a -> T f a -> Bool
$c> :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
T f a -> T f a -> Bool
<= :: T f a -> T f a -> Bool
$c<= :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
T f a -> T f a -> Bool
< :: T f a -> T f a -> Bool
$c< :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
T f a -> T f a -> Bool
compare :: T f a -> T f a -> Ordering
$ccompare :: forall (f :: * -> *) a.
(Ord a, Ord (f a)) =>
T f a -> T f a -> Ordering
$cp1Ord :: forall (f :: * -> *) a. (Ord a, Ord (f a)) => Eq (T f a)
Ord)

fromEmpty :: Empty.T a -> T f a
fromEmpty :: T a -> T f a
fromEmpty T a
Empty.Cons = T f a
forall (f :: * -> *) a. T f a
Nil

fromNonEmpty :: NonEmpty.T f a -> T f a
fromNonEmpty :: T f a -> T f a
fromNonEmpty (NonEmpty.Cons a
x f a
xs) = a -> f a -> T f a
forall (f :: * -> *) a. a -> f a -> T f a
Cons a
x f a
xs


instance (C.NFData f, NFData a) => NFData (T f a) where
   rnf :: T f a -> ()
rnf = T f a -> ()
forall (f :: * -> *) a. (NFData f, NFData a) => f a -> ()
C.rnf

instance (C.NFData f) => C.NFData (T f) where
   rnf :: T f a -> ()
rnf T f a
Nil = ()
   rnf (Cons a
x f a
xs) = (a, ()) -> ()
forall a. NFData a => a -> ()
rnf (a
x, f a -> ()
forall (f :: * -> *) a. (NFData f, NFData a) => f a -> ()
C.rnf f a
xs)


instance (C.Show f, P.Show a) => P.Show (T f a) where
   showsPrec :: Int -> T f a -> ShowS
showsPrec = Int -> T f a -> ShowS
forall (f :: * -> *) a. (Show f, Show a) => Int -> f a -> ShowS
C.showsPrec

instance (C.Show f) => C.Show (T f) where
   showsPrec :: Int -> T f a -> ShowS
showsPrec Int
_ T f a
Nil = String -> ShowS
P.showString String
"Nil"
   showsPrec Int
p (Cons a
x f a
xs) =
      Bool -> ShowS -> ShowS
P.showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
5) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
P.showsPrec Int
6 a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
P.showString String
"?:" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f a -> ShowS
forall (f :: * -> *) a. (Show f, Show a) => Int -> f a -> ShowS
C.showsPrec Int
5 f a
xs


infixr 5 ?:

(?:) :: a -> f a -> T f a
?: :: a -> f a -> T f a
(?:) = a -> f a -> T f a
forall (f :: * -> *) a. a -> f a -> T f a
Cons


instance P.Functor f => P.Functor (T f) where
   fmap :: (a -> b) -> T f a -> T f b
fmap a -> b
_ T f a
Nil = T f b
forall (f :: * -> *) a. T f a
Nil
   fmap a -> b
f (Cons a
x f a
xs) = b -> f b -> T f b
forall (f :: * -> *) a. a -> f a -> T f a
Cons (a -> b
f a
x) ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
xs)

instance (Fold.Foldable f) => Fold.Foldable (T f) where
   foldr :: (a -> b -> b) -> b -> T f a -> b
foldr a -> b -> b
_ b
y T f a
Nil = b
y
   foldr a -> b -> b
f b
y (Cons a
x f a
xs) = a -> b -> b
f a
x ((a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Fold.foldr a -> b -> b
f b
y f a
xs)

instance (Trav.Traversable f) => Trav.Traversable (T f) where
   sequenceA :: T f (f a) -> f (T f a)
sequenceA T f (f a)
Nil = T f a -> f (T f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure T f a
forall (f :: * -> *) a. T f a
Nil
   sequenceA (Cons f a
x f (f a)
xs) = (a -> f a -> T f a) -> f a -> f (f a) -> f (T f a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> f a -> T f a
forall (f :: * -> *) a. a -> f a -> T f a
Cons f a
x (f (f a) -> f (f a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
Trav.sequenceA f (f a)
xs)


instance (C.Arbitrary f, QC.Arbitrary a) => QC.Arbitrary (T f a) where
   arbitrary :: Gen (T f a)
arbitrary = Gen (T f a)
forall (f :: * -> *) a. (Arbitrary f, Arbitrary a) => Gen (T f a)
arbitrary
   shrink :: T f a -> [T f a]
shrink = T f a -> [T f a]
forall (f :: * -> *) a.
(Arbitrary f, Arbitrary a) =>
T f a -> [T f a]
shrink

instance (C.Arbitrary f) => C.Arbitrary (T f) where
   arbitrary :: Gen (T f a)
arbitrary = Gen (T f a)
forall (f :: * -> *) a. (Arbitrary f, Arbitrary a) => Gen (T f a)
arbitrary
   shrink :: T f a -> [T f a]
shrink = T f a -> [T f a]
forall (f :: * -> *) a.
(Arbitrary f, Arbitrary a) =>
T f a -> [T f a]
shrink

arbitrary :: (C.Arbitrary f, QC.Arbitrary a) => QC.Gen (T f a)
arbitrary :: Gen (T f a)
arbitrary = [Gen (T f a)] -> Gen (T f a)
forall a. [Gen a] -> Gen a
QC.oneof [T f a -> Gen (T f a)
forall (m :: * -> *) a. Monad m => a -> m a
return T f a
forall (f :: * -> *) a. T f a
Nil, (a -> f a -> T f a) -> Gen a -> Gen (f a) -> Gen (T f a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> f a -> T f a
forall (f :: * -> *) a. a -> f a -> T f a
Cons Gen a
forall a. Arbitrary a => Gen a
QC.arbitrary Gen (f a)
forall (f :: * -> *) a. (Arbitrary f, Arbitrary a) => Gen (f a)
C.arbitrary]

shrink :: (C.Arbitrary f, QC.Arbitrary a) => T f a -> [T f a]
shrink :: T f a -> [T f a]
shrink T f a
Nil = []
shrink (Cons a
x f a
xs) = ((a, Aux f a) -> T f a) -> [(a, Aux f a)] -> [T f a]
forall a b. (a -> b) -> [a] -> [b]
P.map (\(a
y, Aux f a
ys) -> a -> f a -> T f a
forall (f :: * -> *) a. a -> f a -> T f a
Cons a
y f a
ys) ((a, Aux f a) -> [(a, Aux f a)]
forall a. Arbitrary a => a -> [a]
QC.shrink (a
x, f a -> Aux f a
forall (f :: * -> *) a. f a -> Aux f a
Aux f a
xs))

instance (C.Gen f) => C.Gen (T f) where
   genOf :: Gen a -> Gen (T f a)
genOf Gen a
gen = do
      Bool
b <- Gen Bool
forall a. Arbitrary a => Gen a
QC.arbitrary
      if Bool
b then (a -> f a -> T f a) -> Gen a -> Gen (f a) -> Gen (T f a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> f a -> T f a
forall (f :: * -> *) a. a -> f a -> T f a
Cons Gen a
gen (Gen (f a) -> Gen (T f a)) -> Gen (f a) -> Gen (T f a)
forall a b. (a -> b) -> a -> b
$ Gen a -> Gen (f a)
forall (f :: * -> *) a. Gen f => Gen a -> Gen (f a)
C.genOf Gen a
gen else T f a -> Gen (T f a)
forall (m :: * -> *) a. Monad m => a -> m a
return T f a
forall (f :: * -> *) a. T f a
Nil


instance C.Empty (T f) where
   empty :: T f a
empty = T f a
forall (f :: * -> *) a. T f a
Nil

instance (C.Cons f, C.Empty f) => C.Cons (T f) where
   cons :: a -> T f a -> T f a
cons a
x T f a
Nil = a -> f a -> T f a
forall (f :: * -> *) a. a -> f a -> T f a
Cons a
x f a
forall (f :: * -> *) a. Empty f => f a
C.empty
   cons a
x0 (Cons a
x1 f a
xs) = a -> f a -> T f a
forall (f :: * -> *) a. a -> f a -> T f a
Cons a
x0 (f a -> T f a) -> f a -> T f a
forall a b. (a -> b) -> a -> b
$ a -> f a -> f a
forall (f :: * -> *) a. Cons f => a -> f a -> f a
C.cons a
x1 f a
xs

instance (C.Repeat f) => C.Repeat (T f) where
   repeat :: a -> T f a
repeat a
x = a -> f a -> T f a
forall (f :: * -> *) a. a -> f a -> T f a
Cons a
x (f a -> T f a) -> f a -> T f a
forall a b. (a -> b) -> a -> b
$ a -> f a
forall (f :: * -> *) a. Repeat f => a -> f a
C.repeat a
x

instance (C.Iterate f) => C.Iterate (T f) where
   iterate :: (a -> a) -> a -> T f a
iterate a -> a
f a
x = a -> f a -> T f a
forall (f :: * -> *) a. a -> f a -> T f a
Cons a
x (f a -> T f a) -> f a -> T f a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> f a
forall (f :: * -> *) a. Iterate f => (a -> a) -> a -> f a
C.iterate a -> a
f (a -> a
f a
x)

instance C.Zip f => C.Zip (T f) where
   zipWith :: (a -> b -> c) -> T f a -> T f b -> T f c
zipWith a -> b -> c
f (Cons a
x f a
xs) (Cons b
y f b
ys) = c -> f c -> T f c
forall (f :: * -> *) a. a -> f a -> T f a
Cons (a -> b -> c
f a
x b
y) ((a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
C.zipWith a -> b -> c
f f a
xs f b
ys)
   zipWith a -> b -> c
_ T f a
_ T f b
_ = T f c
forall (f :: * -> *) a. T f a
Nil

instance (Trav.Traversable f, C.Reverse f) => C.Reverse (T f) where
   reverse :: T f a -> T f a
reverse T f a
Nil = T f a
forall (f :: * -> *) a. T f a
Nil
   reverse (Cons a
x f a
xs) =
      T f a -> T f a
forall (f :: * -> *) a. T f a -> T f a
fromNonEmpty (f a -> a -> T f a
forall (f :: * -> *) a. Traversable f => f a -> a -> T f a
snoc (f a -> f a
forall (f :: * -> *) a. Reverse f => f a -> f a
C.reverse f a
xs) a
x)

instance (NonEmpty.Insert f, C.Sort f) => C.Sort (T f) where
   sort :: T f a -> T f a
sort T f a
Nil = T f a
forall (f :: * -> *) a. T f a
Nil
   sort (Cons a
x f a
xs) =
      T f a -> T f a
forall (f :: * -> *) a. T f a -> T f a
fromNonEmpty (T f a -> T f a) -> T f a -> T f a
forall a b. (a -> b) -> a -> b
$ a -> f a -> T f a
forall (f :: * -> *) a. (Insert f, Ord a) => a -> f a -> T f a
NonEmpty.insert a
x (f a -> T f a) -> f a -> T f a
forall a b. (a -> b) -> a -> b
$ f a -> f a
forall (f :: * -> *) a. (Sort f, Ord a) => f a -> f a
C.sort f a
xs

instance (NonEmpty.InsertBy f, C.SortBy f) => C.SortBy (T f) where
   sortBy :: (a -> a -> Ordering) -> T f a -> T f a
sortBy a -> a -> Ordering
_ T f a
Nil = T f a
forall (f :: * -> *) a. T f a
Nil
   sortBy a -> a -> Ordering
f (Cons a
x f a
xs) =
      T f a -> T f a
forall (f :: * -> *) a. T f a -> T f a
fromNonEmpty (T f a -> T f a) -> T f a -> T f a
forall a b. (a -> b) -> a -> b
$ (a -> a -> Ordering) -> a -> f a -> T f a
forall (f :: * -> *) a.
InsertBy f =>
(a -> a -> Ordering) -> a -> f a -> T f a
NonEmpty.insertBy a -> a -> Ordering
f a
x (f a -> T f a) -> f a -> T f a
forall a b. (a -> b) -> a -> b
$ (a -> a -> Ordering) -> f a -> f a
forall (f :: * -> *) a.
SortBy f =>
(a -> a -> Ordering) -> f a -> f a
C.sortBy a -> a -> Ordering
f f a
xs

instance (NonEmpty.Insert f) => NonEmpty.Insert (T f) where
   insert :: a -> T f a -> T (T f) a
insert a
y T f a
xt =
      (a -> T f a -> T (T f) a) -> (a, T f a) -> T (T f) a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> T f a -> T (T f) a
forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons ((a, T f a) -> T (T f) a) -> (a, T f a) -> T (T f) a
forall a b. (a -> b) -> a -> b
$
      case T f a
xt of
         T f a
Nil -> (a
y, T f a
xt)
         Cons a
x f a
xs ->
            case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare a
y a
x of
               Ordering
GT -> (a
x, T f a -> T f a
forall (f :: * -> *) a. T f a -> T f a
fromNonEmpty (T f a -> T f a) -> T f a -> T f a
forall a b. (a -> b) -> a -> b
$ a -> f a -> T f a
forall (f :: * -> *) a. (Insert f, Ord a) => a -> f a -> T f a
NonEmpty.insert a
y f a
xs)
               Ordering
_ -> (a
y, T f a
xt)

instance (NonEmpty.InsertBy f) => NonEmpty.InsertBy (T f) where
   insertBy :: (a -> a -> Ordering) -> a -> T f a -> T (T f) a
insertBy a -> a -> Ordering
f a
y T f a
xt =
      (a -> T f a -> T (T f) a) -> (a, T f a) -> T (T f) a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> T f a -> T (T f) a
forall (f :: * -> *) a. a -> f a -> T f a
NonEmpty.Cons ((a, T f a) -> T (T f) a) -> (a, T f a) -> T (T f) a
forall a b. (a -> b) -> a -> b
$
      case T f a
xt of
         T f a
Nil -> (a
y, T f a
xt)
         Cons a
x f a
xs ->
            case a -> a -> Ordering
f a
y a
x of
               Ordering
GT -> (a
x, T f a -> T f a
forall (f :: * -> *) a. T f a -> T f a
fromNonEmpty (T f a -> T f a) -> T f a -> T f a
forall a b. (a -> b) -> a -> b
$ (a -> a -> Ordering) -> a -> f a -> T f a
forall (f :: * -> *) a.
InsertBy f =>
(a -> a -> Ordering) -> a -> f a -> T f a
NonEmpty.insertBy a -> a -> Ordering
f a
y f a
xs)
               Ordering
_ -> (a
y, T f a
xt)