Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

file 58 lines (44 sloc) 1.314 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
module TreeEdsl (process,TreeContext,insertLeaf,insertSubTree) where

import Control.Monad.State
import Data.Tree

data TreeGenerator a = TreeGenerator {treeStack :: [Tree a]} deriving Show

type TreeContext a b = StateT (TreeGenerator a) IO b

initTree :: a -> TreeGenerator a
initTree str = TreeGenerator {treeStack=[(Node {rootLabel=str,subForest=[]})]}


tag2tree :: a -> Tree a
tag2tree str = Node {rootLabel=str, subForest = []}

insertSubTree :: a -> TreeContext a () -> TreeContext a ()
insertSubTree str action = do
insertNode str
action
endTree

insertLeaf :: a -> TreeContext a ()
insertLeaf t = do
insertNode t
endTree


insertNode :: a -> TreeContext a ()
insertNode t = do
state <- get
let oldStack = treeStack state
let subTree = tag2tree t

let newStack = subTree:oldStack
put (TreeGenerator newStack)
return ()

endTree :: TreeContext a ()
endTree = do
state <- get
let stack = treeStack state
if (length stack > 1) then
do
let (e1:e2:rest) = stack
let childList = subForest e2
let newE2 = e2 {subForest=e1:childList}
let newStack = newE2:rest
put (TreeGenerator newStack)
return ()

else
return ()

process :: a -> TreeContext a () -> IO (Tree a)
process str action = do
(s,TreeGenerator x) <- runStateT (action>>endTree) (initTree str)
return (x!!0)
Something went wrong with that request. Please try again.