module Language.Fixpoint.Files (
Ext (..)
, extFileName
, extModuleName
, withExt
, isExtFile
, getFixpointPath, getZ3LibPath
, getHsTargets
, getFileInDirs
, findFileInDirs
, copyFiles
) where
import qualified Control.Exception as Ex
import Control.Monad
import Data.Functor ((<$>))
import Data.List hiding (find)
import Data.Maybe (fromMaybe)
import System.Directory
import System.Environment
import System.FilePath
import System.FilePath.Find
import Language.Fixpoint.Misc
getFixpointPath = fromMaybe msg <$> findExecutable "fixpoint.native"
where msg = errorstar "Cannot find fixpoint binary [fixpoint.native]"
getZ3LibPath = dropFileName <$> getFixpointPath
checkM f msg p
= do ex <- f p
if ex then return p else errorstar $ "Cannot find " ++ msg ++ " at :" ++ p
data Ext = Cgi
| Fq
| Out
| Html
| Annot
| Hs
| LHs
| Spec
| Hquals
| Result
| Cst
| Mkdn
| Json
| Saved
| Pred
| PAss
| Dat
deriving (Eq, Ord, Show)
extMap e = go e
where
go Cgi = ".cgi"
go Pred = ".pred"
go PAss = ".pass"
go Dat = ".dat"
go Out = ".fqout"
go Fq = ".fq"
go Html = ".html"
go Cst = ".cst"
go Annot = ".annot"
go Hs = ".hs"
go LHs = ".lhs"
go Mkdn = ".markdown"
go Json = ".json"
go Spec = ".spec"
go Hquals = ".hquals"
go Result = ".out"
go Saved = ".bak"
go _ = errorstar $ "extMap: Unknown extension " ++ show e
withExt :: FilePath -> Ext -> FilePath
withExt f ext = replaceExtension f (extMap ext)
extFileName :: Ext -> FilePath -> FilePath
extFileName ext = (`addExtension` (extMap ext))
isExtFile :: Ext -> FilePath -> Bool
isExtFile ext = ((extMap ext) ==) . takeExtension
extModuleName :: String -> Ext -> FilePath
extModuleName modName ext =
case explode modName of
[] -> errorstar $ "malformed module name: " ++ modName
ws -> extFileName ext $ foldr1 (</>) ws
where explode = words . map (\c -> if c == '.' then ' ' else c)
copyFiles :: [FilePath] -> FilePath -> IO ()
copyFiles srcs tgt
= do Ex.catch (removeFile tgt) $ \(_ :: Ex.IOException) -> return ()
forM_ srcs (readFile >=> appendFile tgt)
getHsTargets p
| hasTrailingPathSeparator p = getHsSourceFiles p
| otherwise = return [p]
getHsSourceFiles = find dirs hs
where hs = extension ==? ".hs" ||? extension ==? ".lhs"
dirs = liftM (not . ("dist" `isSuffixOf`)) directory
getFileInDirs :: FilePath -> [FilePath] -> IO (Maybe FilePath)
getFileInDirs name = findFirst (testM doesFileExist . (</> name))
findFileInDirs :: FilePath -> [FilePath] -> IO FilePath
findFileInDirs file dirs
= liftM (fromMaybe err) (findFirst (find always (fileName ==? file)) dirs)
where err = errorstar $ "findFileInDirs: cannot find " ++ file ++ " in " ++ show dirs