{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- TODO: Disabled while we still support GHC 9.2 to enable
-- the import of the empty TypeEq module there.
{-# OPTIONS_GHC -Wno-dodgy-exports -Wno-unused-imports #-}

-- | This module provides a replacement for 'Prelude' with
-- support for linear programming via linear versions of
-- standard data types, functions and type classes.
--
-- A simple example:
--
-- >>> :set -XLinearTypes
-- >>> :set -XNoImplicitPrelude
-- >>> import Prelude.Linear
-- >>> :{
--   boolToInt :: Bool %1-> Int
--   boolToInt False = 0
--   boolToInt True = 1
-- :}
--
-- >>> :{
--   makeInt :: Either Int Bool %1-> Int
--   makeInt = either id boolToInt
-- :}
--
-- This module is designed to be imported unqualifed.
module Prelude.Linear
  ( -- * Standard Types, Classes and Related Functions

    -- ** Basic data types
    module Data.Bool.Linear,
    Prelude.Char,
    module Data.Maybe.Linear,
    module Data.Either.Linear,
    module Prelude.Linear.Internal.TypeEq,

    -- * Tuples
    Prelude.fst,
    Prelude.snd,
    curry,
    uncurry,

    -- ** Basic type classes
    module Data.Ord.Linear,
    Prelude.Enum (..),
    Prelude.Bounded (..),

    -- ** Numbers
    Prelude.Int,
    Prelude.Integer,
    Prelude.Float,
    Prelude.Double,
    Prelude.Rational,
    Prelude.Word,
    module Data.Num.Linear,
    Prelude.Real (..),
    Prelude.Integral (..),
    Prelude.Floating (..),
    Prelude.Fractional (..),
    Prelude.RealFrac (..),
    Prelude.RealFloat (..),

    -- *** Numeric functions
    Prelude.subtract,
    Prelude.even,
    Prelude.odd,
    Prelude.gcd,
    Prelude.lcm,
    (Prelude.^),
    (Prelude.^^),
    Prelude.fromIntegral,
    Prelude.realToFrac,

    -- ** Monads and functors
    (<*),

    -- ** Semigroups and monoids
    module Data.Monoid.Linear,

    -- ** Miscellaneous functions
    id,
    const,
    (.),
    flip,
    ($),
    (&),
    Prelude.until,
    Prelude.error,
    Prelude.errorWithoutStackTrace,
    Prelude.undefined,
    seq,
    ($!),

    -- * List operations
    module Data.List.Linear,

    -- * Functions on strings

    -- TODO: Implement a linear counterpart of this
    module Data.String,

    -- * Converting to and from String
    Prelude.ShowS,
    Prelude.Show (..),
    Prelude.shows,
    Prelude.showChar,
    Prelude.showString,
    Prelude.showParen,
    Prelude.ReadS,
    Prelude.Read (..),
    Prelude.reads,
    Prelude.readParen,
    Prelude.read,
    Prelude.lex,

    -- * Basic input and output
    Prelude.IO,
    Prelude.putChar,
    Prelude.putStr,
    Prelude.putStrLn,
    Prelude.print,
    Prelude.getChar,
    Prelude.getLine,
    Prelude.getContents,
    Prelude.interact,

    -- ** Files
    Prelude.FilePath,
    Prelude.readFile,
    Prelude.writeFile,
    Prelude.appendFile,
    Prelude.readIO,
    Prelude.readLn,

    -- * Using 'Ur' values in linear code
    -- $
    Ur (..),
    unur,

    -- * Doing non-linear operations inside linear functions
    -- $
    Consumable (..),
    Dupable (..),
    Movable (..),
    lseq,
    dup,
    dup3,
    forget,
  )
where

import Data.Bool.Linear
import Data.Either.Linear
import qualified Data.Functor.Linear as Data
import Data.List.Linear
import Data.Maybe.Linear
import Data.Monoid.Linear
import Data.Num.Linear
import Data.Ord.Linear
import Data.String
import Data.Tuple.Linear
import Data.Unrestricted.Linear
import Prelude.Linear.Internal
import Prelude.Linear.Internal.TypeEq
import qualified Prelude

-- | Replacement for the flip function with generalized multiplicities.
flip :: (a %p -> b %q -> c) %r -> b %q -> a %p -> c
flip :: forall a b c (q :: Multiplicity) (p :: Multiplicity)
       (r :: Multiplicity).
(a %p -> b %q -> c) %r -> b %q -> a %p -> c
flip a %p -> b %q -> c
f b
b a
a = a %p -> b %q -> c
f a
a b
b

-- | Linearly typed replacement for the standard '(Prelude.<*)' function.
(<*) :: (Data.Applicative f, Consumable b) => f a %1 -> f b %1 -> f a
f a
fa <* :: forall (f :: * -> *) b a.
(Applicative f, Consumable b) =>
f a %1 -> f b %1 -> f a
<* f b
fb = forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
Data.fmap (forall a b c (q :: Multiplicity) (p :: Multiplicity)
       (r :: Multiplicity).
(a %p -> b %q -> c) %r -> b %q -> a %p -> c
flip forall a b. Consumable a => a %1 -> b %1 -> b
lseq) f a
fa forall (f :: * -> *) a b.
Applicative f =>
f (a %1 -> b) %1 -> f a %1 -> f b
Data.<*> f b
fb

infixl 4 <* -- same fixity as base.<*