{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

{-|
This module provides functionality of generating LaTeX formula in order to
represent a given 'PetriLike'.
Using this module these formulas are only converted into LaTeX source code.
-}
module Modelling.PetriNet.LaTeX (
  toPetriMath,
  ) where

import qualified Data.Map as M

import Modelling.PetriNet.Types (
  Net (..),
  PetriMath (..),
  PetriNode (..),
  )

import Control.Arrow                ((&&&))
import Data.Char                    (isDigit)
import Data.List                    (intercalate)
import Data.Maybe                   (fromMaybe)
import Data.String.Interpolate      (i)
import Image.LaTeX.Render           (Formula)

{-|
Takes a 'Net' and generates all formulas required in order to
represent this net using a mathematical representation ('PetriMath').
-}
toPetriMath :: Net p n => p n String -> PetriMath Formula
toPetriMath :: forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
p n Formula -> PetriMath Formula
toPetriMath p n Formula
pl = PetriMath {
  $sel:netMath:PetriMath :: Formula
netMath            = Formula
netLaTeX,
  $sel:placesMath:PetriMath :: Formula
placesMath         = [Formula] -> Formula
placesLaTeX [Formula]
places,
  $sel:transitionsMath:PetriMath :: Formula
transitionsMath    = [Formula] -> Formula
transitionsLaTeX [Formula]
transitions,
  $sel:tokenChangeMath:PetriMath :: [(Formula, Formula)]
tokenChangeMath    = [Formula] -> [Formula] -> p n Formula -> [(Formula, Formula)]
forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
[Formula] -> [Formula] -> p n Formula -> [(Formula, Formula)]
tokenChangeLaTeX [Formula]
places [Formula]
transitions p n Formula
net,
  $sel:initialMarkingMath:PetriMath :: Formula
initialMarkingMath = [n Formula] -> Formula
forall (n :: * -> *) a. PetriNode n => [n a] -> Formula
initialMarkingLaTeX [n Formula]
placeNodes,
  $sel:placeOrderMath:PetriMath :: Maybe Formula
placeOrderMath     = Formula -> Maybe Formula
forall a. a -> Maybe a
Just (Formula -> Maybe Formula) -> Formula -> Maybe Formula
forall a b. (a -> b) -> a -> b
$ [Formula] -> Formula
placeOrderLaTeX [Formula]
places
  }
  where
    (Map Formula (n Formula)
ps, Map Formula (n Formula)
ts)         = (n Formula -> Bool)
-> Map Formula (n Formula)
-> (Map Formula (n Formula), Map Formula (n Formula))
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partition n Formula -> Bool
forall a. n a -> Bool
forall (n :: * -> *) a. PetriNode n => n a -> Bool
isPlaceNode (Map Formula (n Formula)
 -> (Map Formula (n Formula), Map Formula (n Formula)))
-> Map Formula (n Formula)
-> (Map Formula (n Formula), Map Formula (n Formula))
forall a b. (a -> b) -> a -> b
$ p n Formula -> Map Formula (n Formula)
forall a. Ord a => p n a -> Map a (n a)
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
p n a -> Map a (n a)
nodes p n Formula
net
    ([Formula]
places, [n Formula]
placeNodes) = [(Formula, n Formula)] -> ([Formula], [n Formula])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Formula, n Formula)] -> ([Formula], [n Formula]))
-> [(Formula, n Formula)] -> ([Formula], [n Formula])
forall a b. (a -> b) -> a -> b
$ Map Formula (n Formula) -> [(Formula, n Formula)]
forall k a. Map k a -> [(k, a)]
M.toList Map Formula (n Formula)
ps
    transitions :: [Formula]
transitions      = Map Formula (n Formula) -> [Formula]
forall k a. Map k a -> [k]
M.keys Map Formula (n Formula)
ts
    net :: p n Formula
net              = Formula -> Formula
toLowerIndexes (Formula -> Formula) -> p n Formula -> p n Formula
forall b a. Ord b => (a -> b) -> p n a -> p n b
forall (p :: (* -> *) -> * -> *) (n :: * -> *) b a.
(Net p n, Ord b) =>
(a -> b) -> p n a -> p n b
`mapNet` p n Formula
pl

{-|
Rewrite the given 'String' to print indexes as subscripts when rendering it
using LaTeX.

>>> toLowerIndexes "t1"
"t_{1}"
-}
toLowerIndexes :: String -> Formula
toLowerIndexes :: Formula -> Formula
toLowerIndexes [] = []
toLowerIndexes (Char
x:Formula
xs)
  | Char -> Bool
isDigit Char
x = Formula
"_{" Formula -> Formula -> Formula
forall a. [a] -> [a] -> [a]
++ Char
x Char -> Formula -> Formula
forall a. a -> [a] -> [a]
: Formula
ys Formula -> Formula -> Formula
forall a. [a] -> [a] -> [a]
++ Char
'}' Char -> Formula -> Formula
forall a. a -> [a] -> [a]
: Formula -> Formula
toLowerIndexes Formula
zs
  | Bool
otherwise = Char
x Char -> Formula -> Formula
forall a. a -> [a] -> [a]
: Formula -> Formula
toLowerIndexes Formula
xs
  where
    (Formula
ys, Formula
zs) = (Char -> Bool) -> Formula -> (Formula, Formula)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit Formula
xs

placesSetName :: String
placesSetName :: Formula
placesSetName = Formula
"S"

transitionsSetName :: String
transitionsSetName :: Formula
transitionsSetName = Formula
"T"

{-|
A LaTeX-'Formula' for the basic five tuple representing a Petri net.
-}
netLaTeX :: Formula
netLaTeX :: Formula
netLaTeX = [i|N = #{tuple}|]
  where
    tuple :: Formula
    tuple :: Formula
tuple = Formula -> Formula
parenthesise
      (Formula -> Formula) -> Formula -> Formula
forall a b. (a -> b) -> a -> b
$  Formula
placesSetName Formula -> Formula -> Formula
forall a. [a] -> [a] -> [a]
++ Formula
", "
      Formula -> Formula -> Formula
forall a. [a] -> [a] -> [a]
++ Formula
transitionsSetName Formula -> Formula -> Formula
forall a. [a] -> [a] -> [a]
++ Formula
", \\vphantom{()}^{\\bullet}(), ()^{\\bullet}, m_0"

{-|
Wrap the given LaTeX-'Formula' into parentheses.
-}
parenthesise :: Formula -> Formula
parenthesise :: Formula -> Formula
parenthesise = Formula -> Formula -> Formula -> Formula
wrap Formula
"\\left(" Formula
"\\right)"

{-|
Wrap the given LaTeX-'Formula' into braces.
-}
brace :: Formula -> Formula
brace :: Formula -> Formula
brace = Formula -> Formula -> Formula -> Formula
wrap Formula
"\\left\\{" Formula
"\\right\\}"

{-|
Wrap the third given 'Formula' between the first and second 'Formula'.
-}
wrap :: Formula -> Formula -> Formula -> Formula
wrap :: Formula -> Formula -> Formula -> Formula
wrap Formula
x Formula
y Formula
zs = [i|#{x}#{zs}#{y}|]

{-|
Create a LaTeX-'Formula' representing the order of places.
-}
placeOrderLaTeX :: [String] -> Formula
placeOrderLaTeX :: [Formula] -> Formula
placeOrderLaTeX [Formula]
ps = [i|#{parenthesise $ intercalate "," ps}|]

{-|
Create a LaTeX-'Formula' representing the set of given places.
-}
placesLaTeX :: [String] -> Formula
placesLaTeX :: [Formula] -> Formula
placesLaTeX [Formula]
ps = [i|#{placesSetName} = #{brace $ intercalate "," ps}|]

{-|
Create a LaTeX-'Formula' representing the set of given transitions.
-}
transitionsLaTeX :: [String] -> Formula
transitionsLaTeX :: [Formula] -> Formula
transitionsLaTeX [Formula]
ts =
  [i|#{transitionsSetName} = #{brace $ intercalate "," ts}|]

{-|
Create a LaTeX-'Formula' representing the tuple of the inital marking.
-}
initialMarkingLaTeX
  :: PetriNode n
  => [n a]
  -- ^ A list of nodes which should only contain place nodes.
  -> Formula
initialMarkingLaTeX :: forall (n :: * -> *) a. PetriNode n => [n a] -> Formula
initialMarkingLaTeX [n a]
ns = Formula
"m_0 = "
  Formula -> Formula -> Formula
forall a. [a] -> [a] -> [a]
++ Formula -> Formula
parenthesise (Formula -> [Formula] -> Formula
forall a. [a] -> [[a]] -> [a]
intercalate Formula
"," ([Formula] -> Formula) -> [Formula] -> Formula
forall a b. (a -> b) -> a -> b
$ (n a -> Formula) -> [n a] -> [Formula]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Formula
forall a. Show a => a -> Formula
show (Int -> Formula) -> (n a -> Int) -> n a -> Formula
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n a -> Int
forall a. n a -> Int
forall (n :: * -> *) a. PetriNode n => n a -> Int
initialTokens) [n a]
ns)

{-|
Create LaTeX-'Formula's representing the tuples for incoming and outgoing flow
for each of the given transitions in the order of the given places.
-}
tokenChangeLaTeX
  :: Net p n
  => [String]
  -- ^ the names of the places (in this given order)
  -> [String]
  -- ^ the transition names (in this given order).
  -> p n String
  -> [(Formula, Formula)]
tokenChangeLaTeX :: forall (p :: (* -> *) -> * -> *) (n :: * -> *).
Net p n =>
[Formula] -> [Formula] -> p n Formula -> [(Formula, Formula)]
tokenChangeLaTeX [Formula]
ps [Formula]
ts p n Formula
net = (Formula -> (Formula, Formula))
-> [Formula] -> [(Formula, Formula)]
forall a b. (a -> b) -> [a] -> [b]
map (Formula -> Formula
inT (Formula -> Formula)
-> (Formula -> Formula) -> Formula -> (Formula, Formula)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Formula -> Formula
outT) [Formula]
ts
  where
    inT :: Formula -> Formula
inT  Formula
t = Formula
"^{\\bullet}" Formula -> Formula -> Formula
forall a. [a] -> [a] -> [a]
++ Formula
t Formula -> Formula -> Formula
forall a. [a] -> [a] -> [a]
++ (Formula -> p n Formula -> Maybe Int) -> Formula
forall {a}.
(Show a, Num a) =>
(Formula -> p n Formula -> Maybe a) -> Formula
tokens (Formula -> Formula -> p n Formula -> Maybe Int
forall a. Ord a => a -> a -> p n a -> Maybe Int
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
a -> a -> p n a -> Maybe Int
`flow` Formula
t)
    outT :: Formula -> Formula
outT Formula
t = Formula
t Formula -> Formula -> Formula
forall a. [a] -> [a] -> [a]
++ Formula
"^{\\bullet}" Formula -> Formula -> Formula
forall a. [a] -> [a] -> [a]
++ (Formula -> p n Formula -> Maybe Int) -> Formula
forall {a}.
(Show a, Num a) =>
(Formula -> p n Formula -> Maybe a) -> Formula
tokens (Formula -> Formula -> p n Formula -> Maybe Int
forall a. Ord a => a -> a -> p n a -> Maybe Int
forall (p :: (* -> *) -> * -> *) (n :: * -> *) a.
(Net p n, Ord a) =>
a -> a -> p n a -> Maybe Int
flow Formula
t)
    tokens :: (Formula -> p n Formula -> Maybe a) -> Formula
tokens Formula -> p n Formula -> Maybe a
f  = Formula
" = " Formula -> Formula -> Formula
forall a. [a] -> [a] -> [a]
++ Formula -> Formula
parenthesise (Formula -> [Formula] -> Formula
forall a. [a] -> [[a]] -> [a]
intercalate Formula
"," ([Formula] -> Formula) -> [Formula] -> Formula
forall a b. (a -> b) -> a -> b
$ (a -> Formula) -> [a] -> [Formula]
forall a b. (a -> b) -> [a] -> [b]
map a -> Formula
forall a. Show a => a -> Formula
show ([a] -> [Formula]) -> [a] -> [Formula]
forall a b. (a -> b) -> a -> b
$ (Formula -> p n Formula -> Maybe a) -> [a]
forall {b}. Num b => (Formula -> p n Formula -> Maybe b) -> [b]
flowList Formula -> p n Formula -> Maybe a
f)
    flowList :: (Formula -> p n Formula -> Maybe b) -> [b]
flowList Formula -> p n Formula -> Maybe b
f = (Formula -> b) -> [Formula] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (\Formula
p -> b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
0 (Maybe b -> b) -> Maybe b -> b
forall a b. (a -> b) -> a -> b
$ Formula -> p n Formula -> Maybe b
f Formula
p p n Formula
net) [Formula]
ps