{- FOURMOLU_DISABLE -}
-- The MIT License (MIT)

-- Copyright (c) 2016-2024 Objectionary.com

-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to deal
-- in the Software without restriction, including without limitation the rights
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:

-- The above copyright notice and this permission notice shall be included
-- in all copies or substantial portions of the Software.

-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NON-INFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-- SOFTWARE.
{- FOURMOLU_ENABLE -}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Language.EO.Phi.ToLaTeX where

import Data.Foldable (fold)
import Data.List (intersperse)
import Data.String (IsString)
import Data.Text qualified as T
import Language.EO.Phi
import Language.EO.Phi.Rules.Yaml
import Text.Regex (mkRegex, subRegex)

newtype LaTeX = LaTeX {LaTeX -> String
unLaTeX :: String}
  deriving newtype (String -> LaTeX
(String -> LaTeX) -> IsString LaTeX
forall a. (String -> a) -> IsString a
$cfromString :: String -> LaTeX
fromString :: String -> LaTeX
IsString, NonEmpty LaTeX -> LaTeX
LaTeX -> LaTeX -> LaTeX
(LaTeX -> LaTeX -> LaTeX)
-> (NonEmpty LaTeX -> LaTeX)
-> (forall b. Integral b => b -> LaTeX -> LaTeX)
-> Semigroup LaTeX
forall b. Integral b => b -> LaTeX -> LaTeX
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: LaTeX -> LaTeX -> LaTeX
<> :: LaTeX -> LaTeX -> LaTeX
$csconcat :: NonEmpty LaTeX -> LaTeX
sconcat :: NonEmpty LaTeX -> LaTeX
$cstimes :: forall b. Integral b => b -> LaTeX -> LaTeX
stimes :: forall b. Integral b => b -> LaTeX -> LaTeX
Semigroup, Semigroup LaTeX
LaTeX
Semigroup LaTeX =>
LaTeX
-> (LaTeX -> LaTeX -> LaTeX) -> ([LaTeX] -> LaTeX) -> Monoid LaTeX
[LaTeX] -> LaTeX
LaTeX -> LaTeX -> LaTeX
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: LaTeX
mempty :: LaTeX
$cmappend :: LaTeX -> LaTeX -> LaTeX
mappend :: LaTeX -> LaTeX -> LaTeX
$cmconcat :: [LaTeX] -> LaTeX
mconcat :: [LaTeX] -> LaTeX
Monoid)

instance Show LaTeX where
  show :: LaTeX -> String
show = LaTeX -> String
latexToString

class ToLatex a where
  toLatex :: a -> LaTeX
  toLatexString :: a -> String
  toLatexString = LaTeX -> String
latexToString (LaTeX -> String) -> (a -> LaTeX) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex

instance ToLatex Program where
  toLatex :: Program -> LaTeX
toLatex (Program [Binding]
bindings) =
    LaTeX
"\\Big\\{ " LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex ([Binding] -> Object
Formation [Binding]
bindings) LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
" \\Big\\}"

instance ToLatex Attribute where
  toLatex :: Attribute -> LaTeX
toLatex Attribute
Phi = LaTeX
"@"
  toLatex Attribute
Rho = LaTeX
"^"
  toLatex (Alpha (AlphaIndex String
a)) = String -> LaTeX
LaTeX (String
"\\alpha_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. HasCallStack => [a] -> [a]
tail String
a)
  toLatex (Label (LabelId String
l)) = String -> LaTeX
LaTeX String
l
  toLatex (MetaAttr (LabelMetaId String
l)) = String -> LaTeX
LaTeX String
l

instance ToLatex Binding where
  toLatex :: Binding -> LaTeX
toLatex (AlphaBinding Attribute
attr Object
obj) = Attribute -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Attribute
attr LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
" -> " LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
obj
  toLatex (EmptyBinding Attribute
attr) = Attribute -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Attribute
attr LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
" -> ?"
  toLatex (DeltaBinding (Bytes String
bytes)) = LaTeX
"D> " LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> String -> LaTeX
LaTeX String
bytes
  toLatex Binding
DeltaEmptyBinding = LaTeX
"D> ?"
  toLatex (LambdaBinding (Function String
fn)) = LaTeX
"L> " LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> String -> LaTeX
LaTeX String
fn
  toLatex (MetaBindings (BindingsMetaId String
x)) = String -> LaTeX
LaTeX String
x
  toLatex (MetaDeltaBinding (BytesMetaId String
x)) = LaTeX
"D> " LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> String -> LaTeX
LaTeX String
x

instance ToLatex Object where
  toLatex :: Object -> LaTeX
toLatex (Formation [Binding]
bindings) =
    LaTeX
"[[ " LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> [LaTeX] -> LaTeX
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
intersperse LaTeX
", " ((Binding -> LaTeX) -> [Binding] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map Binding -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex [Binding]
bindings)) LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
" ]]"
  toLatex (Application Object
obj [Binding]
bindings) =
    Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
obj LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
"( " LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> [LaTeX] -> LaTeX
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
intersperse LaTeX
", " ((Binding -> LaTeX) -> [Binding] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map Binding -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex [Binding]
bindings)) LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
" )"
  toLatex (ObjectDispatch Object
obj Attribute
attr) =
    Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
obj LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
"." LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> Attribute -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Attribute
attr
  toLatex Object
GlobalObject = LaTeX
"Q"
  toLatex Object
ThisObject = LaTeX
"\\xi"
  toLatex Object
Termination = LaTeX
"\\dead"
  toLatex (MetaObject (ObjectMetaId String
metaId)) = String -> LaTeX
LaTeX String
metaId
  toLatex MetaTailContext{} = String -> LaTeX
forall a. HasCallStack => String -> a
error String
"rendering MetaTailContext in LaTex format"
  toLatex (MetaFunction MetaFunctionName
_ Object
_) = String -> LaTeX
forall a. HasCallStack => String -> a
error String
"rendering MetaFunction in LaTex format"
  toLatex (MetaSubstThis Object
obj1 Object
obj2) = String -> LaTeX
LaTeX String
"\\mathbb{S}(" LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
obj1 LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
", " LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
obj2 LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
")"
  toLatex (MetaContextualize Object
obj1 Object
obj2) = String -> LaTeX
LaTeX String
"\\lceil" LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
obj1 LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
", " LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
obj2 LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
"\\rceil"

removeOrgEolang :: String -> String
removeOrgEolang :: String -> String
removeOrgEolang = Text -> String
T.unpack (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"Q.org.eolang" Text
"QQ" (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

substituteTau :: String -> String
substituteTau :: String -> String
substituteTau = Text -> String
T.unpack (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"τ" Text
"\\tau" (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

removeExclamationsMarks :: String -> String
removeExclamationsMarks :: String -> String
removeExclamationsMarks = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'!')

removeAlpha :: String -> String
removeAlpha :: String -> String
removeAlpha String
s = Regex -> String -> String -> String
subRegex (String -> Regex
mkRegex String
"\\\\alpha_([0-9]+) ->") String
s String
"\\1->"

-- >>> toLatex ("{ ⟦ α0 ↦ ξ, α1 ↦ Φ.org.eolang.bytes( Δ ⤍ 00- ) ⟧ }" :: Program)
-- \Big\{ [[ 0-> $, 1-> QQ.bytes( D> 00- ) ]] \Big\}
latexToString :: LaTeX -> String
latexToString :: LaTeX -> String
latexToString = String -> String
removeExclamationsMarks (String -> String) -> (LaTeX -> String) -> LaTeX -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
substituteTau (String -> String) -> (LaTeX -> String) -> LaTeX -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
removeAlpha (String -> String) -> (LaTeX -> String) -> LaTeX -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
removeOrgEolang (String -> String) -> (LaTeX -> String) -> LaTeX -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LaTeX -> String
unLaTeX

inMathMode :: LaTeX -> LaTeX
inMathMode :: LaTeX -> LaTeX
inMathMode = (LaTeX
" $ " LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<>) (LaTeX -> LaTeX) -> (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
" $ ")

-- it's ok without separators here because rules have zero or one constraint from the context
instance ToLatex RuleContext where
  toLatex :: RuleContext -> LaTeX
toLatex RuleContext{Maybe Attribute
Maybe Object
global_object :: Maybe Object
current_object :: Maybe Object
current_attribute :: Maybe Attribute
$sel:global_object:RuleContext :: RuleContext -> Maybe Object
$sel:current_object:RuleContext :: RuleContext -> Maybe Object
$sel:current_attribute:RuleContext :: RuleContext -> Maybe Attribute
..} =
    LaTeX -> (Object -> LaTeX) -> Maybe Object -> LaTeX
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LaTeX
forall a. Monoid a => a
mempty (\Object
x -> LaTeX -> LaTeX
inMathMode (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
GlobalObject LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
" -> " LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
x) Maybe Object
global_object
      LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX -> (Object -> LaTeX) -> Maybe Object -> LaTeX
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LaTeX
forall a. Monoid a => a
mempty (\Object
x -> (LaTeX -> LaTeX
inMathMode (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
x) LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
" is the scope of the redex") Maybe Object
current_object
      LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX -> (Attribute -> LaTeX) -> Maybe Attribute -> LaTeX
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LaTeX
forall a. Monoid a => a
mempty (\Attribute
x -> Attribute -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Attribute
x LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
" is the current attribute") Maybe Attribute
current_attribute

instance ToLatex RuleAttribute where
  toLatex :: RuleAttribute -> LaTeX
toLatex (ObjectAttr Attribute
a) = Attribute -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Attribute
a
  toLatex RuleAttribute
DeltaAttr = LaTeX
"\\Delta"
  toLatex RuleAttribute
LambdaAttr = LaTeX
"\\lambda"

instance ToLatex Condition where
  toLatex :: Condition -> LaTeX
toLatex (IsNF Object
nf) = LaTeX -> LaTeX
inMathMode (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
nf LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
"\\in\\mathcal{N}"
  toLatex (IsNFInsideFormation Object
nf_inside_formation) =
    LaTeX -> LaTeX
inMathMode (Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
nf_inside_formation) LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
" is nf inside formation"
  toLatex (PresentAttrs (AttrsInBindings [RuleAttribute]
attrs [Binding]
bindings)) =
    LaTeX -> LaTeX
inMathMode (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ [LaTeX] -> LaTeX
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
intersperse LaTeX
", " ((RuleAttribute -> LaTeX) -> [RuleAttribute] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map RuleAttribute -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex [RuleAttribute]
attrs)) LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
" \\in " LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> (Binding -> LaTeX) -> [Binding] -> LaTeX
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Binding -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex [Binding]
bindings
  toLatex (AbsentAttrs (AttrsInBindings [RuleAttribute]
attrs [Binding]
bindings)) =
    LaTeX -> LaTeX
inMathMode (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ [LaTeX] -> LaTeX
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
intersperse LaTeX
", " ((RuleAttribute -> LaTeX) -> [RuleAttribute] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map RuleAttribute -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex [RuleAttribute]
attrs)) LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
" \\notin " LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> (Binding -> LaTeX) -> [Binding] -> LaTeX
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Binding -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex [Binding]
bindings
  toLatex (AttrNotEqual (Attribute
attr1, Attribute
attr2)) =
    LaTeX -> LaTeX
inMathMode (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ Attribute -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Attribute
attr1 LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
" \\neq " LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> Attribute -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Attribute
attr2
  toLatex (ApplyInSubformations Bool
apply_in_subformations) =
    if Bool -> Bool
not Bool
apply_in_subformations then String -> LaTeX
LaTeX String
"not in subformations" else LaTeX
forall a. Monoid a => a
mempty
  toLatex (ApplyInAbstractSubformations Bool
apply_in_abstract_subformations) =
    if Bool -> Bool
not Bool
apply_in_abstract_subformations then String -> LaTeX
LaTeX String
"not in subformations" else LaTeX
forall a. Monoid a => a
mempty

isNonEmptyContext :: Maybe RuleContext -> Bool
isNonEmptyContext :: Maybe RuleContext -> Bool
isNonEmptyContext Maybe RuleContext
Nothing = Bool
False
isNonEmptyContext (Just (RuleContext Maybe Object
Nothing Maybe Object
Nothing Maybe Attribute
Nothing)) = Bool
False
isNonEmptyContext Maybe RuleContext
_ = Bool
True

-- Renders all conditions on separate lines
instance ToLatex Rule where
  toLatex :: Rule -> LaTeX
toLatex (Rule String
name String
_ Maybe RuleContext
context Maybe [MetaId]
_ Object
pattern Object
result Maybe [FreshMetaId]
_ Maybe [Condition]
when Maybe [RuleTest]
_) =
    LaTeX
"\\rrule{"
      LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> String -> LaTeX
LaTeX String
name
      LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
"}: &"
      LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX -> LaTeX
inMathMode (Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
pattern)
      LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
"\\(\\trans\\)"
      LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX -> LaTeX
inMathMode (Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
result)
      LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> (if Bool -> Bool
not (Maybe [Condition] -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe [Condition]
when) Bool -> Bool -> Bool
|| Maybe RuleContext -> Bool
isNonEmptyContext Maybe RuleContext
context then LaTeX
"\\\\\\text {if }" else LaTeX
forall a. Monoid a => a
mempty)
      LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX -> (RuleContext -> LaTeX) -> Maybe RuleContext -> LaTeX
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LaTeX
forall a. Monoid a => a
mempty (\RuleContext
c -> LaTeX
"&" LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> RuleContext -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex RuleContext
c LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
"\\\\") Maybe RuleContext
context
      LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> [LaTeX] -> LaTeX
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
intersperse LaTeX
",\\\\" ([LaTeX] -> ([Condition] -> [LaTeX]) -> Maybe [Condition] -> [LaTeX]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Condition -> LaTeX) -> [Condition] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map ((LaTeX
"&" LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<>) (LaTeX -> LaTeX) -> (Condition -> LaTeX) -> Condition -> LaTeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Condition -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex)) Maybe [Condition]
when))

instance ToLatex [Rule] where
  toLatex :: [Rule] -> LaTeX
toLatex [Rule]
rules =
    LaTeX
"\\begin{figure*}\n\\begin{tabular}{rl}\n  "
      LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> [LaTeX] -> LaTeX
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
intersperse LaTeX
"\\\\\\\\\n  " ((Rule -> LaTeX) -> [Rule] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map Rule -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex [Rule]
rules))
      LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
"\n\\end{tabular}\n\\end{figure*}"

-- Renders all conditions in one line
ruleToLatexCompact :: Rule -> LaTeX
ruleToLatexCompact :: Rule -> LaTeX
ruleToLatexCompact (Rule String
name String
_ Maybe RuleContext
context Maybe [MetaId]
_ Object
pattern Object
result Maybe [FreshMetaId]
_ Maybe [Condition]
when Maybe [RuleTest]
_) =
  LaTeX
"\\rrule{"
    LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> String -> LaTeX
LaTeX String
name
    LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
"}: "
    LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX -> LaTeX
inMathMode (Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
pattern)
    LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
"\\(\\trans\\)"
    LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX -> LaTeX
inMathMode (Object -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex Object
result)
    LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> (if Bool -> Bool
not (Maybe [Condition] -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe [Condition]
when) Bool -> Bool -> Bool
|| Maybe RuleContext -> Bool
isNonEmptyContext Maybe RuleContext
context then LaTeX
"\\quad\\text {if }" else LaTeX
"")
    LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX -> (RuleContext -> LaTeX) -> Maybe RuleContext -> LaTeX
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LaTeX
forall a. Monoid a => a
mempty (\RuleContext
c -> RuleContext -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex RuleContext
c LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
", ") Maybe RuleContext
context
    LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> [LaTeX] -> LaTeX
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
intersperse LaTeX
", " ([LaTeX] -> ([Condition] -> [LaTeX]) -> Maybe [Condition] -> [LaTeX]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Condition -> LaTeX) -> [Condition] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map Condition -> LaTeX
forall a. ToLatex a => a -> LaTeX
toLatex) Maybe [Condition]
when))

rulesToLatexCompact :: [Rule] -> LaTeX
rulesToLatexCompact :: [Rule] -> LaTeX
rulesToLatexCompact [Rule]
rules =
  LaTeX
"\\begin{figure*}\n  "
    LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> [LaTeX] -> LaTeX
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (LaTeX -> [LaTeX] -> [LaTeX]
forall a. a -> [a] -> [a]
intersperse LaTeX
"\\\\\\vspace*{0.5em}\n  " ((Rule -> LaTeX) -> [Rule] -> [LaTeX]
forall a b. (a -> b) -> [a] -> [b]
map Rule -> LaTeX
ruleToLatexCompact [Rule]
rules))
    LaTeX -> LaTeX -> LaTeX
forall a. Semigroup a => a -> a -> a
<> LaTeX
"\n\\end{figure*}"