module Data.NonEmpty.Class where
import qualified Data.List as List
import Control.Monad (liftM2, )
import Data.Tuple.HT (forcePair, mapSnd, )
import qualified Data.List.HT as ListHT
import qualified Test.QuickCheck as QC
import Prelude hiding (zipWith, )
class Empty f where
empty :: f a
instance Empty [] where
empty = []
instance Empty Maybe where
empty = Nothing
class Cons f where
cons :: a -> f a -> f a
instance Cons [] where
cons = (:)
class View f where
viewL :: f a -> Maybe (a, f a)
instance View [] where
viewL = ListHT.viewL
instance View Maybe where
viewL = fmap (\a -> (a, Nothing))
class Singleton f where
singleton :: a -> f a
instance Singleton [] where
singleton x = [x]
instance Singleton Maybe where
singleton x = Just x
class Append f where
append :: f a -> f a -> f a
instance Append [] where
append = (++)
infixr 5 `cons`, `append`
class Zip f where
zipWith :: (a -> b -> c) -> f a -> f b -> f c
instance Zip [] where
zipWith = List.zipWith
instance Zip Maybe where
zipWith = liftM2
zip :: (Zip f) => f a -> f b -> f (a,b)
zip = zipWith (,)
class Sort f where
sortBy :: (a -> a -> Ordering) -> f a -> f a
insertBy :: (a -> a -> Ordering) -> a -> f a -> (a, f a)
instance Sort [] where
sortBy = List.sortBy
insertBy f y xt =
forcePair $
case xt of
[] -> (y, xt)
x:xs ->
case f y x of
GT -> (x, List.insertBy f y xs)
_ -> (y, xt)
instance Sort Maybe where
sortBy _f = id
insertBy f y mx =
forcePair $
case mx of
Nothing -> (y, Nothing)
Just x ->
mapSnd Just $
case f y x of
GT -> (x, y)
_ -> (y, x)
sort :: (Ord a, Sort f) => f a -> f a
sort = sortBy compare
insert :: (Ord a, Sort f) => a -> f a -> (a, f a)
insert = insertBy compare
class Arbitrary f where
arbitrary :: QC.Arbitrary a => QC.Gen (f a)
shrink :: QC.Arbitrary a => f a -> [f a]
instance Arbitrary [] where
arbitrary = QC.arbitrary
shrink = QC.shrink