{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE LinearTypes #-}

module Data.Unrestricted.Internal.Consumable
  (
  -- * Consumable
    Consumable(..)
  , lseq
  , seqUnit
  )
  where

class Consumable a where
  consume :: a %1-> ()

-- | Consume the unit and return the second argument.
-- This is like 'seq' but since the first argument is restricted to be of type
-- @()@ it is consumed, hence @seqUnit@ is linear in its first argument.
seqUnit :: () %1-> b %1-> b
seqUnit :: forall b. () %1 -> b %1 -> b
seqUnit () b
b = b
b

-- | Consume the first argument and return the second argument.
-- This is like 'seq' but the first argument is restricted to be 'Consumable'.
lseq :: Consumable a => a %1-> b %1-> b
lseq :: forall a b. Consumable a => a %1 -> b %1 -> b
lseq a
a b
b = () %1 -> b %1 -> b
forall b. () %1 -> b %1 -> b
seqUnit (a %1 -> ()
forall a. Consumable a => a %1 -> ()
consume a
a) b
b