{-# LANGUAGE StrictData #-}

-- | Strict data types for use as internal
-- accumulators to achieve constant space usage.
module Strict
  (
    {- * Maybe -} Maybe (..), lazy, strict,
    {- * Either -} Either (..), hush,
    {- * Tuples -} Tuple2 (..), Tuple3 (..),
  )
  where

import Data.Semigroup (Semigroup, (<>))
import Data.Monoid (Monoid, mempty)

import qualified Data.Maybe as Lazy

data Maybe a = Just a | Nothing

instance Semigroup a => Semigroup (Maybe a) where
    Maybe a
Nothing <> :: Maybe a -> Maybe a -> Maybe a
<> Maybe a
x = Maybe a
x
    Maybe a
x <> Maybe a
Nothing = Maybe a
x
    Just a
x <> Just a
y = forall a. a -> Maybe a
Just (a
x forall a. Semigroup a => a -> a -> a
<> a
y)

instance Semigroup a => Monoid (Maybe a) where
    mempty :: Maybe a
mempty = forall a. Maybe a
Nothing

lazy :: Maybe a -> Lazy.Maybe a
lazy :: forall a. Maybe a -> Maybe a
lazy Maybe a
Nothing = forall a. Maybe a
Lazy.Nothing
lazy (Just a
a) = forall a. a -> Maybe a
Lazy.Just a
a

strict :: Lazy.Maybe a -> Maybe a
strict :: forall a. Maybe a -> Maybe a
strict Maybe a
Lazy.Nothing = forall a. Maybe a
Nothing
strict (Lazy.Just a
a) = forall a. a -> Maybe a
Just a
a

data Either a b = Left a | Right b

hush :: Either a b -> Lazy.Maybe b
hush :: forall a b. Either a b -> Maybe b
hush (Left a
_) = forall a. Maybe a
Lazy.Nothing
hush (Right b
b) = forall a. a -> Maybe a
Lazy.Just b
b

data Tuple2 a b = Tuple2 a b

data Tuple3 a b c = Tuple3 a b c