module Data.NonNull (
NonNull(..)
, SafeSequence(..)
, NotEmpty
, MonoFoldable1(..)
, OrdNonNull(..)
, (<|)
) where
import Prelude hiding (head, tail, init, last, reverse, seq, filter, replicate)
import Data.MonoTraversable
import Data.Sequences
import Control.Exception.Base (Exception, throw)
import Data.Semigroup
import qualified Data.Monoid as Monoid
import Data.Data
import Data.Maybe (fromMaybe)
import qualified Data.List.NonEmpty as NE
import qualified Data.Foldable as F
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Storable as VS
import qualified Data.Sequence as Seq
data NullError = NullError String deriving (Show, Typeable)
instance Exception NullError
class (SemiSequence seq, IsSequence (Nullable seq), Element seq ~ Element (Nullable seq)) => NonNull seq where
type Nullable seq
fromNonEmpty :: NE.NonEmpty (Element seq) -> seq
fromNullable :: Nullable seq -> Maybe seq
nonNull :: Nullable seq -> seq
nonNull nullable = case fromNullable nullable of
Nothing -> throw $ NullError "Data.NonNull.nonNull (NonNull default): expected non-null"
Just xs -> xs
toNullable :: seq -> Nullable seq
ncons :: Element seq -> Nullable seq -> seq
nuncons :: seq -> (Element seq, Maybe seq)
nuncons xs = case uncons $ toNullable xs of
Nothing -> error "Data.NonNull.nuncons: data structure is null, it should be non-null"
Just (x, xsNullable) -> (x, fromNullable xsNullable)
splitFirst :: seq -> (Element seq, Nullable seq)
splitFirst xs = case uncons $ toNullable xs of
Nothing -> error "Data.NonNull.splitFirst: data structure is null, it should be non-null"
Just tup -> tup
nfilter :: (Element seq -> Bool) -> seq -> Nullable seq
nfilterM :: Monad m => (Element seq -> m Bool) -> seq -> m (Nullable seq)
nReplicate :: Index seq -> Element seq -> seq
class SafeSequence seq where
head :: seq -> Element seq
tail :: seq -> Nullable seq
last :: seq -> Element seq
init :: seq -> Nullable seq
instance NonNull (NE.NonEmpty a) where
type Nullable (NE.NonEmpty a) = [a]
fromNonEmpty = id
fromNullable = NE.nonEmpty
nonNull = NE.fromList
toNullable = NE.toList
ncons = (NE.:|)
nfilter = NE.filter
nfilterM f = filterM f . toNullable
nReplicate i x = NE.unfold unfold i
where
unfold countdown | countdown < 1 = (x, Nothing)
| otherwise = (x, Just (countdown 1))
instance SafeSequence (NE.NonEmpty a) where
head = NE.head
tail = NE.tail
last = NE.last
init = NE.init
newtype NotEmpty seq = NotEmpty { fromNotEmpty :: seq }
deriving (Eq, Ord, Read, Show, Data, Typeable, Functor)
type instance Element (NotEmpty seq) = Element seq
deriving instance MonoFunctor seq => MonoFunctor (NotEmpty seq)
deriving instance MonoFoldable seq => MonoFoldable (NotEmpty seq)
deriving instance MonoTraversable seq => MonoTraversable (NotEmpty seq)
instance Monoid seq => Semigroup (NotEmpty seq) where
x <> y = NotEmpty (fromNotEmpty x `Monoid.mappend` fromNotEmpty y)
sconcat = NotEmpty . Monoid.mconcat . fmap fromNotEmpty . NE.toList
instance SemiSequence seq => SemiSequence (NotEmpty seq) where
type Index (NotEmpty seq) = Index seq
singleton = NotEmpty . singleton
intersperse e = fmap $ intersperse e
reverse = fmap reverse
find f = find f . fromNotEmpty
cons x = fmap $ cons x
snoc xs x = fmap (flip snoc x) xs
sortBy f = fmap $ sortBy f
instance IsSequence seq => NonNull (NotEmpty seq) where
type Nullable (NotEmpty seq) = seq
fromNonEmpty = NotEmpty . fromList . NE.toList
fromNullable xs | onull xs = Nothing
| otherwise = Just $ NotEmpty xs
nonNull xs | onull xs = throw $ NullError "Data.NonNull.nonNull expected NotEmpty"
| otherwise = NotEmpty xs
toNullable = fromNotEmpty
ncons x xs = NotEmpty $ cons x xs
nReplicate i x | i < 1 = ncons x mempty
| otherwise = NotEmpty $ replicate i x
nfilter f = filter f . toNullable
nfilterM f = filterM f . toNullable
instance SafeSequence (NotEmpty (Seq.Seq a)) where
head = flip Seq.index 1 . fromNotEmpty
last (NotEmpty xs) = Seq.index xs (Seq.length xs 1)
tail = Seq.drop 1 . fromNotEmpty
init (NotEmpty xs) = Seq.take (Seq.length xs 1) xs
instance SafeSequence (NotEmpty (V.Vector a)) where
head = V.head . fromNotEmpty
tail = V.tail . fromNotEmpty
last = V.last . fromNotEmpty
init = V.init . fromNotEmpty
instance U.Unbox a => SafeSequence (NotEmpty (U.Vector a)) where
head = U.head . fromNotEmpty
tail = U.tail . fromNotEmpty
last = U.last . fromNotEmpty
init = U.init . fromNotEmpty
instance VS.Storable a => SafeSequence (NotEmpty (VS.Vector a)) where
head = VS.head . fromNotEmpty
tail = VS.tail . fromNotEmpty
last = VS.last . fromNotEmpty
init = VS.init . fromNotEmpty
instance SafeSequence (NotEmpty S.ByteString) where
head = S.head . fromNotEmpty
tail = S.tail . fromNotEmpty
last = S.last . fromNotEmpty
init = S.init . fromNotEmpty
instance SafeSequence (NotEmpty T.Text) where
head = T.head . fromNotEmpty
tail = T.tail . fromNotEmpty
last = T.last . fromNotEmpty
init = T.init . fromNotEmpty
instance SafeSequence (NotEmpty L.ByteString) where
head = L.head . fromNotEmpty
tail = L.tail . fromNotEmpty
last = L.last . fromNotEmpty
init = L.init . fromNotEmpty
instance SafeSequence (NotEmpty TL.Text) where
head = TL.head . fromNotEmpty
tail = TL.tail . fromNotEmpty
last = TL.last . fromNotEmpty
init = TL.init . fromNotEmpty
infixr 5 <|
(<|) :: NonNull seq => Element seq -> seq -> seq
(<|) = cons
class (NonNull seq, MonoFoldable (Nullable seq)) => MonoFoldable1 seq where
ofoldMap1 :: Semigroup m => (Element seq -> m) -> seq -> m
ofoldMap1 f = maybe (error "Data.NonNull.foldMap1 (MonoFoldable1)") id . getOption . ofoldMap (Option . Just . f) . toNullable
ofoldr1 :: (Element seq -> Element seq -> Element seq) -> seq -> Element seq
ofoldr1 f = fromMaybe (error "Data.NonNull.foldr1 (MonoFoldable1): empty structure") .
(ofoldr mf Nothing) . toNullable
where
mf x Nothing = Just x
mf x (Just y) = Just (f x y)
ofoldl1' :: (Element seq -> Element seq -> Element seq) -> seq -> Element seq
ofoldl1' f = fromMaybe (error "ofoldl1': empty structure") .
(ofoldl' mf Nothing) . toNullable
where
mf Nothing y = Just y
mf (Just x) y = Just (f x y)
instance MonoFoldable1 (NE.NonEmpty a)
instance (MonoFoldable mono, IsSequence mono) => MonoFoldable1 (NotEmpty mono)
class (MonoFoldable1 seq, OrdSequence (Nullable seq)) => OrdNonNull seq where
maximum :: seq -> Element seq
default maximum :: (MonoFoldable1 seq) => seq -> Element seq
maximum = ofoldr1 max
minimum :: seq -> Element seq
default minimum :: (MonoFoldable1 seq, Element (Nullable seq) ~ Element seq) => seq -> Element seq
minimum = ofoldr1 min
maximumBy :: (Element seq -> Element seq -> Ordering) -> seq -> Element seq
default maximumBy :: (MonoFoldable1 seq) => (Element seq -> Element seq -> Ordering) -> seq -> Element seq
maximumBy cmp = ofoldr1 max'
where max' x y = case cmp x y of
GT -> x
_ -> y
minimumBy :: (Element seq -> Element seq -> Ordering) -> seq -> Element seq
default minimumBy :: (MonoFoldable1 seq) => (Element seq -> Element seq -> Ordering) -> seq -> Element seq
minimumBy cmp = ofoldr1 min'
where min' x y = case cmp x y of
GT -> y
_ -> x
instance Ord a => OrdNonNull (NE.NonEmpty a) where
maximum = F.maximum
minimum = F.minimum
maximumBy = F.maximumBy
minimumBy = F.minimumBy
instance Ord a => OrdNonNull (NotEmpty (Seq.Seq a))
instance Ord a => OrdNonNull (NotEmpty (V.Vector a))
instance OrdNonNull (NotEmpty (S.ByteString))
instance OrdNonNull (NotEmpty (L.ByteString))
instance OrdNonNull (NotEmpty (T.Text))
instance OrdNonNull (NotEmpty (TL.Text))