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 (Eq, Ord)
fromEmpty :: Empty.T a -> T f a
fromEmpty Empty.Cons = Nil
fromNonEmpty :: NonEmpty.T f a -> T f a
fromNonEmpty (NonEmpty.Cons x xs) = Cons x xs
instance (C.NFData f, NFData a) => NFData (T f a) where
rnf = C.rnf
instance (C.NFData f) => C.NFData (T f) where
rnf Nil = ()
rnf (Cons x xs) = rnf (x, C.rnf xs)
instance (C.Show f, P.Show a) => P.Show (T f a) where
showsPrec = C.showsPrec
instance (C.Show f) => C.Show (T f) where
showsPrec _ Nil = P.showString "Nil"
showsPrec p (Cons x xs) =
P.showParen (p>5) $
P.showsPrec 6 x . P.showString "?:" . C.showsPrec 5 xs
infixr 5 ?:
(?:) :: a -> f a -> T f a
(?:) = Cons
instance P.Functor f => P.Functor (T f) where
fmap _ Nil = Nil
fmap f (Cons x xs) = Cons (f x) (fmap f xs)
instance (Fold.Foldable f) => Fold.Foldable (T f) where
foldr _ y Nil = y
foldr f y (Cons x xs) = f x (Fold.foldr f y xs)
instance (Trav.Traversable f) => Trav.Traversable (T f) where
sequenceA Nil = pure Nil
sequenceA (Cons x xs) = liftA2 Cons x (Trav.sequenceA xs)
instance (C.Arbitrary f, QC.Arbitrary a) => QC.Arbitrary (T f a) where
arbitrary = arbitrary
shrink = shrink
instance (C.Arbitrary f) => C.Arbitrary (T f) where
arbitrary = arbitrary
shrink = shrink
arbitrary :: (C.Arbitrary f, QC.Arbitrary a) => QC.Gen (T f a)
arbitrary = QC.oneof [return Nil, liftA2 Cons QC.arbitrary C.arbitrary]
shrink :: (C.Arbitrary f, QC.Arbitrary a) => T f a -> [T f a]
shrink Nil = []
shrink (Cons x xs) = P.map (\(y, Aux ys) -> Cons y ys) (QC.shrink (x, Aux xs))
instance (C.Gen f) => C.Gen (T f) where
genOf gen = do
b <- QC.arbitrary
if b then liftA2 Cons gen $ C.genOf gen else return Nil
instance C.Empty (T f) where
empty = Nil
instance (C.Cons f, C.Empty f) => C.Cons (T f) where
cons x Nil = Cons x C.empty
cons x0 (Cons x1 xs) = Cons x0 $ C.cons x1 xs
instance (C.Repeat f) => C.Repeat (T f) where
repeat x = Cons x $ C.repeat x
instance (C.Iterate f) => C.Iterate (T f) where
iterate f x = Cons x $ C.iterate f (f x)
instance C.Zip f => C.Zip (T f) where
zipWith f (Cons x xs) (Cons y ys) = Cons (f x y) (C.zipWith f xs ys)
zipWith _ _ _ = Nil
instance (Trav.Traversable f, C.Reverse f) => C.Reverse (T f) where
reverse Nil = Nil
reverse (Cons x xs) =
fromNonEmpty (snoc (C.reverse xs) x)
instance (NonEmpty.Insert f, C.Sort f) => C.Sort (T f) where
sort Nil = Nil
sort (Cons x xs) =
fromNonEmpty $ NonEmpty.insert x $ C.sort xs
instance (NonEmpty.InsertBy f, C.SortBy f) => C.SortBy (T f) where
sortBy _ Nil = Nil
sortBy f (Cons x xs) =
fromNonEmpty $ NonEmpty.insertBy f x $ C.sortBy f xs
instance (NonEmpty.Insert f) => NonEmpty.Insert (T f) where
insert y xt =
uncurry NonEmpty.Cons $
case xt of
Nil -> (y, xt)
Cons x xs ->
case P.compare y x of
GT -> (x, fromNonEmpty $ NonEmpty.insert y xs)
_ -> (y, xt)
instance (NonEmpty.InsertBy f) => NonEmpty.InsertBy (T f) where
insertBy f y xt =
uncurry NonEmpty.Cons $
case xt of
Nil -> (y, xt)
Cons x xs ->
case f y x of
GT -> (x, fromNonEmpty $ NonEmpty.insertBy f y xs)
_ -> (y, xt)