{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.NonNull (
NonNull
, fromNullable
, impureNonNull
, nonNull
, toNullable
, fromNonEmpty
, ncons
, nuncons
, splitFirst
, nfilter
, nfilterM
, nReplicate
, head
, tail
, last
, init
, ofoldMap1
, ofold1
, ofoldr1
, ofoldl1'
, maximum
, maximumBy
, minimum
, minimumBy
, (<|)
, toMinList
, mapNonNull
, GrowingAppend
) where
import Prelude hiding (head, tail, init, last, reverse, seq, filter, replicate, maximum, minimum)
import Control.Arrow (second)
import Control.Exception.Base (Exception, throw)
#if !MIN_VERSION_base(4,8,0)
import Control.Monad (liftM)
#endif
import Data.Data
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromMaybe)
import Data.MonoTraversable
import Data.Sequences
import Data.Semigroup (Semigroup (..))
import Control.Monad.Trans.State.Strict (evalState, state)
data NullError = NullError String deriving (Show, Typeable)
instance Exception NullError
newtype NonNull mono = NonNull
{ toNullable :: mono
}
deriving (Eq, Ord, Read, Show, Data, Typeable)
type instance Element (NonNull mono) = Element mono
deriving instance MonoFunctor mono => MonoFunctor (NonNull mono)
deriving instance MonoFoldable mono => MonoFoldable (NonNull mono)
instance MonoTraversable mono => MonoTraversable (NonNull mono) where
otraverse f (NonNull x) = fmap NonNull (otraverse f x)
{-# INLINE otraverse #-}
#if !MIN_VERSION_base(4,8,0)
omapM f (NonNull x) = liftM NonNull (omapM f x)
{-# INLINE omapM #-}
#endif
instance GrowingAppend mono => GrowingAppend (NonNull mono)
instance (Semigroup mono, GrowingAppend mono) => Semigroup (NonNull mono) where
NonNull x <> NonNull y = NonNull (x <> y)
instance SemiSequence seq => SemiSequence (NonNull seq) where
type Index (NonNull seq) = Index seq
intersperse e = unsafeMap $ intersperse e
reverse = unsafeMap reverse
find f = find f . toNullable
cons x = unsafeMap $ cons x
snoc xs x = unsafeMap (flip snoc x) xs
sortBy f = unsafeMap $ sortBy f
unsafeMap :: (mono -> mono) -> NonNull mono -> NonNull mono
unsafeMap f (NonNull x) = NonNull (f x)
instance MonoPointed mono => MonoPointed (NonNull mono) where
opoint = NonNull . opoint
{-# INLINE opoint #-}
instance IsSequence mono => MonoComonad (NonNull mono) where
oextract = head
oextend f (NonNull mono) = NonNull
. flip evalState mono
. ofor mono
. const
. state
$ \mono' -> (f (NonNull mono'), tailEx mono')
fromNullable :: MonoFoldable mono => mono -> Maybe (NonNull mono)
fromNullable mono
| onull mono = Nothing
| otherwise = Just (NonNull mono)
impureNonNull :: MonoFoldable mono => mono -> NonNull mono
impureNonNull nullable =
fromMaybe (throw $ NullError "Data.NonNull.impureNonNull (NonNull default): expected non-null")
$ fromNullable nullable
nonNull :: MonoFoldable mono => mono -> NonNull mono
nonNull = impureNonNull
{-# DEPRECATED nonNull "Please use the more explicit impureNonNull instead" #-}
fromNonEmpty :: IsSequence seq => NE.NonEmpty (Element seq) -> NonNull seq
fromNonEmpty = impureNonNull . fromList . NE.toList
{-# INLINE fromNonEmpty #-}
toMinList :: NE.NonEmpty a -> NonNull [a]
toMinList = fromNonEmpty
ncons :: SemiSequence seq => Element seq -> seq -> NonNull seq
ncons x xs = nonNull $ cons x xs
nuncons :: IsSequence seq => NonNull seq -> (Element seq, Maybe (NonNull seq))
nuncons xs =
second fromNullable
$ fromMaybe (error "Data.NonNull.nuncons: data structure is null, it should be non-null")
$ uncons (toNullable xs)
splitFirst :: IsSequence seq => NonNull seq -> (Element seq, seq)
splitFirst xs =
fromMaybe (error "Data.NonNull.splitFirst: data structure is null, it should be non-null")
$ uncons (toNullable xs)
nfilter :: IsSequence seq => (Element seq -> Bool) -> NonNull seq -> seq
nfilter f = filter f . toNullable
nfilterM :: (Monad m, IsSequence seq) => (Element seq -> m Bool) -> NonNull seq -> m seq
nfilterM f = filterM f . toNullable
nReplicate :: IsSequence seq => Index seq -> Element seq -> NonNull seq
nReplicate i = nonNull . replicate (max 1 i)
tail :: IsSequence seq => NonNull seq -> seq
tail = tailEx . toNullable
{-# INLINE tail #-}
init :: IsSequence seq => NonNull seq -> seq
init = initEx . toNullable
{-# INLINE init #-}
infixr 5 <|
(<|) :: SemiSequence seq => Element seq -> NonNull seq -> NonNull seq
x <| y = ncons x (toNullable y)
head :: MonoFoldable mono => NonNull mono -> Element mono
head = headEx . toNullable
{-# INLINE head #-}
last :: MonoFoldable mono => NonNull mono -> Element mono
last = lastEx . toNullable
{-# INLINE last #-}
ofoldMap1 :: (MonoFoldable mono, Semigroup m) => (Element mono -> m) -> NonNull mono -> m
ofoldMap1 f = ofoldMap1Ex f . toNullable
{-# INLINE ofoldMap1 #-}
ofold1 :: (MonoFoldable mono, Semigroup (Element mono)) => NonNull mono -> Element mono
ofold1 = ofoldMap1 id
{-# INLINE ofold1 #-}
ofoldr1 :: MonoFoldable mono
=> (Element mono -> Element mono -> Element mono)
-> NonNull mono
-> Element mono
ofoldr1 f = ofoldr1Ex f . toNullable
{-# INLINE ofoldr1 #-}
ofoldl1' :: MonoFoldable mono
=> (Element mono -> Element mono -> Element mono)
-> NonNull mono
-> Element mono
ofoldl1' f = ofoldl1Ex' f . toNullable
{-# INLINE ofoldl1' #-}
maximum :: (MonoFoldable mono, Ord (Element mono))
=> NonNull mono
-> Element mono
maximum = maximumEx . toNullable
{-# INLINE maximum #-}
minimum :: (MonoFoldable mono, Ord (Element mono))
=> NonNull mono
-> Element mono
minimum = minimumEx . toNullable
{-# INLINE minimum #-}
maximumBy :: MonoFoldable mono
=> (Element mono -> Element mono -> Ordering)
-> NonNull mono
-> Element mono
maximumBy cmp = maximumByEx cmp . toNullable
{-# INLINE maximumBy #-}
minimumBy :: MonoFoldable mono
=> (Element mono -> Element mono -> Ordering)
-> NonNull mono
-> Element mono
minimumBy cmp = minimumByEx cmp . toNullable
{-# INLINE minimumBy #-}
mapNonNull :: (Functor f, MonoFoldable (f b))
=> (a -> b)
-> NonNull (f a)
-> NonNull (f b)
mapNonNull f = impureNonNull . fmap f . toNullable