-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | This module is intended to be imported instead of "Lorentz" by Indigo
-- modules.
--
-- The idea is to avoid repeating common @hiding@ rules and to not export any of
-- Lorentz's Instructions and Macros.

module Indigo.Lorentz
  ( module L
  , (#)
  ) where

import Lorentz.ADT as L hiding (HasField, caseT, case_, construct, constructT, setField)
import Lorentz.Annotation as L (HasAnnotation)
import Lorentz.Arith as L
import Lorentz.Base as L hiding (Contract, (#))
import Lorentz.Bytes as L
import Lorentz.Coercions as L
import Lorentz.Common as L
import Lorentz.Constraints as L
import Lorentz.Doc as L hiding (contractGeneralDefault, doc, docGroup)
import Lorentz.Entrypoints as L
import Lorentz.Entrypoints.Doc as L hiding
  (entryCase, entryCaseSimple, entryCase_, finalizeParamCallingDoc)
import Lorentz.Errors as L hiding (failCustom, failCustomNoArg, failCustom_)
import Lorentz.Errors.Numeric as L
import Lorentz.Ext as L
import Lorentz.Lambda as L
import Lorentz.Macro as L (NonZero, View_, VoidResult, Void_, voidResultTag)
import Lorentz.Pack as L
import Lorentz.Polymorphic as L
import Lorentz.Print as L
import Lorentz.Referenced as L
import Lorentz.Run as L hiding (Contract(..))
import Lorentz.StoreClass as L hiding (stDelete, stGet, stInsert, stInsertNew, stMem, stUpdate)
import Lorentz.UParam as L
import Lorentz.Util.TH as L
import Lorentz.Value as L
import Lorentz.Zip as L ()

import Lorentz.Base qualified as LBase ((#))

-- | Replicate the old behavior of @(#)@, which ignores anything after failing
-- instructions. Indigo relies on this.
-- TODO #62: reconsider this.
(#) :: (a :-> b) -> (b :-> c) -> a :-> c
FI forall (out' :: [T]). Instr (ToTs a) out'
l # :: forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# b :-> c
_ = (forall (out' :: [T]). Instr (ToTs a) out') -> a :-> c
forall (inp :: [*]) (out :: [*]).
(forall (out' :: [T]). Instr (ToTs inp) out') -> inp :-> out
FI forall (out' :: [T]). Instr (ToTs a) out'
l
a :-> b
x # b :-> c
y = a :-> b
x (a :-> b) -> (b :-> c) -> a :-> c
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
LBase.# b :-> c
y
infixl 8 #