{-# LANGUAGE LambdaCase             #-}
{-# LANGUAGE PatternSynonyms        #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE ViewPatterns           #-}

-- |
-- Module      : Data.Containers.NonEmpty
-- Copyright   : (c) Justin Le 2018
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- = Non-Empty Typeclass
--
-- Provides the typeclass 'HasNonEmpty', which abstracts over different
-- types which have a "non-empty" variant.
--
-- Used to convert between and in between possibly-empty and non-empty
-- types.  Instances are provided for all modules in this package, as well
-- as for 'NonEmpty' in /base/ and 'NonEmptyVector'.
module Data.Containers.NonEmpty (
    HasNonEmpty(..)
  , pattern IsNonEmpty, pattern IsEmpty
  , overNonEmpty
  , onNonEmpty
  ) where

import           Data.IntMap            (IntMap)
import           Data.IntMap.NonEmpty   (NEIntMap)
import           Data.IntSet            (IntSet)
import           Data.IntSet.NonEmpty   (NEIntSet)
import           Data.List.NonEmpty     (NonEmpty(..))
import           Data.Map               (Map)
import           Data.Map.NonEmpty      (NEMap)
import           Data.Maybe
import           Data.Sequence          (Seq(..))
import           Data.Sequence.NonEmpty (NESeq(..))
import           Data.Set               (Set)
import           Data.Set.NonEmpty      (NESet)
import           Data.Vector            (Vector)
import           Data.Vector.NonEmpty   (NonEmptyVector)
import qualified Data.IntMap            as IM
import qualified Data.IntMap.NonEmpty   as NEIM
import qualified Data.IntSet            as IS
import qualified Data.IntSet.NonEmpty   as NEIS
import qualified Data.List.NonEmpty     as NE
import qualified Data.Map               as M
import qualified Data.Map.NonEmpty      as NEM
import qualified Data.Sequence          as Seq
import qualified Data.Sequence.NonEmpty as NESeq
import qualified Data.Set               as S
import qualified Data.Set.NonEmpty      as NES
import qualified Data.Vector            as V
import qualified Data.Vector.NonEmpty   as NEV

-- | If @s@ is an instance of @HasNonEmpty@, it means that there is
-- a corresponding "non-empty" version of @s@, @'NE' s@.
--
-- In order for things to be well-behaved, we expect that 'nonEmpty' and
-- @maybe 'empty' 'fromNonEmpty'@ should form an isomorphism (or that
-- @'withNonEmpty' 'empty' 'fromNonEmpty' == id@.  In addition,
-- the following properties should hold for most exectations:
--
-- *    @(x == empty) ==> isEmpty x@
-- *    @(x == empty) ==> isNothing (nonEmpty x)@
-- *    @isEmpty x    ==> isNothing (nonEmpty x)@
-- *    @unsafeToNonEmpty x == fromJust (nonEmpty x)@
-- *    Usually, @not (isEmpty x) ==> isJust (nonEmpty x)@, but this isn't
--      necessary.
class HasNonEmpty s where
    {-# MINIMAL (nonEmpty | withNonEmpty), fromNonEmpty, empty #-}

    -- | @'NE' s@ is the "non-empty" version of @s@.
    type NE s = t | t -> s

    -- | "Smart constructor" for @'NE' s@ given a (potentailly empty) @s@.
    -- Will return 'Nothing' if the @s@ was empty, and @'Just' n@ if the
    -- @s@ was not empty, with @n :: 'NE' s@.
    --
    -- Should form an isomorphism with @'maybe' 'empty' 'fromNonEmpty'@.
    nonEmpty         :: s -> Maybe (NE s)
    nonEmpty = Maybe (NE s) -> (NE s -> Maybe (NE s)) -> s -> Maybe (NE s)
forall s r. HasNonEmpty s => r -> (NE s -> r) -> s -> r
withNonEmpty Maybe (NE s)
forall a. Maybe a
Nothing NE s -> Maybe (NE s)
forall a. a -> Maybe a
Just

    -- | Convert a @'NE' s@ (non-empty @s@) back into an @s@, "obscuring"
    -- its non-emptiness from its type.
    fromNonEmpty     :: NE s -> s

    -- | Continuation-based version of 'nonEmpty', which can be more
    -- efficient in certain situations.
    --
    -- @'withNonEmpty' 'empty' 'fromNonEmpty'@ should be @id@.
    withNonEmpty     :: r -> (NE s -> r) -> s -> r
    withNonEmpty r
def NE s -> r
f = r -> (NE s -> r) -> Maybe (NE s) -> r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe r
def NE s -> r
f (Maybe (NE s) -> r) -> (s -> Maybe (NE s)) -> s -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe (NE s)
forall s. HasNonEmpty s => s -> Maybe (NE s)
nonEmpty

    -- | An empty @s@.
    empty            :: s

    -- | Check if an @s@ is empty.
    isEmpty :: s -> Bool
    isEmpty = Maybe (NE s) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (NE s) -> Bool) -> (s -> Maybe (NE s)) -> s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe (NE s)
forall s. HasNonEmpty s => s -> Maybe (NE s)
nonEmpty

    -- | Unsafely coerce an @s@ into an @'NE' s@ (non-empty @s@).  Is
    -- undefined (throws a runtime exception when evaluation is attempted)
    -- when the @s@ is empty.
    unsafeToNonEmpty :: s -> NE s
    unsafeToNonEmpty = NE s -> Maybe (NE s) -> NE s
forall a. a -> Maybe a -> a
fromMaybe NE s
forall a. a
e (Maybe (NE s) -> NE s) -> (s -> Maybe (NE s)) -> s -> NE s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe (NE s)
forall s. HasNonEmpty s => s -> Maybe (NE s)
nonEmpty
      where
        e :: a
e = [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"unsafeToNonEmpty: empty input provided"

-- | Useful function for mapping over the "non-empty" representation of
-- a type.
--
-- @since 0.3.3.0
overNonEmpty :: (HasNonEmpty s, HasNonEmpty t) => (NE s -> NE t) -> s -> t
overNonEmpty :: (NE s -> NE t) -> s -> t
overNonEmpty NE s -> NE t
f = t -> (NE s -> t) -> s -> t
forall s r. HasNonEmpty s => r -> (NE s -> r) -> s -> r
withNonEmpty t
forall s. HasNonEmpty s => s
empty (NE t -> t
forall s. HasNonEmpty s => NE s -> s
fromNonEmpty (NE t -> t) -> (NE s -> NE t) -> NE s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NE s -> NE t
f)

-- | Useful function for applying a function on the "non-empty"
-- representation of a type.
--
-- If you want a continuation taking @'NE' s -> 'Maybe r'@, you can
-- use @'withNonEmpty' 'Nothing'@.
--
-- @since 0.3.3.0
onNonEmpty :: HasNonEmpty s => (NE s -> r) -> s -> Maybe r
onNonEmpty :: (NE s -> r) -> s -> Maybe r
onNonEmpty NE s -> r
f = Maybe r -> (NE s -> Maybe r) -> s -> Maybe r
forall s r. HasNonEmpty s => r -> (NE s -> r) -> s -> r
withNonEmpty Maybe r
forall a. Maybe a
Nothing (r -> Maybe r
forall a. a -> Maybe a
Just (r -> Maybe r) -> (NE s -> r) -> NE s -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NE s -> r
f)

instance HasNonEmpty [a] where
    type NE [a] = NonEmpty a
    nonEmpty :: [a] -> Maybe (NE [a])
nonEmpty         = [a] -> Maybe (NE [a])
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
    fromNonEmpty :: NE [a] -> [a]
fromNonEmpty     = NE [a] -> [a]
forall a. NonEmpty a -> [a]
NE.toList
    withNonEmpty :: r -> (NE [a] -> r) -> [a] -> r
withNonEmpty r
def NE [a] -> r
f = \case
      []   -> r
def
      a
x:[a]
xs -> NE [a] -> r
f (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs)
    empty :: [a]
empty            = []
    isEmpty :: [a] -> Bool
isEmpty          = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
    unsafeToNonEmpty :: [a] -> NE [a]
unsafeToNonEmpty = [a] -> NE [a]
forall a. [a] -> NonEmpty a
NE.fromList

instance HasNonEmpty (Map k a) where
    type NE (Map k a) = NEMap k a
    nonEmpty :: Map k a -> Maybe (NE (Map k a))
nonEmpty         = Map k a -> Maybe (NE (Map k a))
forall k a. Map k a -> Maybe (NEMap k a)
NEM.nonEmptyMap
    fromNonEmpty :: NE (Map k a) -> Map k a
fromNonEmpty     = NE (Map k a) -> Map k a
forall k a. NEMap k a -> Map k a
NEM.toMap
    withNonEmpty :: r -> (NE (Map k a) -> r) -> Map k a -> r
withNonEmpty     = r -> (NE (Map k a) -> r) -> Map k a -> r
forall r k a. r -> (NEMap k a -> r) -> Map k a -> r
NEM.withNonEmpty
    empty :: Map k a
empty            = Map k a
forall k a. Map k a
M.empty
    isEmpty :: Map k a -> Bool
isEmpty          = Map k a -> Bool
forall k a. Map k a -> Bool
M.null
    unsafeToNonEmpty :: Map k a -> NE (Map k a)
unsafeToNonEmpty = Map k a -> NE (Map k a)
forall k a. Map k a -> NEMap k a
NEM.unsafeFromMap

instance HasNonEmpty (IntMap a) where
    type NE (IntMap a) = NEIntMap a
    nonEmpty :: IntMap a -> Maybe (NE (IntMap a))
nonEmpty         = IntMap a -> Maybe (NE (IntMap a))
forall a. IntMap a -> Maybe (NEIntMap a)
NEIM.nonEmptyMap
    fromNonEmpty :: NE (IntMap a) -> IntMap a
fromNonEmpty     = NE (IntMap a) -> IntMap a
forall a. NEIntMap a -> IntMap a
NEIM.toMap
    withNonEmpty :: r -> (NE (IntMap a) -> r) -> IntMap a -> r
withNonEmpty     = r -> (NE (IntMap a) -> r) -> IntMap a -> r
forall r a. r -> (NEIntMap a -> r) -> IntMap a -> r
NEIM.withNonEmpty
    empty :: IntMap a
empty            = IntMap a
forall a. IntMap a
IM.empty
    isEmpty :: IntMap a -> Bool
isEmpty          = IntMap a -> Bool
forall a. IntMap a -> Bool
IM.null
    unsafeToNonEmpty :: IntMap a -> NE (IntMap a)
unsafeToNonEmpty = IntMap a -> NE (IntMap a)
forall a. IntMap a -> NEIntMap a
NEIM.unsafeFromMap

instance HasNonEmpty (Set a) where
    type NE (Set a) = NESet a
    nonEmpty :: Set a -> Maybe (NE (Set a))
nonEmpty         = Set a -> Maybe (NE (Set a))
forall a. Set a -> Maybe (NESet a)
NES.nonEmptySet
    fromNonEmpty :: NE (Set a) -> Set a
fromNonEmpty     = NE (Set a) -> Set a
forall a. NESet a -> Set a
NES.toSet
    withNonEmpty :: r -> (NE (Set a) -> r) -> Set a -> r
withNonEmpty     = r -> (NE (Set a) -> r) -> Set a -> r
forall r a. r -> (NESet a -> r) -> Set a -> r
NES.withNonEmpty
    empty :: Set a
empty            = Set a
forall a. Set a
S.empty
    isEmpty :: Set a -> Bool
isEmpty          = Set a -> Bool
forall a. Set a -> Bool
S.null
    unsafeToNonEmpty :: Set a -> NE (Set a)
unsafeToNonEmpty = Set a -> NE (Set a)
forall a. Set a -> NESet a
NES.unsafeFromSet

instance HasNonEmpty IntSet where
    type NE IntSet = NEIntSet
    nonEmpty :: IntSet -> Maybe (NE IntSet)
nonEmpty         = IntSet -> Maybe NEIntSet
IntSet -> Maybe (NE IntSet)
NEIS.nonEmptySet
    fromNonEmpty :: NE IntSet -> IntSet
fromNonEmpty     = NEIntSet -> IntSet
NE IntSet -> IntSet
NEIS.toSet
    withNonEmpty :: r -> (NE IntSet -> r) -> IntSet -> r
withNonEmpty     = r -> (NE IntSet -> r) -> IntSet -> r
forall r. r -> (NEIntSet -> r) -> IntSet -> r
NEIS.withNonEmpty
    empty :: IntSet
empty            = IntSet
IS.empty
    isEmpty :: IntSet -> Bool
isEmpty          = IntSet -> Bool
IS.null
    unsafeToNonEmpty :: IntSet -> NE IntSet
unsafeToNonEmpty = IntSet -> NEIntSet
IntSet -> NE IntSet
NEIS.unsafeFromSet

instance HasNonEmpty (Seq a) where
    type NE (Seq a) = NESeq a
    nonEmpty :: Seq a -> Maybe (NE (Seq a))
nonEmpty         = Seq a -> Maybe (NE (Seq a))
forall a. Seq a -> Maybe (NESeq a)
NESeq.nonEmptySeq
    fromNonEmpty :: NE (Seq a) -> Seq a
fromNonEmpty     = NE (Seq a) -> Seq a
forall a. NESeq a -> Seq a
NESeq.toSeq
    withNonEmpty :: r -> (NE (Seq a) -> r) -> Seq a -> r
withNonEmpty     = r -> (NE (Seq a) -> r) -> Seq a -> r
forall r a. r -> (NESeq a -> r) -> Seq a -> r
NESeq.withNonEmpty
    empty :: Seq a
empty            = Seq a
forall a. Seq a
Seq.empty
    isEmpty :: Seq a -> Bool
isEmpty          = Seq a -> Bool
forall a. Seq a -> Bool
Seq.null
    unsafeToNonEmpty :: Seq a -> NE (Seq a)
unsafeToNonEmpty = Seq a -> NE (Seq a)
forall a. Seq a -> NESeq a
NESeq.unsafeFromSeq

instance HasNonEmpty (Vector a) where
    type NE (Vector a) = NonEmptyVector a
    nonEmpty :: Vector a -> Maybe (NE (Vector a))
nonEmpty           = Vector a -> Maybe (NE (Vector a))
forall a. Vector a -> Maybe (NonEmptyVector a)
NEV.fromVector
    fromNonEmpty :: NE (Vector a) -> Vector a
fromNonEmpty       = NE (Vector a) -> Vector a
forall a. NonEmptyVector a -> Vector a
NEV.toVector
    empty :: Vector a
empty              = Vector a
forall a. Vector a
V.empty
    isEmpty :: Vector a -> Bool
isEmpty            = Vector a -> Bool
forall a. Vector a -> Bool
V.null

-- | The 'IsNonEmpty' and 'IsEmpty' patterns allow you to treat a @s@ as
-- if it were either a @'IsNonEmpty' n@ (where @n@ is a non-empty version
-- of @s@, type @'NE' s@) or an 'IsEmpty'.
--
-- For example, you can pattern match on a list to get a 'NonEmpty'
-- (non-empty list):
--
-- @
-- safeHead :: [Int] -> Int
-- safeHead ('IsNonEmpty' (x :| _)) = x     -- here, the list was not empty
-- safehead 'IsEmpty'               = 0     -- here, the list was empty
-- @
--
-- Matching on @'IsNonEmpty' n@ means that the original input was /not/
-- empty, and you have a verified-non-empty @n :: 'NE' s@ to use.
--
-- Note that because of the way coverage checking works for polymorphic
-- pattern synonyms, you will unfortunatelly still get incomplete pattern
-- match warnings if you match on both 'IsNonEmpty' and 'NonEmpty', even
-- though the two are meant to provide complete coverage.  However, many
-- instances of 'HasNonEmpty' (like 'NEMap', 'NEIntMap', 'NESet',
-- 'NEIntSet') will provide their own monomorphic versions of these
-- patterns that can be verified as complete covers by GHC.
--
-- This is a bidirectional pattern, so you can use 'IsNonEmpty' to convert
-- a @'NE' s@ back into an @s@, "obscuring" its non-emptiness (see
-- 'fromNonEmpty').
pattern IsNonEmpty :: HasNonEmpty s => NE s -> s
pattern $bIsNonEmpty :: NE s -> s
$mIsNonEmpty :: forall r s. HasNonEmpty s => s -> (NE s -> r) -> (Void# -> r) -> r
IsNonEmpty n <- (nonEmpty->Just n)
  where
    IsNonEmpty NE s
n = NE s -> s
forall s. HasNonEmpty s => NE s -> s
fromNonEmpty NE s
n

-- | The 'IsNonEmpty' and 'IsEmpty' patterns allow you to treat a @s@ as
-- if it were either a @'IsNonEmpty' n@ (where @n@ is a non-empty version
-- of @s@, type @'NE' s@) or an 'IsEmpty'.
--
-- Matching on 'IsEmpty' means that the original item was empty.
--
-- This is a bidirectional pattern, so you can use 'IsEmpty' as an
-- expression, and it will be interpreted as 'empty'.
--
-- Note that because of the way coverage checking works for polymorphic
-- pattern synonyms, you will unfortunatelly still get incomplete pattern
-- match warnings if you match on both 'IsNonEmpty' and 'NonEmpty', even
-- though the two are meant to provide complete coverage.  However, many
-- instances of 'HasNonEmpty' (like 'NEMap', 'NEIntMap', 'NESet',
-- 'NEIntSet') will provide their own monomorphic versions of these
-- patterns that can be verified as complete covers by GHC.
--
-- See 'IsNonEmpty' for more information.
pattern IsEmpty :: HasNonEmpty s => s
pattern $bIsEmpty :: s
$mIsEmpty :: forall r s. HasNonEmpty s => s -> (Void# -> r) -> (Void# -> r) -> r
IsEmpty <- (isEmpty->True)
  where
    IsEmpty = s
forall s. HasNonEmpty s => s
empty