{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | "Data.NonNull" extends the concepts from
-- "Data.List.NonEmpty" to any 'MonoFoldable'.
--
-- 'NonNull' is a newtype wrapper for a container with 1 or more elements.
module Data.NonNull (
    NonNull
  , fromNullable
  , impureNonNull
  , nonNull
  , toNullable
  , fromNonEmpty
  , toNonEmpty
  , 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)
import Data.Data
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromMaybe)
import Data.MonoTraversable
import Data.Sequences
import Control.Monad.Trans.State.Strict (evalState, state)

data NullError = NullError String deriving (Int -> NullError -> ShowS
[NullError] -> ShowS
NullError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NullError] -> ShowS
$cshowList :: [NullError] -> ShowS
show :: NullError -> String
$cshow :: NullError -> String
showsPrec :: Int -> NullError -> ShowS
$cshowsPrec :: Int -> NullError -> ShowS
Show, Typeable)
instance Exception NullError

-- | A monomorphic container that is not null.
newtype NonNull mono = NonNull
    { forall mono. NonNull mono -> mono
toNullable :: mono
    -- ^ __Safely__ convert from a non-null monomorphic container to a nullable monomorphic container.
    }
    deriving (NonNull mono -> NonNull mono -> Bool
forall mono. Eq mono => NonNull mono -> NonNull mono -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonNull mono -> NonNull mono -> Bool
$c/= :: forall mono. Eq mono => NonNull mono -> NonNull mono -> Bool
== :: NonNull mono -> NonNull mono -> Bool
$c== :: forall mono. Eq mono => NonNull mono -> NonNull mono -> Bool
Eq, NonNull mono -> NonNull mono -> Bool
NonNull mono -> NonNull mono -> Ordering
NonNull mono -> NonNull mono -> NonNull mono
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {mono}. Ord mono => Eq (NonNull mono)
forall mono. Ord mono => NonNull mono -> NonNull mono -> Bool
forall mono. Ord mono => NonNull mono -> NonNull mono -> Ordering
forall mono.
Ord mono =>
NonNull mono -> NonNull mono -> NonNull mono
min :: NonNull mono -> NonNull mono -> NonNull mono
$cmin :: forall mono.
Ord mono =>
NonNull mono -> NonNull mono -> NonNull mono
max :: NonNull mono -> NonNull mono -> NonNull mono
$cmax :: forall mono.
Ord mono =>
NonNull mono -> NonNull mono -> NonNull mono
>= :: NonNull mono -> NonNull mono -> Bool
$c>= :: forall mono. Ord mono => NonNull mono -> NonNull mono -> Bool
> :: NonNull mono -> NonNull mono -> Bool
$c> :: forall mono. Ord mono => NonNull mono -> NonNull mono -> Bool
<= :: NonNull mono -> NonNull mono -> Bool
$c<= :: forall mono. Ord mono => NonNull mono -> NonNull mono -> Bool
< :: NonNull mono -> NonNull mono -> Bool
$c< :: forall mono. Ord mono => NonNull mono -> NonNull mono -> Bool
compare :: NonNull mono -> NonNull mono -> Ordering
$ccompare :: forall mono. Ord mono => NonNull mono -> NonNull mono -> Ordering
Ord, ReadPrec [NonNull mono]
ReadPrec (NonNull mono)
ReadS [NonNull mono]
forall mono. Read mono => ReadPrec [NonNull mono]
forall mono. Read mono => ReadPrec (NonNull mono)
forall mono. Read mono => Int -> ReadS (NonNull mono)
forall mono. Read mono => ReadS [NonNull mono]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NonNull mono]
$creadListPrec :: forall mono. Read mono => ReadPrec [NonNull mono]
readPrec :: ReadPrec (NonNull mono)
$creadPrec :: forall mono. Read mono => ReadPrec (NonNull mono)
readList :: ReadS [NonNull mono]
$creadList :: forall mono. Read mono => ReadS [NonNull mono]
readsPrec :: Int -> ReadS (NonNull mono)
$creadsPrec :: forall mono. Read mono => Int -> ReadS (NonNull mono)
Read, Int -> NonNull mono -> ShowS
forall mono. Show mono => Int -> NonNull mono -> ShowS
forall mono. Show mono => [NonNull mono] -> ShowS
forall mono. Show mono => NonNull mono -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonNull mono] -> ShowS
$cshowList :: forall mono. Show mono => [NonNull mono] -> ShowS
show :: NonNull mono -> String
$cshow :: forall mono. Show mono => NonNull mono -> String
showsPrec :: Int -> NonNull mono -> ShowS
$cshowsPrec :: forall mono. Show mono => Int -> NonNull mono -> ShowS
Show, NonNull mono -> DataType
NonNull mono -> Constr
forall {mono}. Data mono => Typeable (NonNull mono)
forall mono. Data mono => NonNull mono -> DataType
forall mono. Data mono => NonNull mono -> Constr
forall mono.
Data mono =>
(forall b. Data b => b -> b) -> NonNull mono -> NonNull mono
forall mono u.
Data mono =>
Int -> (forall d. Data d => d -> u) -> NonNull mono -> u
forall mono u.
Data mono =>
(forall d. Data d => d -> u) -> NonNull mono -> [u]
forall mono r r'.
Data mono =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NonNull mono -> r
forall mono r r'.
Data mono =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NonNull mono -> r
forall mono (m :: * -> *).
(Data mono, Monad m) =>
(forall d. Data d => d -> m d) -> NonNull mono -> m (NonNull mono)
forall mono (m :: * -> *).
(Data mono, MonadPlus m) =>
(forall d. Data d => d -> m d) -> NonNull mono -> m (NonNull mono)
forall mono (c :: * -> *).
Data mono =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (NonNull mono)
forall mono (c :: * -> *).
Data mono =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NonNull mono -> c (NonNull mono)
forall mono (t :: * -> *) (c :: * -> *).
(Data mono, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (NonNull mono))
forall mono (t :: * -> * -> *) (c :: * -> *).
(Data mono, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (NonNull mono))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (NonNull mono)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NonNull mono -> c (NonNull mono)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (NonNull mono))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NonNull mono -> m (NonNull mono)
$cgmapMo :: forall mono (m :: * -> *).
(Data mono, MonadPlus m) =>
(forall d. Data d => d -> m d) -> NonNull mono -> m (NonNull mono)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NonNull mono -> m (NonNull mono)
$cgmapMp :: forall mono (m :: * -> *).
(Data mono, MonadPlus m) =>
(forall d. Data d => d -> m d) -> NonNull mono -> m (NonNull mono)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NonNull mono -> m (NonNull mono)
$cgmapM :: forall mono (m :: * -> *).
(Data mono, Monad m) =>
(forall d. Data d => d -> m d) -> NonNull mono -> m (NonNull mono)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NonNull mono -> u
$cgmapQi :: forall mono u.
Data mono =>
Int -> (forall d. Data d => d -> u) -> NonNull mono -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> NonNull mono -> [u]
$cgmapQ :: forall mono u.
Data mono =>
(forall d. Data d => d -> u) -> NonNull mono -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NonNull mono -> r
$cgmapQr :: forall mono r r'.
Data mono =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NonNull mono -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NonNull mono -> r
$cgmapQl :: forall mono r r'.
Data mono =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NonNull mono -> r
gmapT :: (forall b. Data b => b -> b) -> NonNull mono -> NonNull mono
$cgmapT :: forall mono.
Data mono =>
(forall b. Data b => b -> b) -> NonNull mono -> NonNull mono
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (NonNull mono))
$cdataCast2 :: forall mono (t :: * -> * -> *) (c :: * -> *).
(Data mono, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (NonNull mono))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (NonNull mono))
$cdataCast1 :: forall mono (t :: * -> *) (c :: * -> *).
(Data mono, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (NonNull mono))
dataTypeOf :: NonNull mono -> DataType
$cdataTypeOf :: forall mono. Data mono => NonNull mono -> DataType
toConstr :: NonNull mono -> Constr
$ctoConstr :: forall mono. Data mono => NonNull mono -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (NonNull mono)
$cgunfold :: forall mono (c :: * -> *).
Data mono =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (NonNull mono)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NonNull mono -> c (NonNull mono)
$cgfoldl :: forall mono (c :: * -> *).
Data mono =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NonNull mono -> c (NonNull mono)
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 :: forall (m :: * -> *).
Applicative m =>
(Element (NonNull mono) -> m (Element (NonNull mono)))
-> NonNull mono -> m (NonNull mono)
otraverse Element (NonNull mono) -> f (Element (NonNull mono))
f (NonNull mono
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall mono. mono -> NonNull mono
NonNull (forall mono (f :: * -> *).
(MonoTraversable mono, Applicative f) =>
(Element mono -> f (Element mono)) -> mono -> f mono
otraverse Element (NonNull mono) -> f (Element (NonNull mono))
f mono
x)
    {-# INLINE otraverse #-}

instance GrowingAppend mono => GrowingAppend (NonNull mono)

instance (Semigroup mono, GrowingAppend mono) => Semigroup (NonNull mono) where
    NonNull mono
x <> :: NonNull mono -> NonNull mono -> NonNull mono
<> NonNull mono
y = forall mono. mono -> NonNull mono
NonNull (mono
x forall a. Semigroup a => a -> a -> a
<> mono
y)

instance SemiSequence seq => SemiSequence (NonNull seq) where
    type Index (NonNull seq) = Index seq

    intersperse :: Element (NonNull seq) -> NonNull seq -> NonNull seq
intersperse Element (NonNull seq)
e = forall mono. (mono -> mono) -> NonNull mono -> NonNull mono
unsafeMap forall a b. (a -> b) -> a -> b
$ forall seq. SemiSequence seq => Element seq -> seq -> seq
intersperse Element (NonNull seq)
e
    reverse :: NonNull seq -> NonNull seq
reverse       = forall mono. (mono -> mono) -> NonNull mono -> NonNull mono
unsafeMap forall seq. SemiSequence seq => seq -> seq
reverse
    find :: (Element (NonNull seq) -> Bool)
-> NonNull seq -> Maybe (Element (NonNull seq))
find Element (NonNull seq) -> Bool
f        = forall seq.
SemiSequence seq =>
(Element seq -> Bool) -> seq -> Maybe (Element seq)
find Element (NonNull seq) -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. NonNull mono -> mono
toNullable
    cons :: Element (NonNull seq) -> NonNull seq -> NonNull seq
cons Element (NonNull seq)
x        = forall mono. (mono -> mono) -> NonNull mono -> NonNull mono
unsafeMap forall a b. (a -> b) -> a -> b
$ forall seq. SemiSequence seq => Element seq -> seq -> seq
cons Element (NonNull seq)
x
    snoc :: NonNull seq -> Element (NonNull seq) -> NonNull seq
snoc NonNull seq
xs Element (NonNull seq)
x     = forall mono. (mono -> mono) -> NonNull mono -> NonNull mono
unsafeMap (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall seq. SemiSequence seq => seq -> Element seq -> seq
snoc Element (NonNull seq)
x) NonNull seq
xs
    sortBy :: (Element (NonNull seq) -> Element (NonNull seq) -> Ordering)
-> NonNull seq -> NonNull seq
sortBy Element (NonNull seq) -> Element (NonNull seq) -> Ordering
f      = forall mono. (mono -> mono) -> NonNull mono -> NonNull mono
unsafeMap forall a b. (a -> b) -> a -> b
$ forall seq.
SemiSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
sortBy Element (NonNull seq) -> Element (NonNull seq) -> Ordering
f

-- | This function is unsafe, and must not be exposed from this module.
unsafeMap :: (mono -> mono) -> NonNull mono -> NonNull mono
unsafeMap :: forall mono. (mono -> mono) -> NonNull mono -> NonNull mono
unsafeMap mono -> mono
f (NonNull mono
x) = forall mono. mono -> NonNull mono
NonNull (mono -> mono
f mono
x)

instance MonoPointed mono => MonoPointed (NonNull mono) where
    opoint :: Element (NonNull mono) -> NonNull mono
opoint = forall mono. mono -> NonNull mono
NonNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. MonoPointed mono => Element mono -> mono
opoint
    {-# INLINE opoint #-}
instance IsSequence mono => MonoComonad (NonNull mono) where
        oextract :: NonNull mono -> Element (NonNull mono)
oextract  = forall mono. MonoFoldable mono => NonNull mono -> Element mono
head
        oextend :: (NonNull mono -> Element (NonNull mono))
-> NonNull mono -> NonNull mono
oextend NonNull mono -> Element (NonNull mono)
f (NonNull mono
mono) = forall mono. mono -> NonNull mono
NonNull
                                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState mono
mono
                                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono (f :: * -> *).
(MonoTraversable mono, Applicative f) =>
mono -> (Element mono -> f (Element mono)) -> f mono
ofor mono
mono
                                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
                                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state
                                 forall a b. (a -> b) -> a -> b
$ \mono
mono' -> (NonNull mono -> Element (NonNull mono)
f (forall mono. mono -> NonNull mono
NonNull mono
mono'), forall seq. IsSequence seq => seq -> seq
tailEx mono
mono')

-- | __Safely__ convert from an __unsafe__ monomorphic container to a __safe__
-- non-null monomorphic container.
fromNullable :: MonoFoldable mono => mono -> Maybe (NonNull mono)
fromNullable :: forall mono. MonoFoldable mono => mono -> Maybe (NonNull mono)
fromNullable mono
mono
    | forall mono. MonoFoldable mono => mono -> Bool
onull mono
mono = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just (forall mono. mono -> NonNull mono
NonNull mono
mono)

-- | __Unsafely__ convert from an __unsafe__ monomorphic container to a __safe__
-- non-null monomorphic container.
--
-- Throws an exception if the monomorphic container is empty.
--
-- @since 1.0.0
impureNonNull :: MonoFoldable mono => mono -> NonNull mono
impureNonNull :: forall mono. MonoFoldable mono => mono -> NonNull mono
impureNonNull mono
nullable =
  forall a. a -> Maybe a -> a
fromMaybe (forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ String -> NullError
NullError String
"Data.NonNull.impureNonNull (NonNull default): expected non-null")
          forall a b. (a -> b) -> a -> b
$ forall mono. MonoFoldable mono => mono -> Maybe (NonNull mono)
fromNullable mono
nullable

-- | Old synonym for 'impureNonNull'
nonNull :: MonoFoldable mono => mono -> NonNull mono
nonNull :: forall mono. MonoFoldable mono => mono -> NonNull mono
nonNull = forall mono. MonoFoldable mono => mono -> NonNull mono
impureNonNull
{-# DEPRECATED nonNull "Please use the more explicit impureNonNull instead" #-}

-- | __Safely__ convert from a 'NonEmpty' list to a non-null monomorphic container.
fromNonEmpty :: IsSequence seq => NE.NonEmpty (Element seq) -> NonNull seq
fromNonEmpty :: forall seq. IsSequence seq => NonEmpty (Element seq) -> NonNull seq
fromNonEmpty = forall mono. MonoFoldable mono => mono -> NonNull mono
impureNonNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall seq. IsSequence seq => [Element seq] -> seq
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList
{-# INLINE fromNonEmpty #-}

-- | __Safely__ convert from a 'NonNull' container to a 'NonEmpty' list.
--
-- @since 1.0.15.0
toNonEmpty :: MonoFoldable mono => NonNull mono -> NE.NonEmpty (Element mono)
toNonEmpty :: forall mono.
MonoFoldable mono =>
NonNull mono -> NonEmpty (Element mono)
toNonEmpty = forall a. [a] -> NonEmpty a
NE.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

-- | Specializes 'fromNonEmpty' to lists only.
toMinList :: NE.NonEmpty a -> NonNull [a]
toMinList :: forall a. NonEmpty a -> NonNull [a]
toMinList = forall seq. IsSequence seq => NonEmpty (Element seq) -> NonNull seq
fromNonEmpty

-- | Prepend an element to a 'SemiSequence', creating a non-null 'SemiSequence'.
--
-- Generally this uses cons underneath.
-- cons is not efficient for most data structures.
--
-- Alternatives:
--
-- * if you don't need to cons, use 'fromNullable' or 'nonNull' if you can create your structure in one go.
-- * if you need to cons, you might be able to start off with an efficient data structure such as a 'NonEmpty' List.
--     'fronNonEmpty' will convert that to your data structure using the structure's fromList function.
ncons :: SemiSequence seq => Element seq -> seq -> NonNull seq
ncons :: forall seq. SemiSequence seq => Element seq -> seq -> NonNull seq
ncons Element seq
x seq
xs = forall mono. MonoFoldable mono => mono -> NonNull mono
nonNull forall a b. (a -> b) -> a -> b
$ forall seq. SemiSequence seq => Element seq -> seq -> seq
cons Element seq
x seq
xs

-- | Extract the first element of a sequnce and the rest of the non-null sequence if it exists.
nuncons :: IsSequence seq => NonNull seq -> (Element seq, Maybe (NonNull seq))
nuncons :: forall seq.
IsSequence seq =>
NonNull seq -> (Element seq, Maybe (NonNull seq))
nuncons NonNull seq
xs =
  forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall mono. MonoFoldable mono => mono -> Maybe (NonNull mono)
fromNullable
    forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"Data.NonNull.nuncons: data structure is null, it should be non-null")
              forall a b. (a -> b) -> a -> b
$ forall seq. IsSequence seq => seq -> Maybe (Element seq, seq)
uncons (forall mono. NonNull mono -> mono
toNullable NonNull seq
xs)

-- | Same as 'nuncons' with no guarantee that the rest of the sequence is non-null.
splitFirst :: IsSequence seq => NonNull seq -> (Element seq, seq)
splitFirst :: forall seq. IsSequence seq => NonNull seq -> (Element seq, seq)
splitFirst NonNull seq
xs =
  forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"Data.NonNull.splitFirst: data structure is null, it should be non-null")
          forall a b. (a -> b) -> a -> b
$ forall seq. IsSequence seq => seq -> Maybe (Element seq, seq)
uncons (forall mono. NonNull mono -> mono
toNullable NonNull seq
xs)

-- | Equivalent to @"Data.Sequences".'Data.Sequences.filter'@,
-- but works on non-nullable sequences.
nfilter :: IsSequence seq => (Element seq -> Bool) -> NonNull seq -> seq
nfilter :: forall seq.
IsSequence seq =>
(Element seq -> Bool) -> NonNull seq -> seq
nfilter Element seq -> Bool
f = forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter Element seq -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. NonNull mono -> mono
toNullable

-- | Equivalent to @"Data.Sequences".'Data.Sequences.filterM'@,
-- but works on non-nullable sequences.
nfilterM :: (Monad m, IsSequence seq) => (Element seq -> m Bool) -> NonNull seq -> m seq
nfilterM :: forall (m :: * -> *) seq.
(Monad m, IsSequence seq) =>
(Element seq -> m Bool) -> NonNull seq -> m seq
nfilterM Element seq -> m Bool
f = forall seq (m :: * -> *).
(IsSequence seq, Monad m) =>
(Element seq -> m Bool) -> seq -> m seq
filterM Element seq -> m Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. NonNull mono -> mono
toNullable

-- | Equivalent to @"Data.Sequences".'Data.Sequences.replicate'@
--
-- @i@ must be @> 0@
--
-- @i <= 0@ is treated the same as providing @1@
nReplicate :: IsSequence seq => Index seq -> Element seq -> NonNull seq
nReplicate :: forall seq.
IsSequence seq =>
Index seq -> Element seq -> NonNull seq
nReplicate Index seq
i = forall mono. MonoFoldable mono => mono -> NonNull mono
nonNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall seq. IsSequence seq => Index seq -> Element seq -> seq
replicate (forall a. Ord a => a -> a -> a
max Index seq
1 Index seq
i)

-- | __Safe__ version of 'tailEx', only working on non-nullable sequences.
tail :: IsSequence seq => NonNull seq -> seq
tail :: forall seq. IsSequence seq => NonNull seq -> seq
tail = forall seq. IsSequence seq => seq -> seq
tailEx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. NonNull mono -> mono
toNullable
{-# INLINE tail #-}

-- | __Safe__ version of 'initEx', only working on non-nullable sequences.
init :: IsSequence seq => NonNull seq -> seq
init :: forall seq. IsSequence seq => NonNull seq -> seq
init = forall seq. IsSequence seq => seq -> seq
initEx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. NonNull mono -> mono
toNullable
{-# INLINE init #-}

infixr 5 <|

-- | Prepend an element to a non-null 'SemiSequence'.
(<|) :: SemiSequence seq => Element seq -> NonNull seq -> NonNull seq
Element seq
x <| :: forall seq.
SemiSequence seq =>
Element seq -> NonNull seq -> NonNull seq
<| NonNull seq
y = forall seq. SemiSequence seq => Element seq -> seq -> NonNull seq
ncons Element seq
x (forall mono. NonNull mono -> mono
toNullable NonNull seq
y)

-- | Return the first element of a monomorphic container.
--
-- Safe version of 'headEx', only works on monomorphic containers wrapped in a
-- 'NonNull'.
head :: MonoFoldable mono => NonNull mono -> Element mono
head :: forall mono. MonoFoldable mono => NonNull mono -> Element mono
head = forall mono. MonoFoldable mono => mono -> Element mono
headEx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. NonNull mono -> mono
toNullable
{-# INLINE head #-}

-- | Return the last element of a monomorphic container.
--
-- Safe version of 'lastEx', only works on monomorphic containers wrapped in a
-- 'NonNull'.
last :: MonoFoldable mono => NonNull mono -> Element mono
last :: forall mono. MonoFoldable mono => NonNull mono -> Element mono
last = forall mono. MonoFoldable mono => mono -> Element mono
lastEx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. NonNull mono -> mono
toNullable
{-# INLINE last #-}

-- | Map each element of a monomorphic container to a semigroup, and combine the
-- results.
--
-- Safe version of 'ofoldMap1Ex', only works on monomorphic containers wrapped in a
-- 'NonNull'.
--
-- ==== __Examples__
--
-- @
-- > let xs = ncons ("hello", 1 :: 'Integer') [(" world", 2)]
-- > 'ofoldMap1' 'fst' xs
-- "hello world"
-- @
ofoldMap1 :: (MonoFoldable mono, Semigroup m) => (Element mono -> m) -> NonNull mono -> m
ofoldMap1 :: forall mono m.
(MonoFoldable mono, Semigroup m) =>
(Element mono -> m) -> NonNull mono -> m
ofoldMap1 Element mono -> m
f = forall mono m.
(MonoFoldable mono, Semigroup m) =>
(Element mono -> m) -> mono -> m
ofoldMap1Ex Element mono -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. NonNull mono -> mono
toNullable
{-# INLINE ofoldMap1 #-}

-- | Join a monomorphic container, whose elements are 'Semigroup's, together.
--
-- Safe, only works on monomorphic containers wrapped in a 'NonNull'.
--
-- ==== __Examples__
--
-- @
-- > let xs = ncons "a" ["b", "c"]
-- > xs
-- 'NonNull' {toNullable = ["a","b","c"]}
--
-- > 'ofold1' xs
-- "abc"
-- @
ofold1 :: (MonoFoldable mono, Semigroup (Element mono)) => NonNull mono -> Element mono
ofold1 :: forall mono.
(MonoFoldable mono, Semigroup (Element mono)) =>
NonNull mono -> Element mono
ofold1 = forall mono m.
(MonoFoldable mono, Semigroup m) =>
(Element mono -> m) -> NonNull mono -> m
ofoldMap1 forall a. a -> a
id
{-# INLINE ofold1 #-}

-- | Right-associative fold of a monomorphic container with no base element.
--
-- Safe version of 'ofoldr1Ex', only works on monomorphic containers wrapped in a
-- 'NonNull'.
--
-- @'foldr1' f = "Prelude".'Prelude.foldr1' f . 'otoList'@
--
-- ==== __Examples__
--
-- @
-- > let xs = ncons "a" ["b", "c"]
-- > 'ofoldr1' (++) xs
-- "abc"
-- @
ofoldr1 :: MonoFoldable mono
        => (Element mono -> Element mono -> Element mono)
        -> NonNull mono
        -> Element mono
ofoldr1 :: forall mono.
MonoFoldable mono =>
(Element mono -> Element mono -> Element mono)
-> NonNull mono -> Element mono
ofoldr1 Element mono -> Element mono -> Element mono
f = forall mono.
MonoFoldable mono =>
(Element mono -> Element mono -> Element mono)
-> mono -> Element mono
ofoldr1Ex Element mono -> Element mono -> Element mono
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. NonNull mono -> mono
toNullable
{-# INLINE ofoldr1 #-}

-- | Strict left-associative fold of a monomorphic container with no base
-- element.
--
-- Safe version of 'ofoldl1Ex'', only works on monomorphic containers wrapped in a
-- 'NonNull'.
--
-- @'foldl1'' f = "Prelude".'Prelude.foldl1'' f . 'otoList'@
--
-- ==== __Examples__
--
-- @
-- > let xs = ncons "a" ["b", "c"]
-- > 'ofoldl1'' (++) xs
-- "abc"
-- @
ofoldl1' :: MonoFoldable mono
         => (Element mono -> Element mono -> Element mono)
         -> NonNull mono
         -> Element mono
ofoldl1' :: forall mono.
MonoFoldable mono =>
(Element mono -> Element mono -> Element mono)
-> NonNull mono -> Element mono
ofoldl1' Element mono -> Element mono -> Element mono
f = forall mono.
MonoFoldable mono =>
(Element mono -> Element mono -> Element mono)
-> mono -> Element mono
ofoldl1Ex' Element mono -> Element mono -> Element mono
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. NonNull mono -> mono
toNullable
{-# INLINE ofoldl1' #-}

-- | Get the maximum element of a monomorphic container.
--
-- Safe version of 'maximumEx', only works on monomorphic containers wrapped in a
-- 'NonNull'.
--
-- ==== __Examples__
--
-- @
-- > let xs = ncons 1 [2, 3 :: Int]
-- > 'maximum' xs
-- 3
-- @
maximum :: (MonoFoldable mono, Ord (Element mono))
        => NonNull mono
        -> Element mono
maximum :: forall mono.
(MonoFoldable mono, Ord (Element mono)) =>
NonNull mono -> Element mono
maximum = forall mono.
(MonoFoldable mono, Ord (Element mono)) =>
mono -> Element mono
maximumEx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. NonNull mono -> mono
toNullable
{-# INLINE maximum #-}

-- | Get the minimum element of a monomorphic container.
--
-- Safe version of 'minimumEx', only works on monomorphic containers wrapped in a
-- 'NonNull'.
--
-- ==== __Examples__
--
-- @
-- > let xs = ncons 1 [2, 3 :: Int]
-- > 'minimum' xs
-- 1
-- @
minimum :: (MonoFoldable mono, Ord (Element mono))
        => NonNull mono
        -> Element mono
minimum :: forall mono.
(MonoFoldable mono, Ord (Element mono)) =>
NonNull mono -> Element mono
minimum = forall mono.
(MonoFoldable mono, Ord (Element mono)) =>
mono -> Element mono
minimumEx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. NonNull mono -> mono
toNullable
{-# INLINE minimum #-}

-- | Get the maximum element of a monomorphic container,
-- using a supplied element ordering function.
--
-- Safe version of 'maximumByEx', only works on monomorphic containers wrapped in a
-- 'NonNull'.
maximumBy :: MonoFoldable mono
          => (Element mono -> Element mono -> Ordering)
          -> NonNull mono
          -> Element mono
maximumBy :: forall mono.
MonoFoldable mono =>
(Element mono -> Element mono -> Ordering)
-> NonNull mono -> Element mono
maximumBy Element mono -> Element mono -> Ordering
cmp = forall mono.
MonoFoldable mono =>
(Element mono -> Element mono -> Ordering) -> mono -> Element mono
maximumByEx Element mono -> Element mono -> Ordering
cmp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. NonNull mono -> mono
toNullable
{-# INLINE maximumBy #-}

-- | Get the minimum element of a monomorphic container,
-- using a supplied element ordering function.
--
-- Safe version of 'minimumByEx', only works on monomorphic containers wrapped in a
-- 'NonNull'.
minimumBy :: MonoFoldable mono
          => (Element mono -> Element mono -> Ordering)
          -> NonNull mono
          -> Element mono
minimumBy :: forall mono.
MonoFoldable mono =>
(Element mono -> Element mono -> Ordering)
-> NonNull mono -> Element mono
minimumBy Element mono -> Element mono -> Ordering
cmp = forall mono.
MonoFoldable mono =>
(Element mono -> Element mono -> Ordering) -> mono -> Element mono
minimumByEx Element mono -> Element mono -> Ordering
cmp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. NonNull mono -> mono
toNullable
{-# INLINE minimumBy #-}

-- | 'fmap' over the underlying container in a 'NonNull'.
--
-- @since 1.0.6.0

-- ==== __Examples__
--
-- @
-- > let xs = 'ncons' 1 [2, 3 :: Int]
-- > 'mapNonNull' 'show' xs
-- 'NonNull' {toNullable = [\"1\",\"2\",\"3\"]}
-- @
mapNonNull :: (Functor f, MonoFoldable (f b))
           => (a -> b)
           -> NonNull (f a)
           -> NonNull (f b)
mapNonNull :: forall (f :: * -> *) b a.
(Functor f, MonoFoldable (f b)) =>
(a -> b) -> NonNull (f a) -> NonNull (f b)
mapNonNull a -> b
f = forall mono. MonoFoldable mono => mono -> NonNull mono
impureNonNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall mono. NonNull mono -> mono
toNullable