{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# 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 qualified Data.IntMap as IM
import Data.IntMap.NonEmpty (NEIntMap)
import qualified Data.IntMap.NonEmpty as NEIM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import Data.IntSet.NonEmpty (NEIntSet)
import qualified Data.IntSet.NonEmpty as NEIS
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Map (Map)
import qualified Data.Map as M
import Data.Map.NonEmpty (NEMap)
import qualified Data.Map.NonEmpty as NEM
import Data.Maybe
import Data.Sequence (Seq (..))
import qualified Data.Sequence as Seq
import Data.Sequence.NonEmpty (NESeq (..))
import qualified Data.Sequence.NonEmpty as NESeq
import Data.Set (Set)
import qualified Data.Set as S
import Data.Set.NonEmpty (NESet)
import qualified Data.Set.NonEmpty as NES
import Data.Vector (Vector)
import qualified Data.Vector as V
import Data.Vector.NonEmpty (NonEmptyVector)
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 r. r -> (NE s -> r) -> s -> r
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 :: forall s t.
(HasNonEmpty s, HasNonEmpty t) =>
(NE s -> NE t) -> s -> t
overNonEmpty NE s -> NE t
f = t -> (NE s -> t) -> s -> t
forall r. r -> (NE s -> r) -> s -> r
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 :: forall s r. HasNonEmpty s => (NE s -> r) -> s -> Maybe r
onNonEmpty NE s -> r
f = Maybe r -> (NE s -> Maybe r) -> s -> Maybe r
forall r. r -> (NE s -> r) -> s -> 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 (NonEmpty a)
[a] -> Maybe (NE [a])
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
  fromNonEmpty :: NE [a] -> [a]
fromNonEmpty = NonEmpty a -> [a]
NE [a] -> [a]
forall a. NonEmpty a -> [a]
NE.toList
  withNonEmpty :: forall r. 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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
  unsafeToNonEmpty :: [a] -> NE [a]
unsafeToNonEmpty = [a] -> NonEmpty a
[a] -> NE [a]
forall a. HasCallStack => [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 (NEMap k a)
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 = NEMap k a -> Map k a
NE (Map k a) -> Map k a
forall k a. NEMap k a -> Map k a
NEM.toMap
  withNonEmpty :: forall r. r -> (NE (Map k a) -> r) -> Map k a -> r
withNonEmpty = r -> (NEMap k a -> r) -> Map k a -> r
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 -> NEMap k a
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 (NEIntMap a)
IntMap a -> Maybe (NE (IntMap a))
forall a. IntMap a -> Maybe (NEIntMap a)
NEIM.nonEmptyMap
  fromNonEmpty :: NE (IntMap a) -> IntMap a
fromNonEmpty = NEIntMap a -> IntMap a
NE (IntMap a) -> IntMap a
forall a. NEIntMap a -> IntMap a
NEIM.toMap
  withNonEmpty :: forall r. r -> (NE (IntMap a) -> r) -> IntMap a -> r
withNonEmpty = r -> (NEIntMap a -> r) -> IntMap a -> r
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 -> NEIntMap a
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 (NESet a)
Set a -> Maybe (NE (Set a))
forall a. Set a -> Maybe (NESet a)
NES.nonEmptySet
  fromNonEmpty :: NE (Set a) -> Set a
fromNonEmpty = NESet a -> Set a
NE (Set a) -> Set a
forall a. NESet a -> Set a
NES.toSet
  withNonEmpty :: forall r. r -> (NE (Set a) -> r) -> Set a -> r
withNonEmpty = r -> (NESet a -> r) -> Set a -> r
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 -> NESet a
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 :: forall r. r -> (NE IntSet -> r) -> IntSet -> r
withNonEmpty = r -> (NEIntSet -> r) -> IntSet -> r
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 (NESeq a)
Seq a -> Maybe (NE (Seq a))
forall a. Seq a -> Maybe (NESeq a)
NESeq.nonEmptySeq
  fromNonEmpty :: NE (Seq a) -> Seq a
fromNonEmpty = NESeq a -> Seq a
NE (Seq a) -> Seq a
forall a. NESeq a -> Seq a
NESeq.toSeq
  withNonEmpty :: forall r. r -> (NE (Seq a) -> r) -> Seq a -> r
withNonEmpty = r -> (NESeq a -> r) -> Seq a -> r
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 -> NESeq a
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 (NonEmptyVector a)
Vector a -> Maybe (NE (Vector a))
forall a. Vector a -> Maybe (NonEmptyVector a)
NEV.fromVector
  fromNonEmpty :: NE (Vector a) -> Vector a
fromNonEmpty = NonEmptyVector a -> Vector a
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 $mIsNonEmpty :: forall {r} {s}.
HasNonEmpty s =>
s -> (NE s -> r) -> ((# #) -> r) -> r
$bIsNonEmpty :: forall s. HasNonEmpty s => NE s -> s
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 $mIsEmpty :: forall {r} {s}.
HasNonEmpty s =>
s -> ((# #) -> r) -> ((# #) -> r) -> r
$bIsEmpty :: forall s. HasNonEmpty s => s
IsEmpty <- (isEmpty -> True)
  where
    IsEmpty = s
forall s. HasNonEmpty s => s
empty