module Data.Simtreelo(loadString, loadFile) where
import Data.Tree
loadString str = do
let (first:s:r) = lines str
let (_,spaces) = separate' s
(tree,_,_) <- if spaces /= [] then
parse (s:r) 2 1 (Just spaces) first
else
parse (s:r) 2 0 Nothing first
return tree
loadFile fname = do
str <- readFile fname
return $ loadString str
parse [] ln _ _ _ = Right ([],[],ln)
parse (h:r) ln d Nothing comment = do
let (name,spaces) = separate' h
if (strip name comment) == "" then parse r (ln+1) d Nothing comment
else do
let (indentor,depth) = if spaces == "" then (Nothing,0) else (Just spaces,1)
(children,rest,ln') <- parse r (ln + 1) (d + 1) indentor comment
if depth == d then do
(siblings,rest',ln'') <- parse rest ln' d indentor comment
return (Node{rootLabel = (strip name comment), subForest = children}:siblings, rest',ln'')
else return ([],(h:r),ln)
parse (h:r) ln d (Just indentor) comment = do
(name,depth) <- separate h indentor ln
if (strip name comment) == "" then parse r (ln+1) d (Just indentor) comment
else do
(children,rest,ln') <- parse r (ln + 1) (d + 1) (Just indentor) comment
if depth == d then do
(siblings,rest',ln'') <- parse rest ln' d (Just indentor) comment
return (Node{rootLabel = (strip name comment), subForest = children}:siblings, rest',ln'')
else return ([],(h:r),ln)
isPrefix [] r = (True,r)
isPrefix i [] = (False,[])
isPrefix (hi:ri) (h:r)
| h == hi =
let (prefix,rest) = isPrefix ri r in
(prefix,if prefix then rest else h:r)
| otherwise = (False,h:r)
separate' [] = ([],[])
separate' (h:r)
| h == ' ' || h == '\t' = let (name,spaces) = separate' r in
(name,h:spaces)
| otherwise = (h:r,"")
strip [] _ = []
strip (h:r) [] =
let rest = strip r [] in
if rest /= "" then h:rest
else
if h == ' ' || h == '\t' then "" else [h]
strip (h:r) comment =
let (prefix,_) = isPrefix comment (h:r) in
if prefix then ""
else
let rest = strip r comment in
if rest /= "" then h:rest
else
if h == ' ' || h == '\t' then "" else [h]
separate a [] _ = Right (a,0)
separate [] _ _ = Right ([],0)
separate line indentor lineNumber = do
let (prefix,rest) = isPrefix indentor line
if prefix then do
(name,depth) <- separate rest indentor lineNumber
return (name,depth + 1)
else if head rest == ' ' || head rest == '\t' then
Left $ "Invalid indentation at line " ++ show lineNumber
else
Right (line,0)