{-# LANGUAGE RankNTypes #-}

module Plutarch.Extra.Compile (
  mustCompile,
  mustCompileTracing,
) where

import Data.Text qualified as T
import Plutarch (
  Config (Config, tracingMode),
  Script,
  TracingMode (DetTracing),
  compile,
 )

{- | Compile a 'ClosedTerm', throwing an error if unsuccessful.

     @since 2.0.0
-}
mustCompile :: forall (a :: S -> Type). ClosedTerm a -> Script
mustCompile :: forall (a :: S -> Type). ClosedTerm a -> Script
mustCompile ClosedTerm a
t = case forall (a :: S -> Type).
Config -> ClosedTerm a -> Either Text Script
compile Config
conf ClosedTerm a
t of
  Left Text
err -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"Plutarch compilation error:", Text -> [Char]
T.unpack Text
err]
  Right Script
s -> Script
s
  where
    conf :: Config
conf = Config {$sel:tracingMode:Config :: TracingMode
tracingMode = TracingMode
DetTracing}

-- Like 'mustCompile', but with tracing turned on.
--
-- @since 3.8.0
mustCompileTracing ::
  forall (a :: S -> Type).
  (forall (s :: S). Term s a) ->
  Script
mustCompileTracing :: forall (a :: S -> Type). ClosedTerm a -> Script
mustCompileTracing forall (s :: S). Term s a
term =
  case forall (a :: S -> Type).
Config -> ClosedTerm a -> Either Text Script
compile Config {$sel:tracingMode:Config :: TracingMode
tracingMode = TracingMode
DetTracing} forall (s :: S). Term s a
term of
    Left Text
err ->
      forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
        [[Char]] -> [Char]
unwords
          [ [Char]
"Plutarch compilation error: "
          , Text -> [Char]
T.unpack Text
err
          ]
    Right Script
script -> Script
script