Monocle-0.0.4: monocle-test.hs

module Test where

import Monocle

main = do

    -- create object $A$ and $B$, arrows $f: A \to B$ and $g: (B\otimes A) \to (B\otimes A)$ :
    let a = object "A"; b = object "B"
    let f = arrow "f" a b; g = arrow "g" (b \* a) (b \* a)

    -- create arrow $g \circ (f \otimes id_A)$ :
    let h = g \. f \* a

    -- show \LaTeX form of $h$ :
    putStrLn "-- show \\LaTeX form of $h$:"
    ptex h

    -- show detailed \LaTeX documentation of $h$ :
    putStrLn "-- show detailed \\LaTeX documentation of $h$ :"
    pdoc h

    -- create braid $\beta$ and unbraid $\beta^{-1}$ :
    let br = braid a b; ub = unbraid b a

    -- show them in \LaTeX :
    putStrLn "-- show braid and unbraid in \\LaTeX :"
    pdoc br
    pdoc ub

    -- show unbraid rule :
    putStrLn "-- show unbraid rule :"
    pdoc braid'rule'Iso'Left

    -- apply it to $\beta^{-1} \circ \beta$ :
    let r = apply braid'rule'Iso'Left (ub \. br)
    putStrLn "-- apply it to $\\beta^{-1} \\circ \\beta$ :"
    ptex r


    -- create arrow $h: (A\otimes B) \to (A\otimes B)$ :
    let h = arrow "h" (a \* b) (a \* b)

    -- create arrow $(h \circ \beta^{-1} \circ \beta \circ h) \otimes h$ :
    let h1 = (h \. ub \. br \. h) \* h

    -- markup it :
    let h2 = markup h1
    putStrLn "-- h1 marked :"
    ptex h2

    -- using label "lab:3" select elements 2-3 from
    -- composition $h \circ \beta^{-1} \circ \beta \circ h$ :
    let h3 = modifLab "lab:3" h2 $ choose "lab" 2 3
    putStrLn "-- h2 modified by choose :"
    ptex h3

    -- apply unbraid rule to the selected components :
    putStrLn "-- h3 modified by applying unbraid"
    ptex $ modif "lab" h3 $ apply braid'rule'Iso'Left