graphmod-1.2: src/Utils.hs

module Utils
  ( parseFile
  , parseString
  , Qualifier
  , splitQualifier
  , ModName
  , splitModName
  , joinModName
  , relPaths
  , modToFile
  , suffixes
  ) where

import Language.Haskell.Lexer(lexerPass1,Token(..),PosToken)

import Data.Maybe(catMaybes)
import Data.List(intersperse,isPrefixOf)
import System.Directory(doesFileExist)
import System.FilePath

-- | Get the imports of a file.
parseFile          :: FilePath -> IO (ModName,[ModName])
parseFile f         = (parseString . get_text) `fmap` readFile f
  where get_text txt = if takeExtension f == ".lhs" then delit txt else txt

-- | Get the imports from a string that represents a program.
parseString        :: String -> (ModName,[ModName])
parseString         = parse . lexerPass1

isImp              :: [PosToken] -> Maybe (String, [PosToken])
isImp (_ : (Conid, (_,x)) : xs)   = Just (x,xs)
isImp (_ : (Qconid, (_,x)) : xs)  = Just (x,xs)
-- isImp (_ : (Specialid,_) : (Conid, (_,x)) : xs)   = Just (x,xs)
-- isImp (_ : (Specialid,_) : (Qconid, (_,x)) : xs)  = Just (x,xs)
isImp (_ : (Varid,_) : (Conid, (_,x)) : xs)   = Just (x,xs)
isImp (_ : (Varid,_) : (Qconid, (_,x)) : xs)  = Just (x,xs)
isImp _ = Nothing

parse              :: [PosToken] -> (ModName,[ModName])
parse (_ : (Reservedid,(_,"module")) : (_,(_,m)) : is) =
                                                  (splitModName m,imports is)
parse is            = (([],"Main"),imports is)

imports            :: [PosToken] -> [ModName]
imports ts          = case isImp $ snd $ break (("import" ==) . snd . snd) ts of
                        Just (x,xs) -> splitModName x : imports xs
                        _           -> []

-- | A hierarchical module name.
type Qualifier      = [String]
type ModName        = (Qualifier,String)


-- | Convert a string name into a hierarchical name qualifier.
splitQualifier     :: String -> Qualifier
splitQualifier cs   = case break ('.'==) cs of
                        (xs,_:ys)  -> xs : splitQualifier ys
                        _          -> [cs]

-- | Convert a string name into a hierarchical name.
splitModName       :: String -> ModName
splitModName cs     = case break ('.'==) cs of
                        (xs,_:ys)  -> let (as,bs) = splitModName ys
                                   in (xs:as,bs)
                        _ -> ([],cs)

joinModName        :: ModName -> String
joinModName (xs,y)  = concat $ intersperse "." (xs ++ [y])

-- | The files in which a module might reside.
relPaths           :: ModName -> [FilePath]
relPaths (xs,y)     = [ prefix ++ suffix | suffix <- suffixes ]
  where prefix      = foldr (</>) y xs

suffixes           :: [String]
suffixes            = [".hs",".lhs"]

-- | The files in which a module might reside.
-- We report only files that exist.
modToFile          :: [FilePath] -> ModName -> IO [FilePath]
modToFile dirs m    = catMaybes `fmap` mapM check paths
  where
  paths             = [ d </> r | d <- dirs, r <- relPaths m ]
  check p           = do x <- doesFileExist p
                         return (if x then Just p else Nothing)


delit :: String -> String
delit txt = unlines $ bird $ lines txt
  where
  bird (('>' : cs) : ls)  = (' ' : cs) : bird ls
  bird (l : ls)
    | "\\begin{code}" `isPrefixOf` l  = in_code ls
    | otherwise                       = bird ls
  bird []                             = []

  in_code (l : ls)
    | "\\end{code}" `isPrefixOf` l    = bird ls
    | otherwise                       = l : in_code ls
  in_code []                          = []    -- unterminated code...