{-# LANGUAGE FlexibleInstances #-}

-- |
-- Module        : Data.NonEmpty
-- Copyright     : Gautier DI FOLCO
-- License       : BSD2
--
-- Maintainer    : Gautier DI FOLCO <gautier.difolco@gmail.com>
-- Stability     : Unstable
-- Portability   : GHC
--
-- Create NonEmpty version of any container.
module Data.NonEmpty
  ( -- * Base type
    NonEmpty,
    getNonEmpty,
    trustedNonEmpty,

    -- * Singleton constructor
    NonEmptySingleton (..),
    singleton,
    MkNonEmptySingletonApplicative (..),

    -- * From container
    NonEmptyFromContainer (..),
    nonEmpty,
    MkNonEmptyFromContainerFoldable (..),

    -- * Operations
    (<|),
    (|>),
    overNonEmpty,
    overNonEmpty2,
    overNonEmpty3,
    overNonEmpty4,
    overNonEmpty5,
    fmapNonEmpty,
    withNonEmpty,
  )
where

import Data.Maybe(fromJust)
import Data.Kind
import Data.Proxy

-- | NonEmpty proofed value.
newtype NonEmpty a = NonEmpty
  { -- | Extract the NonEmpty proven value
    NonEmpty a -> a
getNonEmpty :: a
  }
  deriving stock (NonEmpty a -> NonEmpty a -> Bool
(NonEmpty a -> NonEmpty a -> Bool)
-> (NonEmpty a -> NonEmpty a -> Bool) -> Eq (NonEmpty a)
forall a. Eq a => NonEmpty a -> NonEmpty a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonEmpty a -> NonEmpty a -> Bool
$c/= :: forall a. Eq a => NonEmpty a -> NonEmpty a -> Bool
== :: NonEmpty a -> NonEmpty a -> Bool
$c== :: forall a. Eq a => NonEmpty a -> NonEmpty a -> Bool
Eq, Eq (NonEmpty a)
Eq (NonEmpty a)
-> (NonEmpty a -> NonEmpty a -> Ordering)
-> (NonEmpty a -> NonEmpty a -> Bool)
-> (NonEmpty a -> NonEmpty a -> Bool)
-> (NonEmpty a -> NonEmpty a -> Bool)
-> (NonEmpty a -> NonEmpty a -> Bool)
-> (NonEmpty a -> NonEmpty a -> NonEmpty a)
-> (NonEmpty a -> NonEmpty a -> NonEmpty a)
-> Ord (NonEmpty a)
NonEmpty a -> NonEmpty a -> Bool
NonEmpty a -> NonEmpty a -> Ordering
NonEmpty a -> NonEmpty a -> NonEmpty a
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 a. Ord a => Eq (NonEmpty a)
forall a. Ord a => NonEmpty a -> NonEmpty a -> Bool
forall a. Ord a => NonEmpty a -> NonEmpty a -> Ordering
forall a. Ord a => NonEmpty a -> NonEmpty a -> NonEmpty a
min :: NonEmpty a -> NonEmpty a -> NonEmpty a
$cmin :: forall a. Ord a => NonEmpty a -> NonEmpty a -> NonEmpty a
max :: NonEmpty a -> NonEmpty a -> NonEmpty a
$cmax :: forall a. Ord a => NonEmpty a -> NonEmpty a -> NonEmpty a
>= :: NonEmpty a -> NonEmpty a -> Bool
$c>= :: forall a. Ord a => NonEmpty a -> NonEmpty a -> Bool
> :: NonEmpty a -> NonEmpty a -> Bool
$c> :: forall a. Ord a => NonEmpty a -> NonEmpty a -> Bool
<= :: NonEmpty a -> NonEmpty a -> Bool
$c<= :: forall a. Ord a => NonEmpty a -> NonEmpty a -> Bool
< :: NonEmpty a -> NonEmpty a -> Bool
$c< :: forall a. Ord a => NonEmpty a -> NonEmpty a -> Bool
compare :: NonEmpty a -> NonEmpty a -> Ordering
$ccompare :: forall a. Ord a => NonEmpty a -> NonEmpty a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (NonEmpty a)
Ord, Int -> NonEmpty a -> ShowS
[NonEmpty a] -> ShowS
NonEmpty a -> String
(Int -> NonEmpty a -> ShowS)
-> (NonEmpty a -> String)
-> ([NonEmpty a] -> ShowS)
-> Show (NonEmpty a)
forall a. Show a => Int -> NonEmpty a -> ShowS
forall a. Show a => [NonEmpty a] -> ShowS
forall a. Show a => NonEmpty a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonEmpty a] -> ShowS
$cshowList :: forall a. Show a => [NonEmpty a] -> ShowS
show :: NonEmpty a -> String
$cshow :: forall a. Show a => NonEmpty a -> String
showsPrec :: Int -> NonEmpty a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NonEmpty a -> ShowS
Show)

instance Semigroup a => Semigroup (NonEmpty a) where
  NonEmpty a
x <> :: NonEmpty a -> NonEmpty a -> NonEmpty a
<> NonEmpty a
y = a -> NonEmpty a
forall a. a -> NonEmpty a
NonEmpty (a -> NonEmpty a) -> a -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y

-- * Operations

-- | Append empty container
(<|) :: Semigroup a => NonEmpty a -> a -> NonEmpty a
NonEmpty a
ne <| :: NonEmpty a -> a -> NonEmpty a
<| a
n = a -> NonEmpty a
forall a. a -> NonEmpty a
NonEmpty (a -> NonEmpty a) -> a -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ a
ne a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
n
{-# INLINE (<|) #-}

infixr 6 <|

-- | Prepend empty container
(|>) :: Semigroup a => a -> NonEmpty a -> NonEmpty a
a
n |> :: a -> NonEmpty a -> NonEmpty a
|> NonEmpty a
ne = a -> NonEmpty a
forall a. a -> NonEmpty a
NonEmpty (a -> NonEmpty a) -> a -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ a
n a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
ne
{-# INLINE (|>) #-}

infixr 6 |>

-- | Wrap and unwrap 'NonEmpty' (unsafe, be sure 'f' is size-conservative)
overNonEmpty :: (a -> b) -> NonEmpty a -> NonEmpty b
overNonEmpty :: (a -> b) -> NonEmpty a -> NonEmpty b
overNonEmpty a -> b
f = b -> NonEmpty b
forall a. a -> NonEmpty a
trustedNonEmpty (b -> NonEmpty b) -> (NonEmpty a -> b) -> NonEmpty a -> NonEmpty b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> b) -> (NonEmpty a -> a) -> NonEmpty a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> a
forall a. NonEmpty a -> a
getNonEmpty
{-# INLINE overNonEmpty #-}

-- | Wrap and unwrap 'NonEmpty' (unsafe, be sure 'f' is size-conservative)
overNonEmpty2 :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
overNonEmpty2 :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
overNonEmpty2 a -> b -> c
f NonEmpty a
a = c -> NonEmpty c
forall a. a -> NonEmpty a
trustedNonEmpty (c -> NonEmpty c) -> (NonEmpty b -> c) -> NonEmpty b -> NonEmpty c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c
f (NonEmpty a -> a
forall a. NonEmpty a -> a
getNonEmpty NonEmpty a
a) (b -> c) -> (NonEmpty b -> b) -> NonEmpty b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty b -> b
forall a. NonEmpty a -> a
getNonEmpty
{-# INLINE overNonEmpty2 #-}

-- | Wrap and unwrap 'NonEmpty' (unsafe, be sure 'f' is size-conservative)
overNonEmpty3 :: (a -> b -> c -> d) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d
overNonEmpty3 :: (a -> b -> c -> d)
-> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d
overNonEmpty3 a -> b -> c -> d
f NonEmpty a
a NonEmpty b
b = d -> NonEmpty d
forall a. a -> NonEmpty a
trustedNonEmpty (d -> NonEmpty d) -> (NonEmpty c -> d) -> NonEmpty c -> NonEmpty d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c -> d
f (NonEmpty a -> a
forall a. NonEmpty a -> a
getNonEmpty NonEmpty a
a) (NonEmpty b -> b
forall a. NonEmpty a -> a
getNonEmpty NonEmpty b
b) (c -> d) -> (NonEmpty c -> c) -> NonEmpty c -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty c -> c
forall a. NonEmpty a -> a
getNonEmpty
{-# INLINE overNonEmpty3 #-}

-- | Wrap and unwrap 'NonEmpty' (unsafe, be sure 'f' is size-conservative)
overNonEmpty4 :: (a -> b -> c -> d -> e) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e
overNonEmpty4 :: (a -> b -> c -> d -> e)
-> NonEmpty a
-> NonEmpty b
-> NonEmpty c
-> NonEmpty d
-> NonEmpty e
overNonEmpty4 a -> b -> c -> d -> e
f NonEmpty a
a NonEmpty b
b NonEmpty c
c = e -> NonEmpty e
forall a. a -> NonEmpty a
trustedNonEmpty (e -> NonEmpty e) -> (NonEmpty d -> e) -> NonEmpty d -> NonEmpty e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c -> d -> e
f (NonEmpty a -> a
forall a. NonEmpty a -> a
getNonEmpty NonEmpty a
a) (NonEmpty b -> b
forall a. NonEmpty a -> a
getNonEmpty NonEmpty b
b) (NonEmpty c -> c
forall a. NonEmpty a -> a
getNonEmpty NonEmpty c
c) (d -> e) -> (NonEmpty d -> d) -> NonEmpty d -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty d -> d
forall a. NonEmpty a -> a
getNonEmpty
{-# INLINE overNonEmpty4 #-}

-- | Wrap and unwrap 'NonEmpty' (unsafe, be sure 'f' is size-conservative)
overNonEmpty5 :: (a -> b -> c -> d -> e -> f) -> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d -> NonEmpty e -> NonEmpty f
overNonEmpty5 :: (a -> b -> c -> d -> e -> f)
-> NonEmpty a
-> NonEmpty b
-> NonEmpty c
-> NonEmpty d
-> NonEmpty e
-> NonEmpty f
overNonEmpty5 a -> b -> c -> d -> e -> f
f NonEmpty a
a NonEmpty b
b NonEmpty c
c NonEmpty d
d = f -> NonEmpty f
forall a. a -> NonEmpty a
trustedNonEmpty (f -> NonEmpty f) -> (NonEmpty e -> f) -> NonEmpty e -> NonEmpty f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c -> d -> e -> f
f (NonEmpty a -> a
forall a. NonEmpty a -> a
getNonEmpty NonEmpty a
a) (NonEmpty b -> b
forall a. NonEmpty a -> a
getNonEmpty NonEmpty b
b) (NonEmpty c -> c
forall a. NonEmpty a -> a
getNonEmpty NonEmpty c
c) (NonEmpty d -> d
forall a. NonEmpty a -> a
getNonEmpty NonEmpty d
d) (e -> f) -> (NonEmpty e -> e) -> NonEmpty e -> f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty e -> e
forall a. NonEmpty a -> a
getNonEmpty
{-# INLINE overNonEmpty5 #-}

-- | 'fmap' over a 'NonEmpty' container
fmapNonEmpty :: Functor f => (a -> b) -> NonEmpty (f a) -> NonEmpty (f b)
fmapNonEmpty :: (a -> b) -> NonEmpty (f a) -> NonEmpty (f b)
fmapNonEmpty a -> b
f = (f a -> f b) -> NonEmpty (f a) -> NonEmpty (f b)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
overNonEmpty ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
{-# INLINE fmapNonEmpty #-}

-- | Apply an unsafe function over empty, which is safe over 'NonEmpty'
withNonEmpty :: (a -> Maybe b) -> NonEmpty a -> b
withNonEmpty :: (a -> Maybe b) -> NonEmpty a -> b
withNonEmpty a -> Maybe b
f = Maybe b -> b
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe b -> b) -> (NonEmpty a -> Maybe b) -> NonEmpty a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
f (a -> Maybe b) -> (NonEmpty a -> a) -> NonEmpty a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> a
forall a. NonEmpty a -> a
getNonEmpty
{-# INLINE withNonEmpty #-}

-- | Trusted value
trustedNonEmpty :: a -> NonEmpty a
trustedNonEmpty :: a -> NonEmpty a
trustedNonEmpty = a -> NonEmpty a
forall a. a -> NonEmpty a
NonEmpty
{-# INLINE trustedNonEmpty #-}

-- | Singleton constructible value
class NonEmptySingleton a where
  type NonEmptySingletonElement a :: Type
  nonEmptySingleton :: Proxy a -> NonEmptySingletonElement a -> a

-- | Build a 'NonEmpty' value from a singleton value
singleton :: NonEmptySingleton a => Proxy a -> NonEmptySingletonElement a -> NonEmpty a
singleton :: Proxy a -> NonEmptySingletonElement a -> NonEmpty a
singleton Proxy a
p = a -> NonEmpty a
forall a. a -> NonEmpty a
trustedNonEmpty (a -> NonEmpty a)
-> (NonEmptySingletonElement a -> a)
-> NonEmptySingletonElement a
-> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> NonEmptySingletonElement a -> a
forall a.
NonEmptySingleton a =>
Proxy a -> NonEmptySingletonElement a -> a
nonEmptySingleton Proxy a
p
{-# INLINE singleton #-}

-- | Build 'NonEmptySingleton' for 'Applicative' defined types
--   to be used with 'DerivingVia':
--
--   > deriving instance NonEmptySingleton [a] via (MkNonEmptySingletonApplicative [a])
newtype MkNonEmptySingletonApplicative a
  = MkNonEmptySingletonApplicative a

instance Applicative f => NonEmptySingleton (f a) where
  type NonEmptySingletonElement (f a) = a
  nonEmptySingleton :: Proxy (f a) -> NonEmptySingletonElement (f a) -> f a
nonEmptySingleton Proxy (f a)
_ = NonEmptySingletonElement (f a) -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- * From container

-- | Used to attempt conversion from possibly empty to 'NonEmpty'.
class NonEmptyFromContainer a where
  isNonEmpty :: a -> Bool

-- | Attempt 'NonEmpty' proof
nonEmpty :: NonEmptyFromContainer a => a -> Maybe (NonEmpty a)
nonEmpty :: a -> Maybe (NonEmpty a)
nonEmpty a
x =
  if a -> Bool
forall a. NonEmptyFromContainer a => a -> Bool
isNonEmpty a
x
    then NonEmpty a -> Maybe (NonEmpty a)
forall a. a -> Maybe a
Just (NonEmpty a -> Maybe (NonEmpty a))
-> NonEmpty a -> Maybe (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ a -> NonEmpty a
forall a. a -> NonEmpty a
trustedNonEmpty a
x
    else Maybe (NonEmpty a)
forall a. Maybe a
Nothing

-- | Build 'MkNonEmptyFromContainerFoldable' for 'Foldable' defined types
--   to be used with 'DerivingVia':
--
--   > deriving instance NonEmptyFromContainer [a] via (MkNonEmptyFromContainerFoldable [a])
newtype MkNonEmptyFromContainerFoldable a
  = MkNonEmptyFromContainerFoldable a

instance Foldable f => NonEmptyFromContainer (f a) where
  isNonEmpty :: f a -> Bool
isNonEmpty = Bool -> Bool
not (Bool -> Bool) -> (f a -> Bool) -> f a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null