{-# LANGUAGE DeriveTraversable #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.List.NotOne
-- Copyright   :  (C) 2024 Koji Miyazato
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Koji Miyazato <viercc@gmail.com>
-- Stability   :  experimental
module Data.List.NotOne where

import Data.Maybe (mapMaybe)
import Data.Foldable (toList)

import Data.Functor.Bind
import Data.Functor.Plus (Alt(..), Plus(..))
import Control.Monad.Isolated

import Data.List.TwoOrMore

-- | List sans singleton
data NotOne a = Zero | Multiple (TwoOrMore a)
  deriving (Int -> NotOne a -> ShowS
[NotOne a] -> ShowS
NotOne a -> String
(Int -> NotOne a -> ShowS)
-> (NotOne a -> String) -> ([NotOne a] -> ShowS) -> Show (NotOne a)
forall a. Show a => Int -> NotOne a -> ShowS
forall a. Show a => [NotOne a] -> ShowS
forall a. Show a => NotOne a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> NotOne a -> ShowS
showsPrec :: Int -> NotOne a -> ShowS
$cshow :: forall a. Show a => NotOne a -> String
show :: NotOne a -> String
$cshowList :: forall a. Show a => [NotOne a] -> ShowS
showList :: [NotOne a] -> ShowS
Show, ReadPrec [NotOne a]
ReadPrec (NotOne a)
Int -> ReadS (NotOne a)
ReadS [NotOne a]
(Int -> ReadS (NotOne a))
-> ReadS [NotOne a]
-> ReadPrec (NotOne a)
-> ReadPrec [NotOne a]
-> Read (NotOne a)
forall a. Read a => ReadPrec [NotOne a]
forall a. Read a => ReadPrec (NotOne a)
forall a. Read a => Int -> ReadS (NotOne a)
forall a. Read a => ReadS [NotOne a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (NotOne a)
readsPrec :: Int -> ReadS (NotOne a)
$creadList :: forall a. Read a => ReadS [NotOne a]
readList :: ReadS [NotOne a]
$creadPrec :: forall a. Read a => ReadPrec (NotOne a)
readPrec :: ReadPrec (NotOne a)
$creadListPrec :: forall a. Read a => ReadPrec [NotOne a]
readListPrec :: ReadPrec [NotOne a]
Read, NotOne a -> NotOne a -> Bool
(NotOne a -> NotOne a -> Bool)
-> (NotOne a -> NotOne a -> Bool) -> Eq (NotOne a)
forall a. Eq a => NotOne a -> NotOne a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => NotOne a -> NotOne a -> Bool
== :: NotOne a -> NotOne a -> Bool
$c/= :: forall a. Eq a => NotOne a -> NotOne a -> Bool
/= :: NotOne a -> NotOne a -> Bool
Eq, Eq (NotOne a)
Eq (NotOne a) =>
(NotOne a -> NotOne a -> Ordering)
-> (NotOne a -> NotOne a -> Bool)
-> (NotOne a -> NotOne a -> Bool)
-> (NotOne a -> NotOne a -> Bool)
-> (NotOne a -> NotOne a -> Bool)
-> (NotOne a -> NotOne a -> NotOne a)
-> (NotOne a -> NotOne a -> NotOne a)
-> Ord (NotOne a)
NotOne a -> NotOne a -> Bool
NotOne a -> NotOne a -> Ordering
NotOne a -> NotOne a -> NotOne 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 (NotOne a)
forall a. Ord a => NotOne a -> NotOne a -> Bool
forall a. Ord a => NotOne a -> NotOne a -> Ordering
forall a. Ord a => NotOne a -> NotOne a -> NotOne a
$ccompare :: forall a. Ord a => NotOne a -> NotOne a -> Ordering
compare :: NotOne a -> NotOne a -> Ordering
$c< :: forall a. Ord a => NotOne a -> NotOne a -> Bool
< :: NotOne a -> NotOne a -> Bool
$c<= :: forall a. Ord a => NotOne a -> NotOne a -> Bool
<= :: NotOne a -> NotOne a -> Bool
$c> :: forall a. Ord a => NotOne a -> NotOne a -> Bool
> :: NotOne a -> NotOne a -> Bool
$c>= :: forall a. Ord a => NotOne a -> NotOne a -> Bool
>= :: NotOne a -> NotOne a -> Bool
$cmax :: forall a. Ord a => NotOne a -> NotOne a -> NotOne a
max :: NotOne a -> NotOne a -> NotOne a
$cmin :: forall a. Ord a => NotOne a -> NotOne a -> NotOne a
min :: NotOne a -> NotOne a -> NotOne a
Ord, (forall a b. (a -> b) -> NotOne a -> NotOne b)
-> (forall a b. a -> NotOne b -> NotOne a) -> Functor NotOne
forall a b. a -> NotOne b -> NotOne a
forall a b. (a -> b) -> NotOne a -> NotOne b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> NotOne a -> NotOne b
fmap :: forall a b. (a -> b) -> NotOne a -> NotOne b
$c<$ :: forall a b. a -> NotOne b -> NotOne a
<$ :: forall a b. a -> NotOne b -> NotOne a
Functor, (forall m. Monoid m => NotOne m -> m)
-> (forall m a. Monoid m => (a -> m) -> NotOne a -> m)
-> (forall m a. Monoid m => (a -> m) -> NotOne a -> m)
-> (forall a b. (a -> b -> b) -> b -> NotOne a -> b)
-> (forall a b. (a -> b -> b) -> b -> NotOne a -> b)
-> (forall b a. (b -> a -> b) -> b -> NotOne a -> b)
-> (forall b a. (b -> a -> b) -> b -> NotOne a -> b)
-> (forall a. (a -> a -> a) -> NotOne a -> a)
-> (forall a. (a -> a -> a) -> NotOne a -> a)
-> (forall a. NotOne a -> [a])
-> (forall a. NotOne a -> Bool)
-> (forall a. NotOne a -> Int)
-> (forall a. Eq a => a -> NotOne a -> Bool)
-> (forall a. Ord a => NotOne a -> a)
-> (forall a. Ord a => NotOne a -> a)
-> (forall a. Num a => NotOne a -> a)
-> (forall a. Num a => NotOne a -> a)
-> Foldable NotOne
forall a. Eq a => a -> NotOne a -> Bool
forall a. Num a => NotOne a -> a
forall a. Ord a => NotOne a -> a
forall m. Monoid m => NotOne m -> m
forall a. NotOne a -> Bool
forall a. NotOne a -> Int
forall a. NotOne a -> [a]
forall a. (a -> a -> a) -> NotOne a -> a
forall m a. Monoid m => (a -> m) -> NotOne a -> m
forall b a. (b -> a -> b) -> b -> NotOne a -> b
forall a b. (a -> b -> b) -> b -> NotOne a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => NotOne m -> m
fold :: forall m. Monoid m => NotOne m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> NotOne a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> NotOne a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> NotOne a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> NotOne a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> NotOne a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NotOne a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> NotOne a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NotOne a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> NotOne a -> b
foldl :: forall b a. (b -> a -> b) -> b -> NotOne a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> NotOne a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> NotOne a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> NotOne a -> a
foldr1 :: forall a. (a -> a -> a) -> NotOne a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> NotOne a -> a
foldl1 :: forall a. (a -> a -> a) -> NotOne a -> a
$ctoList :: forall a. NotOne a -> [a]
toList :: forall a. NotOne a -> [a]
$cnull :: forall a. NotOne a -> Bool
null :: forall a. NotOne a -> Bool
$clength :: forall a. NotOne a -> Int
length :: forall a. NotOne a -> Int
$celem :: forall a. Eq a => a -> NotOne a -> Bool
elem :: forall a. Eq a => a -> NotOne a -> Bool
$cmaximum :: forall a. Ord a => NotOne a -> a
maximum :: forall a. Ord a => NotOne a -> a
$cminimum :: forall a. Ord a => NotOne a -> a
minimum :: forall a. Ord a => NotOne a -> a
$csum :: forall a. Num a => NotOne a -> a
sum :: forall a. Num a => NotOne a -> a
$cproduct :: forall a. Num a => NotOne a -> a
product :: forall a. Num a => NotOne a -> a
Foldable, Functor NotOne
Foldable NotOne
(Functor NotOne, Foldable NotOne) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> NotOne a -> f (NotOne b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    NotOne (f a) -> f (NotOne a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NotOne a -> m (NotOne b))
-> (forall (m :: * -> *) a.
    Monad m =>
    NotOne (m a) -> m (NotOne a))
-> Traversable NotOne
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => NotOne (m a) -> m (NotOne a)
forall (f :: * -> *) a.
Applicative f =>
NotOne (f a) -> f (NotOne a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NotOne a -> m (NotOne b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NotOne a -> f (NotOne b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NotOne a -> f (NotOne b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NotOne a -> f (NotOne b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
NotOne (f a) -> f (NotOne a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
NotOne (f a) -> f (NotOne a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NotOne a -> m (NotOne b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NotOne a -> m (NotOne b)
$csequence :: forall (m :: * -> *) a. Monad m => NotOne (m a) -> m (NotOne a)
sequence :: forall (m :: * -> *) a. Monad m => NotOne (m a) -> m (NotOne a)
Traversable)

notOne :: [a] -> Either a (NotOne a)
notOne :: forall a. [a] -> Either a (NotOne a)
notOne [] = NotOne a -> Either a (NotOne a)
forall a b. b -> Either a b
Right NotOne a
forall a. NotOne a
Zero
notOne [a
a] = a -> Either a (NotOne a)
forall a b. a -> Either a b
Left a
a
notOne (a
a1 : a
a2 : [a]
as) = NotOne a -> Either a (NotOne a)
forall a b. b -> Either a b
Right (NotOne a -> Either a (NotOne a))
-> (TwoOrMore a -> NotOne a) -> TwoOrMore a -> Either a (NotOne a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TwoOrMore a -> NotOne a
forall a. TwoOrMore a -> NotOne a
Multiple (TwoOrMore a -> Either a (NotOne a))
-> TwoOrMore a -> Either a (NotOne a)
forall a b. (a -> b) -> a -> b
$ a -> a -> [a] -> TwoOrMore a
forall a. a -> a -> [a] -> TwoOrMore a
TwoOrMore a
a1 a
a2 [a]
as

getMultiple :: NotOne a -> Maybe (TwoOrMore a)
getMultiple :: forall a. NotOne a -> Maybe (TwoOrMore a)
getMultiple NotOne a
Zero = Maybe (TwoOrMore a)
forall a. Maybe a
Nothing
getMultiple (Multiple TwoOrMore a
as) = TwoOrMore a -> Maybe (TwoOrMore a)
forall a. a -> Maybe a
Just TwoOrMore a
as

instance Semigroup (NotOne a) where
  NotOne a
Zero <> :: NotOne a -> NotOne a -> NotOne a
<> NotOne a
bs = NotOne a
bs
  Multiple (TwoOrMore a
a1 a
a2 [a]
as) <> NotOne a
bs = TwoOrMore a -> NotOne a
forall a. TwoOrMore a -> NotOne a
Multiple (TwoOrMore a -> NotOne a) -> TwoOrMore a -> NotOne a
forall a b. (a -> b) -> a -> b
$ a -> a -> [a] -> TwoOrMore a
forall a. a -> a -> [a] -> TwoOrMore a
TwoOrMore a
a1 a
a2 ([a]
as [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ NotOne a -> [a]
forall a. NotOne a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NotOne a
bs)

instance Monoid (NotOne a) where
  mempty :: NotOne a
mempty = NotOne a
forall a. NotOne a
Zero

instance Apply NotOne where
  NotOne (a -> b)
Zero <.> :: forall a b. NotOne (a -> b) -> NotOne a -> NotOne b
<.> NotOne a
_ = NotOne b
forall a. NotOne a
Zero
  Multiple TwoOrMore (a -> b)
_ <.> NotOne a
Zero = NotOne b
forall a. NotOne a
Zero
  Multiple TwoOrMore (a -> b)
as <.> Multiple TwoOrMore a
bs = TwoOrMore b -> NotOne b
forall a. TwoOrMore a -> NotOne a
Multiple (TwoOrMore (a -> b)
as TwoOrMore (a -> b) -> TwoOrMore a -> TwoOrMore b
forall a b. TwoOrMore (a -> b) -> TwoOrMore a -> TwoOrMore b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> TwoOrMore a
bs)

instance Alt NotOne where
  <!> :: forall a. NotOne a -> NotOne a -> NotOne a
(<!>) = NotOne a -> NotOne a -> NotOne a
forall a. Semigroup a => a -> a -> a
(<>)

instance Plus NotOne where
  zero :: forall a. NotOne a
zero = NotOne a
forall a. Monoid a => a
mempty

-- | @(>>-) = flip foldMap@
instance Bind NotOne where
  NotOne a
Zero >>- :: forall a b. NotOne a -> (a -> NotOne b) -> NotOne b
>>- a -> NotOne b
_ = NotOne b
forall a. NotOne a
Zero
  Multiple TwoOrMore a
as >>- a -> NotOne b
k = case (a -> Maybe (TwoOrMore b)) -> [a] -> [TwoOrMore b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (NotOne b -> Maybe (TwoOrMore b)
forall a. NotOne a -> Maybe (TwoOrMore a)
getMultiple (NotOne b -> Maybe (TwoOrMore b))
-> (a -> NotOne b) -> a -> Maybe (TwoOrMore b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NotOne b
k) (TwoOrMore a -> [a]
forall a. TwoOrMore a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList TwoOrMore a
as) of
    [] -> NotOne b
forall a. NotOne a
Zero
    [TwoOrMore b
bs] -> TwoOrMore b -> NotOne b
forall a. TwoOrMore a -> NotOne a
Multiple TwoOrMore b
bs
    TwoOrMore b
bs1 : TwoOrMore b
bs2 : [TwoOrMore b]
bss -> TwoOrMore b -> NotOne b
forall a. TwoOrMore a -> NotOne a
Multiple (TwoOrMore b -> NotOne b) -> TwoOrMore b -> NotOne b
forall a b. (a -> b) -> a -> b
$ TwoOrMore (TwoOrMore b) -> TwoOrMore b
forall a. TwoOrMore (TwoOrMore a) -> TwoOrMore a
forall (m :: * -> *) a. Bind m => m (m a) -> m a
join (TwoOrMore b
-> TwoOrMore b -> [TwoOrMore b] -> TwoOrMore (TwoOrMore b)
forall a. a -> a -> [a] -> TwoOrMore a
TwoOrMore TwoOrMore b
bs1 TwoOrMore b
bs2 [TwoOrMore b]
bss)

instance Isolated NotOne where
  impureBind :: forall a b. NotOne a -> (a -> Unite NotOne b) -> Unite NotOne b
impureBind NotOne a
as a -> Unite NotOne b
k = Either b (NotOne b) -> Unite NotOne b
forall (f :: * -> *) a. Either a (f a) -> Unite f a
Unite (Either b (NotOne b) -> Unite NotOne b)
-> ([b] -> Either b (NotOne b)) -> [b] -> Unite NotOne b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> Either b (NotOne b)
forall a. [a] -> Either a (NotOne a)
notOne ([b] -> Unite NotOne b) -> [b] -> Unite NotOne b
forall a b. (a -> b) -> a -> b
$ NotOne a -> [a]
forall a. NotOne a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NotOne a
as [a] -> (a -> [b]) -> [b]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Unite NotOne b -> [b]
forall a. Unite NotOne a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Unite NotOne b -> [b]) -> (a -> Unite NotOne b) -> a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Unite NotOne b
k