{-# LANGUAGE RankNTypes #-}
module Fresnel.Semigroup.Snoc1
( -- * Non-empty snoc lists
  Snoc1(..)
  -- * Construction
, singleton
, snoc
) where

import Data.Foldable (toList)
import Data.Foldable1

-- Non-empty snoc lists

newtype Snoc1 a = Snoc1 { forall a. Snoc1 a -> forall r. (a -> r) -> (r -> a -> r) -> r
runSnoc1 :: forall r . (a -> r) -> (r -> a -> r) -> r }

instance Show a => Show (Snoc1 a) where
  showsPrec :: Int -> Snoc1 a -> ShowS
showsPrec Int
_ = [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList ([a] -> ShowS) -> (Snoc1 a -> [a]) -> Snoc1 a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Snoc1 a -> [a]
forall a. Snoc1 a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance Semigroup (Snoc1 a) where
  Snoc1 forall r. (a -> r) -> (r -> a -> r) -> r
a1 <> :: Snoc1 a -> Snoc1 a -> Snoc1 a
<> Snoc1 forall r. (a -> r) -> (r -> a -> r) -> r
a2 = (forall r. (a -> r) -> (r -> a -> r) -> r) -> Snoc1 a
forall a. (forall r. (a -> r) -> (r -> a -> r) -> r) -> Snoc1 a
Snoc1 (\ a -> r
f r -> a -> r
g -> (a -> r) -> (r -> a -> r) -> r
forall r. (a -> r) -> (r -> a -> r) -> r
a2 (\ a
a -> r -> a -> r
g ((a -> r) -> (r -> a -> r) -> r
forall r. (a -> r) -> (r -> a -> r) -> r
a1 a -> r
f r -> a -> r
g) a
a) r -> a -> r
g)

instance Foldable Snoc1 where
  foldMap :: forall m a. Monoid m => (a -> m) -> Snoc1 a -> m
foldMap a -> m
f (Snoc1 forall r. (a -> r) -> (r -> a -> r) -> r
r) = (a -> m) -> (m -> a -> m) -> m
forall r. (a -> r) -> (r -> a -> r) -> r
r a -> m
f (((m -> m) -> (a -> m) -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f) ((m -> m) -> a -> m) -> (m -> m -> m) -> m -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>))
  foldl :: forall b a. (b -> a -> b) -> b -> Snoc1 a -> b
foldl b -> a -> b
f b
z (Snoc1 forall r. (a -> r) -> (r -> a -> r) -> r
r) = (a -> b) -> (b -> a -> b) -> b
forall r. (a -> r) -> (r -> a -> r) -> r
r (b
z b -> a -> b
`f`) b -> a -> b
f

instance Foldable1 Snoc1 where
  foldMap1 :: forall m a. Semigroup m => (a -> m) -> Snoc1 a -> m
foldMap1 a -> m
f (Snoc1 forall r. (a -> r) -> (r -> a -> r) -> r
r) = (a -> m) -> (m -> a -> m) -> m
forall r. (a -> r) -> (r -> a -> r) -> r
r a -> m
f (((m -> m) -> (a -> m) -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f) ((m -> m) -> a -> m) -> (m -> m -> m) -> m -> a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>))
  foldlMap1 :: forall a b. (a -> b) -> (b -> a -> b) -> Snoc1 a -> b
foldlMap1 a -> b
f b -> a -> b
g (Snoc1 forall r. (a -> r) -> (r -> a -> r) -> r
r) = (a -> b) -> (b -> a -> b) -> b
forall r. (a -> r) -> (r -> a -> r) -> r
r a -> b
f b -> a -> b
g

instance Functor Snoc1 where
  fmap :: forall a b. (a -> b) -> Snoc1 a -> Snoc1 b
fmap a -> b
h (Snoc1 forall r. (a -> r) -> (r -> a -> r) -> r
r) = (forall r. (b -> r) -> (r -> b -> r) -> r) -> Snoc1 b
forall a. (forall r. (a -> r) -> (r -> a -> r) -> r) -> Snoc1 a
Snoc1 (\ b -> r
f r -> b -> r
g -> (a -> r) -> (r -> a -> r) -> r
forall r. (a -> r) -> (r -> a -> r) -> r
r (b -> r
f (b -> r) -> (a -> b) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
h) (((b -> r) -> (a -> b) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
h) ((b -> r) -> a -> r) -> (r -> b -> r) -> r -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> b -> r
g))


-- Construction

singleton :: a -> Snoc1 a
singleton :: forall a. a -> Snoc1 a
singleton a
a = (forall r. (a -> r) -> (r -> a -> r) -> r) -> Snoc1 a
forall a. (forall r. (a -> r) -> (r -> a -> r) -> r) -> Snoc1 a
Snoc1 (\ a -> r
f r -> a -> r
_ -> a -> r
f a
a)

snoc :: Snoc1 a -> a -> Snoc1 a
snoc :: forall a. Snoc1 a -> a -> Snoc1 a
snoc (Snoc1 forall r. (a -> r) -> (r -> a -> r) -> r
r) a
a = (forall r. (a -> r) -> (r -> a -> r) -> r) -> Snoc1 a
forall a. (forall r. (a -> r) -> (r -> a -> r) -> r) -> Snoc1 a
Snoc1 (\ a -> r
f r -> a -> r
g -> r -> a -> r
g ((a -> r) -> (r -> a -> r) -> r
forall r. (a -> r) -> (r -> a -> r) -> r
r a -> r
f r -> a -> r
g) a
a)