module Data.NonNull (
NonNull(..)
, fromNonEmpty
, ncons
, nuncons
, splitFirst
, nfilter
, nfilterM
, nReplicate
, head
, tail
, last
, init
, NotEmpty
, asNotEmpty
, ofoldMap1
, ofold1
, ofoldr1
, ofoldl1'
, maximum
, maximumBy
, minimum
, minimumBy
, (<|)
) where
import Prelude hiding (head, tail, init, last, reverse, seq, filter, replicate, maximum, minimum)
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 qualified Data.List.NonEmpty as NE
import Control.Monad (liftM)
data NullError = NullError String deriving (Show, Typeable)
instance Exception NullError
class (MonoFoldable mono, MonoFoldable (Nullable mono), Element mono ~ Element (Nullable mono)) => NonNull mono where
type Nullable mono
fromNullable :: Nullable mono -> Maybe mono
nonNull :: Nullable mono -> mono
nonNull nullable = case fromNullable nullable of
Nothing -> throw $ NullError "Data.NonNull.nonNull (NonNull default): expected non-null"
Just xs -> xs
toNullable :: mono -> Nullable mono
fromNonEmpty :: (NonNull seq, IsSequence (Nullable seq)) => NE.NonEmpty (Element seq) -> seq
fromNonEmpty = nonNull . fromList . NE.toList
ncons :: (NonNull seq, SemiSequence (Nullable seq)) => Element seq -> Nullable seq -> seq
ncons x xs = nonNull $ cons x xs
nuncons :: (NonNull seq, IsSequence (Nullable seq)) => 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 :: (IsSequence (Nullable seq), NonNull seq) => 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 :: (NonNull seq, IsSequence (Nullable seq))
=> (Element seq -> Bool) -> seq -> Nullable seq
nfilter f = filter f . toNullable
nfilterM :: (NonNull seq, Monad m, IsSequence (Nullable seq))
=> (Element seq -> m Bool) -> seq -> m (Nullable seq)
nfilterM f = filterM f . toNullable
nReplicate :: (NonNull seq, Num (Index (Nullable seq)), Ord (Index (Nullable seq)), IsSequence (Nullable seq))
=> Index (Nullable seq) -> Element seq -> seq
nReplicate i = nonNull . replicate (max 1 i)
head :: (MonoFoldable (Nullable seq), NonNull seq) => seq -> Element seq
head = headEx . toNullable
tail :: (IsSequence (Nullable seq), NonNull seq) => seq -> Nullable seq
tail = tailEx . toNullable
last :: (MonoFoldable (Nullable seq), NonNull seq) => seq -> Element seq
last = lastEx . toNullable
init :: (IsSequence (Nullable seq), NonNull seq) => seq -> Nullable seq
init = initEx . toNullable
instance NonNull (NE.NonEmpty a) where
type Nullable (NE.NonEmpty a) = [a]
fromNullable = NE.nonEmpty
nonNull = NE.fromList
toNullable = NE.toList
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)
instance MonoTraversable seq => MonoTraversable (NotEmpty seq) where
otraverse f = fmap NotEmpty . otraverse f . fromNotEmpty
omapM f = liftM NotEmpty . omapM f . fromNotEmpty
asNotEmpty :: NotEmpty a -> NotEmpty a
asNotEmpty = id
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 MonoFoldable seq => NonNull (NotEmpty seq) where
type Nullable (NotEmpty seq) = seq
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
infixr 5 <|
(<|) :: (SemiSequence (Nullable seq), NonNull seq) => Element seq -> seq -> seq
x <| y = ncons x (toNullable y)
ofoldMap1 :: (NonNull seq, Semigroup m) => (Element seq -> m) -> seq -> m
ofoldMap1 f = ofoldMap1Ex f . toNullable
ofold1 :: (NonNull seq, Semigroup (Element seq)) => seq -> Element seq
ofold1 = ofoldMap1 id
ofoldr1 :: NonNull seq => (Element seq -> Element seq -> Element seq) -> seq -> Element seq
ofoldr1 f = ofoldr1Ex f . toNullable
ofoldl1' :: NonNull seq => (Element seq -> Element seq -> Element seq) -> seq -> Element seq
ofoldl1' f = ofoldl1Ex' f . toNullable
maximum :: (MonoFoldableOrd (Nullable seq), NonNull seq) => seq -> Element seq
maximum = maximumEx . toNullable
minimum :: (MonoFoldableOrd (Nullable seq), NonNull seq) => seq -> Element seq
minimum = minimumEx . toNullable
maximumBy :: (MonoFoldableOrd (Nullable seq), NonNull seq)
=> (Element seq -> Element seq -> Ordering) -> seq -> Element seq
maximumBy cmp = maximumByEx cmp . toNullable
minimumBy :: (MonoFoldableOrd (Nullable seq), NonNull seq)
=> (Element seq -> Element seq -> Ordering) -> seq -> Element seq
minimumBy cmp = minimumByEx cmp . toNullable