packages feed

LslPlus-0.3.0: src/Language/Lsl/Internal/Load.hs

module Language.Lsl.Internal.Load(
    loadScripts,
    loadModules) where

import Control.Exception(SomeException(..),tryJust)
import Control.Monad.Error(liftIO)
import Language.Lsl.Internal.BuiltInModules(avEventGen)
import Language.Lsl.Syntax(SourceContext(..),compileLSLScript',compileLibrary)
import Language.Lsl.Parse(parseModule, parseScript)

parseFiles p files =
    let parseFile (name,path) =
            do result <- tryJust (\ e@(SomeException x) -> Just (show e)) $ p path
               case result of
                   Left msg -> return (name,Left (Nothing,msg))
                   Right (Left err) -> return (name,Left err)
                   Right (Right m) -> return (name,Right m)
    in liftIO $ mapM parseFile files

loadModules files =
    do parseResults <- parseFiles parseModule files
       let (bad,ok) = splitResults parseResults
       let augLib = compileLibrary (avEventGen:ok)
       return (augLib ++ (map (\ (n,err) -> (n,Left [err])) bad))

-- loadModules' files =
--     do parseResults <- parseFiles parseModule files
--        let (bad,ok) = splitResults parseResults
--        let augLib = validLibrary (avEventGen:ok)
--        return (augLib ++ (map (\ (n,err) -> (n,Left [err])) bad))
--        --return (validated ++ (map (\ (n,err) -> (n,Left err)) bad))

loadScripts library files =
    do parseResults <- parseFiles parseScript files
       let (bad,ok) = splitResults parseResults
       return $ (map (\ (n,script) -> (n,compileLSLScript' library script)) ok) ++ 
           (map (\ (n,err) -> (n,Left [err])) bad)
           
-- loadScripts' library files =
--     do parseResults <- parseFiles parseScript files
--        let (bad,ok) = splitResults parseResults
--        return $ (map (\ (n,script) -> (n,validLSLScript library script)) ok) ++ 
--            (map (\ (n,err) -> (n,Left [err])) bad)
           
splitResults [] = ([],[])
splitResults ((name,Left err):xs) =
    let (lefts,rights) = splitResults xs in
        ((name,err):lefts,rights)
splitResults ((name, Right m):xs) =
    let (lefts,rights) = splitResults xs in
        (lefts,(name,m):rights)