{-# LANGUAGE RankNTypes #-}
module Fresnel.Monoid.Snoc
( -- * Snoc lists
  Snoc(..)
  -- * Construction
, singleton
, snoc
, nil
) where

import Data.Foldable (toList)

-- Snoc lists

newtype Snoc a = Snoc { Snoc a -> forall r. (r -> a -> r) -> r -> r
runSnoc :: forall r . (r -> a -> r) -> r -> r }

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

instance Semigroup (Snoc a) where
  Snoc forall r. (r -> a -> r) -> r -> r
a1 <> :: Snoc a -> Snoc a -> Snoc a
<> Snoc forall r. (r -> a -> r) -> r -> r
a2 = (forall r. (r -> a -> r) -> r -> r) -> Snoc a
forall a. (forall r. (r -> a -> r) -> r -> r) -> Snoc a
Snoc (\ r -> a -> r
snoc -> (r -> a -> r) -> r -> r
forall r. (r -> a -> r) -> r -> r
a1 r -> a -> r
snoc (r -> r) -> (r -> r) -> r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> a -> r) -> r -> r
forall r. (r -> a -> r) -> r -> r
a2 r -> a -> r
snoc)

instance Monoid (Snoc a) where
  mempty :: Snoc a
mempty = Snoc a
forall a. Snoc a
nil

instance Foldable Snoc where
  foldMap :: (a -> m) -> Snoc a -> m
foldMap a -> m
f (Snoc forall r. (r -> a -> r) -> r -> r
r) = (m -> a -> m) -> m -> m
forall r. (r -> a -> r) -> r -> r
r (m -> a -> m
forall a b. a -> b -> a
const (m -> a -> m) -> (m -> a -> m) -> m -> a -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> m -> a -> m
forall a b. a -> b -> a
const a -> m
f) m
forall a. Monoid a => a
mempty

instance Functor Snoc where
  fmap :: (a -> b) -> Snoc a -> Snoc b
fmap a -> b
f (Snoc forall r. (r -> a -> r) -> r -> r
r) = (Snoc b -> a -> Snoc b) -> Snoc b -> Snoc b
forall r. (r -> a -> r) -> r -> r
r (((b -> Snoc b) -> (a -> b) -> a -> Snoc b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) ((b -> Snoc b) -> a -> Snoc b)
-> (Snoc b -> b -> Snoc b) -> Snoc b -> a -> Snoc b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Snoc b -> b -> Snoc b
forall a. Snoc a -> a -> Snoc a
snoc) Snoc b
forall a. Snoc a
nil


-- Construction

singleton :: a -> Snoc a
singleton :: a -> Snoc a
singleton a
a = (forall r. (r -> a -> r) -> r -> r) -> Snoc a
forall a. (forall r. (r -> a -> r) -> r -> r) -> Snoc a
Snoc (\ r -> a -> r
snoc r
nil -> r -> a -> r
snoc r
nil a
a)

snoc :: Snoc a -> a -> Snoc a
snoc :: Snoc a -> a -> Snoc a
snoc (Snoc forall r. (r -> a -> r) -> r -> r
as) a
a = (forall r. (r -> a -> r) -> r -> r) -> Snoc a
forall a. (forall r. (r -> a -> r) -> r -> r) -> Snoc a
Snoc (\ r -> a -> r
snoc r
nil -> r -> a -> r
snoc ((r -> a -> r) -> r -> r
forall r. (r -> a -> r) -> r -> r
as r -> a -> r
snoc r
nil) a
a)

nil :: Snoc a
nil :: Snoc a
nil = (forall r. (r -> a -> r) -> r -> r) -> Snoc a
forall a. (forall r. (r -> a -> r) -> r -> r) -> Snoc a
Snoc (\ r -> a -> r
_ r
nil -> r
nil)