module Quickpull.Files where
import Quickpull.Types
import System.Directory
import System.FilePath
import Data.List
import Data.Char
import Data.Ord
import Data.Maybe
concatDirs :: FilePath -> [FilePath] -> FilePath
concatDirs st rst = joinPath $ st : reverse rst
isInterestingFile :: FilePath -> Bool
isInterestingFile p = case p of
[] -> False
x:xs -> isUpper x && ".hs" `isSuffixOf` xs
isInterestingDir :: FilePath -> Bool
isInterestingDir p = case p of
[] -> False
x:_ -> isUpper x
modsInDirectory
:: [FilePath]
-> FilePath
-> IO [ModDesc]
modsInDirectory stk strt = do
let path = concatDirs strt stk
filesAndDirs <- fmap (filter (\x -> x /= "." && x /= ".."))
. fmap sort . getDirectoryContents $ concatDirs strt stk
let fullNames = map ((path ++ "/") ++)filesAndDirs
bools <- mapM doesDirectoryExist fullNames
let ps = zip bools filesAndDirs
dirs = filter isInterestingDir
. map snd . filter fst $ ps
files = filter isInterestingFile . map snd
. filter (not . fst) $ ps
mods = map (makeModDesc strt stk) files
readDir dirName = modsInDirectory (dirName : stk) strt
subdirs <- fmap concat . mapM readDir $ dirs
return $ mods ++ subdirs
allModules
:: FilePath
-> IO [ModDesc]
allModules = modsInDirectory []
getQuals
:: ModDesc
-> String
-> [(Meta, Qual)]
getQuals d
= mapMaybe mkQ
. sortBy (comparing fst)
. nubBy (\x y -> snd x == snd y)
. reverse
. sortBy (comparing snd)
. mapMaybe getFirstWord
. zip [1..]
. lines
where
mkQ (i, var)
| "prop_" `isPrefixOf` var = Just $ (Meta d i var, QProp)
| "proptree_" `isPrefixOf` var = Just $ (Meta d i var, QTree)
| otherwise = Nothing
getFirstWord (i, s)
| null r = Nothing
| otherwise = Just (i, r)
where
r = takeWhile varIdChar s
varIdChar c = isLower c || isUpper c || isDigit c
|| c == '_' || c == '\''
readAndParse :: ModDesc -> IO [(Meta, Qual)]
readAndParse d = do
t <- readFile . modPath $ d
return $ getQuals d t