module PostgresqlSyntax.Extras.NonEmpty where

import PostgresqlSyntax.Prelude hiding (reverse, head, tail, init, last, cons, uncons, fromList)
import Data.List.NonEmpty


{-|
>>> intersperseFoldMap ", " id (fromList ["a"])
"a"

>>> intersperseFoldMap ", " id (fromList ["a", "b", "c"])
"a, b, c"
-}
intersperseFoldMap :: Monoid m => m -> (a -> m) -> NonEmpty a -> m
intersperseFoldMap :: m -> (a -> m) -> NonEmpty a -> m
intersperseFoldMap m
a a -> m
b (a
c :| [a]
d) = a -> m
b a
c m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (m -> m -> m
forall a. Monoid a => a -> a -> a
mappend m
a (m -> m) -> (a -> m) -> a -> m
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> m
b) [a]
d

unsnoc :: NonEmpty a -> (Maybe (NonEmpty a), a)
unsnoc :: NonEmpty a -> (Maybe (NonEmpty a), a)
unsnoc = let
  build1 :: NonEmpty t -> (Maybe (NonEmpty t), t)
build1 = \ case
    t
a :| [t]
b -> t -> [t] -> (Maybe (NonEmpty t), t)
forall t. t -> [t] -> (Maybe (NonEmpty t), t)
build2 t
a [t]
b
  build2 :: t -> [t] -> (Maybe (NonEmpty t), t)
build2 t
a = \ case
    t
b : [t]
c -> t -> NonEmpty t -> [t] -> (Maybe (NonEmpty t), t)
forall t. t -> NonEmpty t -> [t] -> (Maybe (NonEmpty t), t)
build3 t
b (t
a t -> [t] -> NonEmpty t
forall a. a -> [a] -> NonEmpty a
:| []) [t]
c
    [t]
_ -> (Maybe (NonEmpty t)
forall a. Maybe a
Nothing, t
a)
  build3 :: t -> NonEmpty t -> [t] -> (Maybe (NonEmpty t), t)
build3 t
a NonEmpty t
b = \ case
    t
c : [t]
d -> t -> NonEmpty t -> [t] -> (Maybe (NonEmpty t), t)
build3 t
c (t -> NonEmpty t -> NonEmpty t
forall a. a -> NonEmpty a -> NonEmpty a
cons t
a NonEmpty t
b) [t]
d
    [t]
_ -> (NonEmpty t -> Maybe (NonEmpty t)
forall a. a -> Maybe a
Just (NonEmpty t -> NonEmpty t
forall a. NonEmpty a -> NonEmpty a
reverse NonEmpty t
b), t
a)
  in NonEmpty a -> (Maybe (NonEmpty a), a)
forall t. NonEmpty t -> (Maybe (NonEmpty t), t)
build1

consAndUnsnoc :: a -> NonEmpty a -> (NonEmpty a, a)
consAndUnsnoc :: a -> NonEmpty a -> (NonEmpty a, a)
consAndUnsnoc a
a NonEmpty a
b = case NonEmpty a -> (Maybe (NonEmpty a), a)
forall t. NonEmpty t -> (Maybe (NonEmpty t), t)
unsnoc NonEmpty a
b of
    (Maybe (NonEmpty a)
c, a
d) -> case Maybe (NonEmpty a)
c of
      Just NonEmpty a
e -> (a -> NonEmpty a -> NonEmpty a
forall a. a -> NonEmpty a -> NonEmpty a
cons a
a NonEmpty a
e, a
d)
      Maybe (NonEmpty a)
Nothing -> (a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a, a
d)