content: {- |
  Module      :  ./MMT/XMLtoPT.hs
  Description :  parsing functions from XML to parse tree
  Copyright   :
  License     :
  Maintainer  :  a.jakubauskas@jacobs-university.de
  Stability   :  experimental
  Portability :
  
  Parsing functions from XML to parse tree
  -}
  module MMT.XMLtoPT where
  
  import MMT.Tools
  -- import qualified MMT.TestData as Test1 -- local file
  
  import Control.Monad
  import Data.Maybe
  import Text.XML.Light
  import Common.Id
  import Common.Result
  
  import Debug.Trace
  
  readPT :: String -> IO [Content]
  readPT fname = liftM parseXML (readFile fname)
  
  parse :: String -> IO [Result Decl]
  parse fname = do
      putStr $ "reading file " ++ fname ++ "\n"
      tree <- readPT fname
  -- putStr $ "reading XML tree: \n" ++ (show (onlyElems tree)) ++ "\n\n"
      return (map parseDeclR (onlyElems tree))
  
  -- get attribute value by key (string)
  getAttByName :: String -> Element -> String
  getAttByName x e = -- trace ("looking at:\n" ++ show x ++ "\nin\n" ++ show e) $
                     fromJust
          (findAttr QName {qName = x, qURI = Nothing, qPrefix = Nothing} e)
  
  getAttByNameMaybe :: String -> Element -> Maybe String
  getAttByNameMaybe x =
          findAttr QName {qName = x, qURI = Nothing, qPrefix = Nothing}
  
  getAttByNameR :: String -> Element -> Result String
  getAttByNameR x e = let
          maybeVal = findAttr QName
              {qName = x, qURI = Nothing, qPrefix = Nothing}
              e
          in
          case maybeVal of
              Just str -> Result [] (Just str)
              Nothing -> Result [] Nothing
  
  {- TODO: a shorthand func that deals specifically with application case
     getSymbName :: Element -> (String,Maybe(String,String))
  -}
  
  {-
  getElName :: Element -> String
  getElName e = (qName.elName) e
  
  makeQName :: String -> QName
  makeQName n = QName {qName = n, qURI=Nothing, qPrefix=Nothing}
  -}
  parseDeclR :: Element -> Result Decl
  parseDeclR e = let
                  chil = elChildren e
                  chilR = mapM parseTreeR chil
                  in
                  case maybeResult chilR of
                      (Just r) -> Result
                          (diags chilR)
                          (Just (Decl
                              (getAttByName "pattern" e)
                              (getAttByName "name" e) r))
                      Nothing -> Result (diags chilR) Nothing
  
  parseTreeR :: Element -> Result Tree
  parseTreeR e = let
          tree = parseNTreeR ((qName . elName) e ) e
          in
          tree
  
  parseNTreeR :: String -> Element -> Result Tree
  parseNTreeR "var" e = Result [] (Just (Variable (getAttByName "name" e)))
  parseNTreeR "app" e = let
                      args = elChildren e
                      body = mapM parseTreeR args
                      pname = getAttByNameMaybe "pattern" e
                      iname = getAttByNameMaybe "instance" e
                      ref = case (pname, iname) of
                                  (Just pn, Just inn) -> Just (pn, inn)
                                  _ -> Nothing
                      in
                      case maybeResult body of
                      (Just r) ->
                          Result [] (Just
                              (Application
                                  (getAttByName "name" e)
                                   ref
                                   r ))
                      Nothing -> Result (diags body) Nothing
  
  parseNTreeR "bind" e = let
                       binder = getAttByName "binder" e
                       var = getAttByName "var" e
                       body = parseTreeR (head (elChildren e))
                       in
                       case maybeResult body of
                          (Just r) -> Result [] (Just (Bind binder var r))
                          Nothing -> Result [] Nothing
  parseNTreeR "tbind" e = let
                        binder = getAttByName "binder" e
                        var = getAttByName "var" e
                        tp = parseTreeR (head (elChildren e))
                        body = parseTreeR (last (elChildren e))
                        in
                        case (maybeResult tp, maybeResult body) of
                          (Just t, Just b) -> Result [] (Just
                                              (Tbind binder var
                                              t b))
                          (_, _) -> Result
                              (diags tp ++ diags body)
                              Nothing
  parseNTreeR str _ = let
                     msg = "error while parsing file " ++
                        -- file ++
                          ": unknown node <" ++ str ++ ">"
                     diag = Diag Error msg nullRange
                     in
                      Result [diag] Nothing
  