module Language.Noodle.DepTree
( SourceFile(..)
, parseDeps ) where
import System.FilePath
import System.Directory
import System.IO
data SourceFile
= SF { srcName :: FilePath
, srcDir :: FilePath
, srcBody :: String
, srcDeps :: [SourceFile] }
instance Show SourceFile where
show sf = show' 0 sf
ind 0 = ""
ind 1 = " "
ind n = ind 1 ++ ind (n1)
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"
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
Nothing -> return $ Left $ "unable to find '" ++ file ++ "' in search path"
Just absname ->
do let justDirName = dropFileName absname
newSearchps = justDirName : searchps
eHeader <-readDeps absname
case eHeader of
Left s -> return $ Left s
Right (depnames,src) ->
do eDepSrcs <- mapM (parseDeps' newSearchps) depnames
case sqshDepSrcs eDepSrcs of
Left s -> return $ Left $ file ++": " ++ s
Right depsrcs -> return $ Right $
SF { srcName = justFileName
, srcDir = justDirName
, srcBody = src
, srcDeps = depsrcs }
where
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)
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
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 ++ "'"
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)
in (fd,"":fls)
("import":[]) -> ([],[])
("import":file:[]) ->
if isValid file && isRelative file
then parseH (d ++ [file],"":ls)
else ([],[])
_ -> (d,(l:ls))