{- |
Description: Facilities for exporting 'AST's to Tikz code as a String.
License: GNU LGPLv3
Maintainer: paul.bittner@uni-ulm.de

Facilities for exporting 'AST's to Tikz code as a String.
We use this export to generate the 'AST' figure in the paper (Figure 5).
-}
module TikzExport where

import Tree (element,  Tree(Tree) )
import AST
import Grammar
import Propositions
import Feature
import FeatureTrace
import FeatureTraceRecording
import Util
import Data.List ( intercalate )

{-This file is a bit hacky.-}

-- | Default implementation to export an AST with feature traces.
-- The returned String is the tikz code that can be copied to a tex document.
astToTikzWithTraceDefault :: (Eq a, Show a, Grammar g) => Version g a -> String
astToTikzWithTraceDefault :: Version g a -> String
astToTikzWithTraceDefault =
    let postProcessing :: [a] -> [a]
postProcessing = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop 6 in -- TODO: Fix the hacky "drop 6" that only works for SJava_Grammar
    (AST g a -> String)
-> (AST g a -> Node g a -> FeatureTrace g a -> String)
-> Version g a
-> String
forall g a.
(AST g a -> String)
-> (AST g a -> Node g a -> FeatureTrace g a -> String)
-> Version g a
-> String
astToTikzWithTrace
    (String -> String
tikzifyName
        (String -> String) -> (AST g a -> String) -> AST g a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\n :: Node g a
n ->
            let ruleStr :: String
ruleStr = String -> String
forall a. [a] -> [a]
postProcessing(String -> String) -> (Node g a -> String) -> Node g a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String
removeQuotes(String -> String) -> (Node g a -> String) -> Node g a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.g -> String
forall a. Show a => a -> String
show(g -> String) -> (Node g a -> g) -> Node g a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Node g a -> g
forall g a. Node g a -> g
grammartype (Node g a -> String) -> Node g a -> String
forall a b. (a -> b) -> a -> b
$ Node g a
n 
                valStr :: String
valStr  = String -> String
removeQuotes(String -> String) -> (Node g a -> String) -> Node g a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> String
forall a. Show a => a -> String
show(a -> String) -> (Node g a -> a) -> Node g a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Node g a -> a
forall g a. Node g a -> a
value (Node g a -> String) -> Node g a -> String
forall a b. (a -> b) -> a -> b
$ Node g a
n in
            String
ruleStrString -> String -> String
forall a. [a] -> [a] -> [a]
++(if String
valStr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
&& String
valStr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
ruleStr then "\\linebreak\\code{"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
valStrString -> String -> String
forall a. [a] -> [a] -> [a]
++"}" else ""))
        (Node g a -> String) -> (AST g a -> Node g a) -> AST g a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AST g a -> Node g a
forall a. Tree a -> a
element)
    (\tree :: AST g a
tree node :: Node g a
node trace :: FeatureTrace g a
trace -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " [
        String -> String
tikzifyName(String -> String)
-> (FeatureFormula -> String) -> FeatureFormula -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\s :: String
s -> String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++if Node g a -> NodeType
forall g a. Grammar g => Node g a -> NodeType
optionaltype Node g a
node NodeType -> NodeType -> Bool
forall a. Eq a => a -> a -> Bool
== NodeType
Mandatory then "Inherited" else "")(String -> String)
-> (FeatureFormula -> String) -> FeatureFormula -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FeatureFormula -> String
featuresToTikzClass (FeatureFormula -> String) -> FeatureFormula -> String
forall a b. (a -> b) -> a -> b
$ AST g a -> FeatureTrace g a -> FeatureTrace g a
forall g a.
(Grammar g, Show a, Eq a) =>
AST g a -> FeatureTrace g a -> FeatureTrace g a
pc AST g a
tree FeatureTrace g a
trace Node g a
node,
        NodeType -> String
forall a. Show a => a -> String
show (NodeType -> String) -> NodeType -> String
forall a b. (a -> b) -> a -> b
$ Node g a -> NodeType
forall g a. Grammar g => Node g a -> NodeType
optionaltype Node g a
node
      ])

featuresToTikzClass :: FeatureFormula -> String
featuresToTikzClass :: FeatureFormula -> String
featuresToTikzClass Nothing = "null"
featuresToTikzClass (Just PTrue) = "true"
featuresToTikzClass (Just PFalse) = "false"
featuresToTikzClass (Just (PVariable v :: String
v)) = String
v
featuresToTikzClass (Just (PNot p :: PropositionalFormula String
p)) = "not"String -> String -> String
forall a. [a] -> [a] -> [a]
++(FeatureFormula -> String
featuresToTikzClass (FeatureFormula -> String) -> FeatureFormula -> String
forall a b. (a -> b) -> a -> b
$ PropositionalFormula String -> FeatureFormula
forall a. a -> Maybe a
Just PropositionalFormula String
p)
featuresToTikzClass _ = String -> String
forall a. HasCallStack => String -> a
error "Only literals are supported"

astToTikzWithTrace :: (AST g a -> String) -> (AST g a -> Node g a -> FeatureTrace g a -> String) -> Version g a -> String
astToTikzWithTrace :: (AST g a -> String)
-> (AST g a -> Node g a -> FeatureTrace g a -> String)
-> Version g a
-> String
astToTikzWithTrace val :: AST g a -> String
val toCls :: AST g a -> Node g a -> FeatureTrace g a -> String
toCls (trace :: FeatureTrace g a
trace, t :: AST g a
t) = (AST g a -> String) -> (AST g a -> String) -> AST g a -> String
forall g a.
(AST g a -> String) -> (AST g a -> String) -> AST g a -> String
astToTikz AST g a -> String
val (\s :: AST g a
s -> AST g a -> Node g a -> FeatureTrace g a -> String
toCls AST g a
t (AST g a -> Node g a
forall a. Tree a -> a
element AST g a
s) FeatureTrace g a
trace) AST g a
t

astToTikz :: (AST g a -> String) -> (AST g a -> String) -> AST g a -> String
astToTikz :: (AST g a -> String) -> (AST g a -> String) -> AST g a -> String
astToTikz val :: AST g a -> String
val cls :: AST g a -> String
cls t :: AST g a
t = "\\"String -> String -> String
forall a. [a] -> [a] -> [a]
++(Int
-> (AST g a -> String) -> (AST g a -> String) -> AST g a -> String
forall g a.
Int
-> (AST g a -> String) -> (AST g a -> String) -> AST g a -> String
astToTikzRecursive 0 AST g a -> String
val AST g a -> String
cls AST g a
t)String -> String -> String
forall a. [a] -> [a] -> [a]
++";"

astToTikzRecursive :: Int -> (AST g a -> String) -> (AST g a -> String) -> AST g a -> String
astToTikzRecursive :: Int
-> (AST g a -> String) -> (AST g a -> String) -> AST g a -> String
astToTikzRecursive i :: Int
i val :: AST g a -> String
val cls :: AST g a -> String
cls t :: AST g a
t@(Tree n :: Node g a
n cs :: [AST g a]
cs) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    ["node", "[", AST g a -> String
cls AST g a
t, "] {", AST g a -> String
val AST g a
t, "}"][String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    ([[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ (AST g a -> [String]) -> [AST g a] -> [[String]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\c :: AST g a
c -> ["\n", String
ind, "child", "{", Int
-> (AST g a -> String) -> (AST g a -> String) -> AST g a -> String
forall g a.
Int
-> (AST g a -> String) -> (AST g a -> String) -> AST g a -> String
astToTikzRecursive (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) AST g a -> String
val AST g a -> String
cls AST g a
c, "\n", String
ind, "}"]) [AST g a]
cs)
    where ind :: String
ind = Int -> String
genIndent (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ 2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i

-- | Converts a string to a valid string inside tikz (e.g., escaping certaing characters such as @_@).
tikzifyName :: String -> String
tikzifyName :: String -> String
tikzifyName s :: String
s =
    let replace :: Char -> String
replace '_' = "\\_"
        replace '-' = "-{}"
        replace x :: Char
x = [Char
x]
        in
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Char -> String
replace (Char -> String) -> String -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
s