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.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 :: [a] empty = [] instance Empty Maybe where empty :: Maybe a empty = Maybe a forall a. Maybe a Nothing instance Empty Set where empty :: Set a empty = Set a forall a. Set a Set.empty instance Empty (Map k) where empty :: Map k a empty = Map k a forall k a. Map k a Map.empty instance Empty Seq where empty :: Seq a empty = Seq a forall a. Seq a Seq.empty class Cons f where cons :: a -> f a -> f a instance Cons [] where cons :: a -> [a] -> [a] cons = (:) instance Cons Seq where cons :: a -> Seq a -> Seq a cons = a -> Seq a -> Seq a forall a. a -> Seq a -> Seq a (Seq.<|) class Snoc f where snoc :: f a -> a -> f a instance Snoc [] where snoc :: [a] -> a -> [a] snoc = [a] -> a -> [a] forall (f :: * -> *) a. (Cons f, Traversable f) => f a -> a -> f a snocDefault instance Snoc Seq where snoc :: Seq a -> a -> Seq a snoc = Seq a -> a -> Seq a forall a. Seq a -> a -> Seq a (Seq.|>) snocDefault :: (Cons f, Traversable f) => f a -> a -> f a snocDefault :: f a -> a -> f a snocDefault f a xs a x = (a -> f a -> f a) -> (a, f a) -> f a forall a b c. (a -> b -> c) -> (a, b) -> c uncurry a -> f a -> f a forall (f :: * -> *) a. Cons f => a -> f a -> f a cons ((a, f a) -> f a) -> (a, f a) -> f a forall a b. (a -> b) -> a -> b $ (a -> a -> (a, a)) -> a -> f a -> (a, f a) forall (t :: * -> *) a b c. Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumR ((a -> a -> (a, a)) -> a -> a -> (a, a) 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 :: [a] -> Maybe (a, [a]) viewL = [a] -> Maybe (a, [a]) forall a. [a] -> Maybe (a, [a]) ListHT.viewL instance ViewL Maybe where viewL :: Maybe a -> Maybe (a, Maybe a) viewL = (a -> (a, Maybe a)) -> Maybe a -> Maybe (a, Maybe a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (\a a -> (a a, Maybe a forall a. Maybe a Nothing)) instance ViewL Set where viewL :: Set a -> Maybe (a, Set a) viewL = Set a -> Maybe (a, Set a) forall a. Set a -> Maybe (a, Set a) Set.minView instance ViewL Seq where viewL :: Seq a -> Maybe (a, Seq a) viewL Seq a x = case Seq a -> ViewL a forall a. Seq a -> ViewL a Seq.viewl Seq a x of ViewL a Seq.EmptyL -> Maybe (a, Seq a) forall a. Maybe a Nothing a y Seq.:< Seq a ys -> (a, Seq a) -> Maybe (a, Seq a) 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 :: [a] -> Maybe ([a], a) viewR = [a] -> Maybe ([a], a) forall a. [a] -> Maybe ([a], a) ListHT.viewR instance ViewR Maybe where viewR :: Maybe a -> Maybe (Maybe a, a) viewR = (a -> (Maybe a, a)) -> Maybe a -> Maybe (Maybe a, a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (\a a -> (Maybe a forall a. Maybe a Nothing, a a)) instance ViewR Set where viewR :: Set a -> Maybe (Set a, a) viewR = ((a, Set a) -> (Set a, a)) -> Maybe (a, Set a) -> Maybe (Set a, a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (a, Set a) -> (Set a, a) forall a b. (a, b) -> (b, a) swap (Maybe (a, Set a) -> Maybe (Set a, a)) -> (Set a -> Maybe (a, Set a)) -> Set a -> Maybe (Set a, a) forall b c a. (b -> c) -> (a -> b) -> a -> c . Set a -> Maybe (a, Set a) forall a. Set a -> Maybe (a, Set a) Set.maxView instance ViewR Seq where viewR :: Seq a -> Maybe (Seq a, a) viewR Seq a x = case Seq a -> ViewR a forall a. Seq a -> ViewR a Seq.viewr Seq a x of ViewR a Seq.EmptyR -> Maybe (Seq a, a) forall a. Maybe a Nothing Seq a ys Seq.:> a y -> (Seq a, a) -> Maybe (Seq a, a) 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 :: f a -> Maybe (f a, a) viewRDefault = ((a, f a) -> (f a, a)) -> Maybe (a, f a) -> Maybe (f a, a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((a, f a) -> (f a, a) forall a b. (a, b) -> (b, a) swap ((a, f a) -> (f a, a)) -> ((a, f a) -> (a, f a)) -> (a, f a) -> (f a, a) forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> f a -> (a, f a)) -> (a, f a) -> (a, f a) forall a b c. (a -> b -> c) -> (a, b) -> c uncurry ((a -> a -> (a, a)) -> a -> f a -> (a, f a) forall (t :: * -> *) a b c. Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) mapAccumL ((a -> a -> (a, a)) -> a -> a -> (a, a) forall a b c. (a -> b -> c) -> b -> a -> c flip (,)))) (Maybe (a, f a) -> Maybe (f a, a)) -> (f a -> Maybe (a, f a)) -> f a -> Maybe (f a, a) forall b c a. (b -> c) -> (a -> b) -> a -> c . f a -> Maybe (a, f a) forall (f :: * -> *) a. ViewL f => f a -> Maybe (a, f a) viewL class Singleton f where singleton :: a -> f a instance Singleton [] where singleton :: a -> [a] singleton a x = [a x] instance Singleton Maybe where singleton :: a -> Maybe a singleton a x = a -> Maybe a forall a. a -> Maybe a Just a x instance Singleton Set where singleton :: a -> Set a singleton = a -> Set a forall a. a -> Set a Set.singleton instance Singleton Seq where singleton :: a -> Seq a singleton = a -> Seq a forall a. a -> Seq a Seq.singleton class Append f where append :: f a -> f a -> f a instance Append [] where append :: [a] -> [a] -> [a] append = [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] (++) instance Append Seq where append :: Seq a -> Seq a -> Seq a append = Seq a -> Seq a -> Seq a 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 :: (a -> b -> c) -> [a] -> [b] -> [c] zipWith = (a -> b -> c) -> [a] -> [b] -> [c] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] List.zipWith instance Zip Maybe where zipWith :: (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c zipWith = (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c forall (m :: * -> *) a1 a2 r. Monad m => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r liftM2 instance Zip Seq where zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c zipWith = (a -> b -> c) -> Seq a -> Seq b -> Seq c 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 :: (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 = ((c -> d) -> c -> d) -> f (c -> d) -> f c -> f d forall (f :: * -> *) a b c. Zip f => (a -> b -> c) -> f a -> f b -> f c zipWith (c -> d) -> c -> d forall a b. (a -> b) -> a -> b ($) ((a -> b -> c -> d) -> f a -> f b -> f (c -> d) 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 :: (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 = ((d -> e) -> d -> e) -> f (d -> e) -> f d -> f e forall (f :: * -> *) a b c. Zip f => (a -> b -> c) -> f a -> f b -> f c zipWith (d -> e) -> d -> e forall a b. (a -> b) -> a -> b ($) ((a -> b -> c -> d -> e) -> f a -> f b -> f c -> f (d -> e) 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 :: f a -> f b -> f (a, b) zip = (a -> b -> (a, b)) -> f a -> f b -> f (a, b) 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 :: f a -> f b -> f c -> f (a, b, c) zip3 = (a -> b -> c -> (a, b, c)) -> f a -> f b -> f c -> f (a, b, c) 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 :: f a -> f b -> f c -> f d -> f (a, b, c, d) zip4 = (a -> b -> c -> d -> (a, b, c, d)) -> f a -> f b -> f c -> f d -> f (a, b, c, d) 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 :: a -> [a] repeat = a -> [a] forall a. a -> [a] List.repeat instance Repeat Maybe where repeat :: a -> Maybe a repeat = a -> Maybe a 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 :: (a -> a) -> a -> [a] iterate = (a -> a) -> a -> [a] forall a. (a -> a) -> a -> [a] List.iterate instance Iterate Maybe where iterate :: (a -> a) -> a -> Maybe a iterate a -> a _ = a -> Maybe 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 :: [a] -> [a] sort = [a] -> [a] forall a. Ord a => [a] -> [a] List.sort instance Sort Maybe where sort :: Maybe a -> Maybe a sort = Maybe a -> Maybe a forall a. a -> a id instance Sort Seq where sort :: Seq a -> Seq a sort = Seq a -> Seq a forall a. Ord a => Seq a -> Seq a Seq.sort instance Sort Set where sort :: Set a -> Set a sort = Set a -> Set a forall a. a -> a id {- | Default implementation for 'sort' based on 'sortBy'. -} sortDefault :: (Ord a, SortBy f) => f a -> f a sortDefault :: f a -> f a sortDefault = (a -> a -> Ordering) -> f a -> f a forall (f :: * -> *) a. SortBy f => (a -> a -> Ordering) -> f a -> f a sortBy a -> a -> Ordering 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 :: (a -> a -> Ordering) -> [a] -> [a] sortBy = (a -> a -> Ordering) -> [a] -> [a] forall a. (a -> a -> Ordering) -> [a] -> [a] List.sortBy instance SortBy Maybe where sortBy :: (a -> a -> Ordering) -> Maybe a -> Maybe a sortBy a -> a -> Ordering _f = Maybe a -> Maybe a forall a. a -> a id instance SortBy Seq where sortBy :: (a -> a -> Ordering) -> Seq a -> Seq a sortBy = (a -> a -> Ordering) -> Seq a -> Seq a 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 :: (a -> b) -> [a] -> [a] sortKey = (a -> b) -> [a] -> [a] forall b a. Ord b => (a -> b) -> [a] -> [a] Key.sort instance SortKey Maybe where sortKey :: (a -> b) -> Maybe a -> Maybe a sortKey a -> b _f = Maybe a -> Maybe a forall a. a -> a id instance SortKey Seq where sortKey :: (a -> b) -> Seq a -> Seq a sortKey = (a -> b) -> Seq a -> Seq a 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 :: (a -> b) -> f a -> f a sortKeyGen a -> b f = ((b, a) -> a) -> f (b, a) -> f a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (b, a) -> a forall a b. (a, b) -> b snd (f (b, a) -> f a) -> (f a -> f (b, a)) -> f a -> f a forall b c a. (b -> c) -> (a -> b) -> a -> c . ((b, a) -> (b, a) -> Ordering) -> f (b, a) -> f (b, a) forall (f :: * -> *) a. SortBy f => (a -> a -> Ordering) -> f a -> f a sortBy (((b, a) -> b) -> (b, a) -> (b, a) -> Ordering forall b a. Ord b => (a -> b) -> a -> a -> Ordering comparing (b, a) -> b forall a b. (a, b) -> a fst) (f (b, a) -> f (b, a)) -> (f a -> f (b, a)) -> f a -> f (b, a) forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> (b, a)) -> f a -> f (b, a) 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 :: [a] -> [a] reverse = [a] -> [a] forall a. [a] -> [a] List.reverse instance Reverse Maybe where reverse :: Maybe a -> Maybe a reverse = Maybe a -> Maybe a forall a. a -> a id instance Reverse Seq where reverse :: Seq a -> Seq a reverse = Seq a -> Seq a forall a. Seq a -> Seq a Seq.reverse class Show f where showsPrec :: P.Show a => Int -> f a -> ShowS instance Show [] where showsPrec :: Int -> [a] -> ShowS showsPrec Int p [a] xs = if [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [a] xs then String -> ShowS showString String "[]" else Bool -> ShowS -> ShowS 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 $ (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr ShowS -> ShowS -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c (.) (String -> ShowS showString String "[]") ([ShowS] -> ShowS) -> [ShowS] -> ShowS forall a b. (a -> b) -> a -> b $ (a -> ShowS) -> [a] -> [ShowS] forall a b. (a -> b) -> [a] -> [b] map (\a x -> 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 showString String ":") [a] xs instance Show Maybe where showsPrec :: Int -> Maybe a -> ShowS showsPrec = Int -> Maybe a -> ShowS forall a. Show a => Int -> a -> ShowS P.showsPrec instance Show Seq where showsPrec :: Int -> Seq a -> ShowS showsPrec = Int -> Seq a -> ShowS forall a. Show a => Int -> a -> ShowS P.showsPrec instance Show Set where showsPrec :: Int -> Set a -> ShowS showsPrec = Int -> Set a -> ShowS 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 :: Gen [a] arbitrary = Gen [a] forall a. Arbitrary a => Gen a QC.arbitrary shrink :: [a] -> [[a]] shrink = [a] -> [[a]] forall a. Arbitrary a => a -> [a] QC.shrink instance Arbitrary Seq where arbitrary :: Gen (Seq a) arbitrary = Gen (Seq a) forall a. Arbitrary a => Gen a QC.arbitrary shrink :: Seq a -> [Seq a] shrink = Seq a -> [Seq a] forall a. Arbitrary a => a -> [a] QC.shrink instance Arbitrary Maybe where arbitrary :: Gen (Maybe a) arbitrary = Gen (Maybe a) forall a. Arbitrary a => Gen a QC.arbitrary shrink :: Maybe a -> [Maybe a] shrink = Maybe a -> [Maybe a] forall a. Arbitrary a => a -> [a] QC.shrink instance (QC.Arbitrary k, Ord k) => Arbitrary (Map k) where arbitrary :: Gen (Map k a) arbitrary = Gen (Map k a) forall a. Arbitrary a => Gen a QC.arbitrary shrink :: Map k a -> [Map k a] shrink = Map k a -> [Map k a] 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 :: Gen a -> Gen [a] genOf = Gen a -> Gen [a] forall a. Gen a -> Gen [a] QC.listOf instance Gen Seq where genOf :: Gen a -> Gen (Seq a) genOf = ([a] -> Seq a) -> Gen [a] -> Gen (Seq a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap [a] -> Seq a forall a. [a] -> Seq a Seq.fromList (Gen [a] -> Gen (Seq a)) -> (Gen a -> Gen [a]) -> Gen a -> Gen (Seq a) forall b c a. (b -> c) -> (a -> b) -> a -> c . Gen a -> Gen [a] forall a. Gen a -> Gen [a] QC.listOf instance Gen Maybe where genOf :: Gen a -> Gen (Maybe a) genOf Gen a gen = do Bool b <- Gen Bool forall a. Arbitrary a => Gen a QC.arbitrary if Bool b then (a -> Maybe a) -> Gen a -> Gen (Maybe a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> Maybe a forall a. a -> Maybe a Just Gen a gen else Maybe a -> Gen (Maybe a) forall (m :: * -> *) a. Monad m => a -> m a return Maybe a forall a. Maybe a Nothing instance (QC.Arbitrary k, Ord k) => Gen (Map k) where genOf :: Gen a -> Gen (Map k a) genOf Gen a gen = ([(k, a)] -> Map k a) -> Gen [(k, a)] -> Gen (Map k a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap [(k, a)] -> Map k a forall k a. Ord k => [(k, a)] -> Map k a Map.fromList (Gen [(k, a)] -> Gen (Map k a)) -> Gen [(k, a)] -> Gen (Map k a) forall a b. (a -> b) -> a -> b $ (k -> Gen (k, a)) -> [k] -> Gen [(k, a)] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM (\k k -> (a -> (k, a)) -> Gen a -> Gen (k, a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((,) k k) Gen a gen) ([k] -> Gen [(k, a)]) -> Gen [k] -> Gen [(k, a)] forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Gen [k] forall a. Arbitrary a => Gen a QC.arbitrary class NFData f where rnf :: DeepSeq.NFData a => f a -> () instance NFData Maybe where rnf :: Maybe a -> () rnf = Maybe a -> () forall a. NFData a => a -> () DeepSeq.rnf instance NFData [] where rnf :: [a] -> () rnf = [a] -> () forall a. NFData a => a -> () DeepSeq.rnf instance NFData Set where rnf :: Set a -> () rnf = Set a -> () forall a. NFData a => a -> () DeepSeq.rnf instance (DeepSeq.NFData k) => NFData (Map k) where rnf :: Map k a -> () rnf = Map k a -> () forall a. NFData a => a -> () DeepSeq.rnf