{- |
Description: Data types and operations for Abstract Syntax Trees ('AST's).
License: GNU LGPLv3
Maintainer: paul.bittner@uni-ulm.de

Data types and operations for Abstract Syntax Trees (ASTs).
'AST's are that 'Tree's with a fixed 'Node' type.
-}
module AST where

import UUID
import Tree
import Grammar
import Control.Monad.State

-- | Node type of 'AST's.
data Node g a = Node {
  -- | The value that is encapsulated by a node. Most of the time this is a @String@ referring to source code statements.
  Node g a -> a
value::a,
  -- | The grammar rule this node was parsed from. @g@ should be an instance of 'Grammar'.
  Node g a -> g
grammartype::g,
  -- | A unique identifier to trace nodes across several versions of 'AST's.
  Node g a -> UUID
uuid::UUID
}

instance Eq (Node g a) where
  n :: Node g a
n == :: Node g a -> Node g a -> Bool
== m :: Node g a
m = (Node g a -> UUID
forall g a. Node g a -> UUID
uuid Node g a
n) UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
== (Node g a -> UUID
forall g a. Node g a -> UUID
uuid Node g a
m)

instance (Eq a) => Ord (Node g a) where
  v :: Node g a
v <= :: Node g a -> Node g a -> Bool
<= w :: Node g a
w = (Node g a -> UUID
forall g a. Node g a -> UUID
uuid Node g a
v) UUID -> UUID -> Bool
forall a. Ord a => a -> a -> Bool
<= (Node g a -> UUID
forall g a. Node g a -> UUID
uuid Node g a
w)

instance Functor (Node g) where
  fmap :: (a -> b) -> Node g a -> Node g b
fmap f :: a -> b
f n :: Node g a
n = Node :: forall g a. a -> g -> UUID -> Node g a
Node {value :: b
value = a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ Node g a -> a
forall g a. Node g a -> a
value Node g a
n, grammartype :: g
grammartype = Node g a -> g
forall g a. Node g a -> g
grammartype Node g a
n, uuid :: UUID
uuid = Node g a -> UUID
forall g a. Node g a -> UUID
uuid Node g a
n}

instance (Grammar g, Show a) => Show (Node g a) where
  show :: Node g a -> String
show n :: Node g a
n = "("String -> ShowS
forall a. [a] -> [a] -> [a]
++(UUID -> String
forall a. Show a => a -> String
show (UUID -> String) -> UUID -> String
forall a b. (a -> b) -> a -> b
$ Node g a -> UUID
forall g a. Node g a -> UUID
uuid Node g a
n)String -> ShowS
forall a. [a] -> [a] -> [a]
++", "String -> ShowS
forall a. [a] -> [a] -> [a]
++(g -> String
forall a. Show a => a -> String
show (g -> String) -> g -> String
forall a b. (a -> b) -> a -> b
$ Node g a -> g
forall g a. Node g a -> g
grammartype Node g a
n)String -> ShowS
forall a. [a] -> [a] -> [a]
++", "String -> ShowS
forall a. [a] -> [a] -> [a]
++(a -> String
forall a. Show a => a -> String
show (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ Node g a -> a
forall g a. Node g a -> a
value Node g a
n)String -> ShowS
forall a. [a] -> [a] -> [a]
++", "String -> ShowS
forall a. [a] -> [a] -> [a]
++(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
n)String -> ShowS
forall a. [a] -> [a] -> [a]
++")"

-- | Type for abstract syntax trees ('AST's) representing source code.
-- It is a tree in which each node represents a source code entity by a value, a grammar type and a 'UUID'.
type AST g a = Tree (Node g a)

-- | Returns the node type of a nodes grammar type.
optionaltype :: Grammar g => Node g a -> NodeType
optionaltype :: Node g a -> NodeType
optionaltype = g -> NodeType
forall g. Grammar g => g -> NodeType
nodetypeof(g -> NodeType) -> (Node g a -> g) -> Node g a -> NodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Node g a -> g
forall g a. Node g a -> g
grammartype

-- | Creates a new node from a value and a type by generating a new 'UUID' for it.
node :: Grammar g => a -> g -> State UUID (Node g a)
node :: a -> g -> State UUID (Node g a)
node v :: a
v vt :: g
vt = do
  State UUID ()
next
  UUID
id <- StateT UUID Identity UUID
forall s (m :: * -> *). MonadState s m => m s
get
  Node g a -> State UUID (Node g a)
forall (m :: * -> *) a. Monad m => a -> m a
return Node :: forall g a. a -> g -> UUID -> Node g a
Node {value :: a
value = a
v, grammartype :: g
grammartype = g
vt, uuid :: UUID
uuid = UUID
id}

-- | Returns the 'UUID' of an 'AST's root.
uuidOf :: AST g a -> UUID
uuidOf :: AST g a -> UUID
uuidOf = Node g a -> UUID
forall g a. Node g a -> UUID
uuid (Node g a -> UUID) -> (AST g a -> Node g a) -> AST g a -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AST g a -> Node g a
forall a. Tree a -> a
element

-- | Finds a subtree in the given 'AST' whose root has the given 'UUID'. Returns @Nothing@ iff no such subtree exists.
findById :: UUID -> AST g a -> Maybe (AST g a)
findById :: UUID -> AST g a -> Maybe (AST g a)
findById i :: UUID
i = (AST g a -> Bool) -> AST g a -> Maybe (AST g a)
forall a. (Tree a -> Bool) -> Tree a -> Maybe (Tree a)
Tree.find ((UUID
iUUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
==)(UUID -> Bool) -> (AST g a -> UUID) -> AST g a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AST g a -> UUID
forall g a. AST g a -> UUID
uuidOf)

-- | Finds a subtree in the given 'AST' whose root has the given value. Returns @Nothing@ iff no such subtree exists.
findByValue :: (Eq a) => a -> AST g a -> Maybe (AST g a)
findByValue :: a -> AST g a -> Maybe (AST g a)
findByValue v :: a
v = (Node g a -> Bool) -> AST g a -> Maybe (AST g a)
forall a. (a -> Bool) -> Tree a -> Maybe (Tree a)
findByNode (\n :: Node g a
n -> Node g a -> a
forall g a. Node g a -> a
value Node g a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v)

-- | Finds a subtree in the given 'AST' whose root has the given grammar type. Returns @Nothing@ iff no such subtree exists.
findByGrammarType :: (Eq g) => g -> AST g a -> Maybe (AST g a)
findByGrammarType :: g -> AST g a -> Maybe (AST g a)
findByGrammarType r :: g
r = (Node g a -> Bool) -> AST g a -> Maybe (AST g a)
forall a. (a -> Bool) -> Tree a -> Maybe (Tree a)
findByNode ((g
rg -> g -> Bool
forall a. Eq a => a -> a -> Bool
==)(g -> Bool) -> (Node g a -> g) -> Node g a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Node g a -> g
forall g a. Node g a -> g
grammartype)

-- | Returns all ancestors of a given subtree (second argument) in the given tree (first argument), that are optional (i.e., their 'optionaltype' is @Optional@).
optionalAncestors :: (Eq a, Grammar g) => AST g a -> AST g a -> [AST g a]
optionalAncestors :: AST g a -> AST g a -> [AST g a]
optionalAncestors root :: AST g a
root = ((AST g a -> Bool) -> [AST g a] -> [AST g a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Tree n :: Node g a
n _) -> Node g a -> NodeType
forall g a. Grammar g => Node g a -> NodeType
optionaltype Node g a
n NodeType -> NodeType -> Bool
forall a. Eq a => a -> a -> Bool
== NodeType
Optional))([AST g a] -> [AST g a])
-> (AST g a -> [AST g a]) -> AST g a -> [AST g a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AST g a -> AST g a -> [AST g a]
forall a. Eq a => Tree a -> Tree a -> [Tree a]
ancestors AST g a
root)