{---- - DepTree.hs - generate a tree to store file, dependency, and source information - for a given noodle source file. Used by the interpreter to load - module imports, and associate error messages with the appropriate - source files. ---- - Author: Jesse Rudolph - See LICENSE for licensing details ----------------------------------------------------------------- -} module Language.Noodle.DepTree ( SourceFile(..) , parseDeps ) where import System.FilePath import System.Directory import IO {- this module is here to provide a basis of operations on noodle programs in relation to the file system -} -- data structure that represents a parsable source file, -- where it is on disk, what its filename is, and all of its dependencies data SourceFile = SF { srcName :: FilePath , srcDir :: FilePath , srcBody :: String , srcDeps :: [SourceFile] } -- self indenting instance of show for SourceFile instance Show SourceFile where show sf = show' 0 sf ind 0 = "" ind 1 = " " ind n = ind 1 ++ ind (n-1) show' n sf = let indn = ind n in indn ++ "Source File: \n" ++ indn ++ " name -" ++ show (srcName sf) ++ "\n" ++ indn ++ " dir -" ++ show (srcDir sf) ++ "\n" ++ indn ++ " body -" ++ show (srcBody sf) ++ "\n" ++ indn ++ if null (srcDeps sf) then " deps - NONE\n" else " deps - (\n" ++ concat (map (show' (n+1)) (srcDeps sf)) ++ indn ++ " )\n" -- generate a source file dependency tree from a a set of search paths and the filename of the source file parseDeps :: [FilePath] -> FilePath -> IO (Either String SourceFile) parseDeps fp f = do curdir <- getCurrentDirectory parseDeps' (curdir:fp) f parseDeps' searchps file = do mabs <- mFindAbsolute searchps file let justFileName = takeFileName file case mabs of -- find a usable path to the file, if one exists Nothing -> return $ Left $ "unable to find '" ++ file ++ "' in search path" Just absname -> do let justDirName = dropFileName absname -- absolute path to directory containing 'file' newSearchps = justDirName : searchps -- add justDirName to search path eHeader <-readDeps absname case eHeader of -- get a list of dependency paths, if the header is valid Left s -> return $ Left s Right (depnames,src) -> do eDepSrcs <- mapM (parseDeps' newSearchps) depnames case sqshDepSrcs eDepSrcs of -- get SourceFile structures for dependencies Left s -> return $ Left $ file ++": " ++ s Right depsrcs -> return $ Right $ SF { srcName = justFileName , srcDir = justDirName , srcBody = src , srcDeps = depsrcs } where -- convert from a list of either values to the first Left, or Right of a list of SourceFiles sqshDepSrcs :: [Either String SourceFile] -> Either String [SourceFile] sqshDepSrcs [] = Right [] sqshDepSrcs (Left s:_) = Left s sqshDepSrcs (Right d:eds) = case sqshDepSrcs eds of Left s -> Left s Right ds -> Right (d:ds) -- try to find the absolute path of a file name in relation to the search paths mFindAbsolute :: [FilePath] -> FilePath -> IO (Maybe FilePath) mFindAbsolute [] file = return Nothing mFindAbsolute (dir:dirs) file = do let absPath = (if isAbsolute file then file else combine dir file) exists <- doesFileExist absPath if exists then return $ Just absPath else mFindAbsolute dirs file -- read an existing source file from disk, and pass it to parseHeader, returning either -- the result of parseHeader, or an error message if the file is unreadable readDeps :: FilePath -> IO (Either String ([FilePath],String)) readDeps file = do p <- getPermissions file if readable p then do source <- readFile file return $ Right $ parseHeader source else return $ Left $ "insufficient permissions to read '" ++ file ++ "'" -- parse the header of a source file, returning a list of dependency paths, and the source -- text modulo header information. Header lines are replaced with blank lines to preserve source -- line numbering. If the header is malformed, parseHeader returns ([],[]) parseHeader :: String -> ([FilePath],String) parseHeader rawsrc = let parseme = case lines rawsrc of (('#':'!':_):rest) -> "":rest noshebang -> noshebang (ds,ls) = parseH ([],parseme) in (ds,unlines ls) where parseH (d,[]) = (d,[]) parseH (d,l:ls) = case words l of [] -> let (fd,fls) = parseH (d,ls) -- blank lines are ok, but preserve them in (fd,"":fls) ("import":[]) -> ([],[]) ("import":file:[]) -> if isValid file && isRelative file -- i dont think absolute paths make much sense then parseH (d ++ [file],"":ls) else ([],[]) _ -> (d,(l:ls)) -- everything else is source code