{-# LANGUAGE CPP #-}
module Curry.Files.PathUtils
(
lookupCurryFile
, lookupCurryModule
, lookupCurryInterface
, lookupFile
, getModuleModTime
, writeModule
, readModule
, addVersion
, checkVersion
) where
import qualified Control.Exception as C (IOException, handle)
import Control.Monad (liftM)
import Data.List (isPrefixOf, isSuffixOf)
import System.FilePath
import System.Directory
import System.IO
#if MIN_VERSION_directory(1,2,0)
import Data.Time (UTCTime)
#else
import System.Time (ClockTime)
#endif
import Curry.Base.Ident
import Curry.Files.Filenames
lookupCurryFile :: [FilePath] -> FilePath -> IO (Maybe FilePath)
lookupCurryFile :: [FilePath] -> FilePath -> IO (Maybe FilePath)
lookupCurryFile paths :: [FilePath]
paths fn :: FilePath
fn = [FilePath] -> [FilePath] -> FilePath -> IO (Maybe FilePath)
lookupFile [FilePath]
paths [FilePath]
exts FilePath
fn
where
exts :: [FilePath]
exts | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
fnExt = [FilePath]
sourceExts
| Bool
otherwise = [FilePath
fnExt]
fnExt :: FilePath
fnExt = FilePath -> FilePath
takeExtension FilePath
fn
lookupCurryModule :: [FilePath]
-> [FilePath]
-> ModuleIdent
-> IO (Maybe FilePath)
lookupCurryModule :: [FilePath] -> [FilePath] -> ModuleIdent -> IO (Maybe FilePath)
lookupCurryModule paths :: [FilePath]
paths libPaths :: [FilePath]
libPaths m :: ModuleIdent
m =
[FilePath] -> [FilePath] -> FilePath -> IO (Maybe FilePath)
lookupFile ([FilePath]
paths [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
libPaths) [FilePath]
moduleExts (ModuleIdent -> FilePath
moduleNameToFile ModuleIdent
m)
lookupCurryInterface :: [FilePath]
-> ModuleIdent
-> IO (Maybe FilePath)
lookupCurryInterface :: [FilePath] -> ModuleIdent -> IO (Maybe FilePath)
lookupCurryInterface paths :: [FilePath]
paths m :: ModuleIdent
m = [FilePath] -> [FilePath] -> FilePath -> IO (Maybe FilePath)
lookupFile [FilePath]
paths [FilePath
icurryExt] (ModuleIdent -> FilePath
moduleNameToFile ModuleIdent
m)
lookupFile :: [FilePath]
-> [String]
-> FilePath
-> IO (Maybe FilePath)
lookupFile :: [FilePath] -> [FilePath] -> FilePath -> IO (Maybe FilePath)
lookupFile paths :: [FilePath]
paths exts :: [FilePath]
exts file :: FilePath
file = [FilePath] -> IO (Maybe FilePath)
lookup' [FilePath]
files
where
files :: [FilePath]
files = [ FilePath -> FilePath
normalise (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
f) | FilePath
p <- [FilePath]
paths, FilePath
f <- [FilePath]
baseNames ]
baseNames :: [FilePath]
baseNames = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
replaceExtension FilePath
file) [FilePath]
exts
lookup' :: [FilePath] -> IO (Maybe FilePath)
lookup' [] = Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
lookup' (f :: FilePath
f : fs :: [FilePath]
fs) = do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
f
if Bool
exists then Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f) else [FilePath] -> IO (Maybe FilePath)
lookup' [FilePath]
fs
writeModule :: FilePath
-> String
-> IO ()
writeModule :: FilePath -> FilePath -> IO ()
writeModule fn :: FilePath
fn contents :: FilePath
contents = do
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
fn
FilePath -> FilePath -> IO ()
tryWriteFile FilePath
fn FilePath
contents
readModule :: FilePath -> IO (Maybe String)
readModule :: FilePath -> IO (Maybe FilePath)
readModule = (FilePath -> IO FilePath) -> FilePath -> IO (Maybe FilePath)
forall a. (FilePath -> IO a) -> FilePath -> IO (Maybe a)
tryOnExistingFile FilePath -> IO FilePath
readFileUTF8
where
readFileUTF8 :: FilePath -> IO String
readFileUTF8 :: FilePath -> IO FilePath
readFileUTF8 fn :: FilePath
fn = do
Handle
hdl <- FilePath -> IOMode -> IO Handle
openFile FilePath
fn IOMode
ReadMode
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
hdl TextEncoding
utf8
Handle -> IO FilePath
hGetContents Handle
hdl
#if MIN_VERSION_directory(1,2,0)
getModuleModTime :: FilePath -> IO (Maybe UTCTime)
#else
getModuleModTime :: FilePath -> IO (Maybe ClockTime)
#endif
getModuleModTime :: FilePath -> IO (Maybe UTCTime)
getModuleModTime = (FilePath -> IO UTCTime) -> FilePath -> IO (Maybe UTCTime)
forall a. (FilePath -> IO a) -> FilePath -> IO (Maybe a)
tryOnExistingFile FilePath -> IO UTCTime
getModificationTime
addVersion :: String -> String -> String
addVersion :: FilePath -> FilePath -> FilePath
addVersion v :: FilePath
v content :: FilePath
content = "{- " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
v FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " -}\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
content
checkVersion :: String -> String -> Either String String
checkVersion :: FilePath -> FilePath -> Either FilePath FilePath
checkVersion expected :: FilePath
expected src :: FilePath
src = case FilePath -> [FilePath]
lines FilePath
src of
[] -> FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left "empty file"
(l :: FilePath
l:ls :: [FilePath]
ls) -> case FilePath -> Maybe FilePath
getVersion FilePath
l of
Just v :: FilePath
v | FilePath
v FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
expected -> FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right ([FilePath] -> FilePath
unlines [FilePath]
ls)
| Bool
otherwise -> FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left (FilePath -> Either FilePath FilePath)
-> FilePath -> Either FilePath FilePath
forall a b. (a -> b) -> a -> b
$ "Expected version `" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
expected
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "', but found version `" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
v FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "'"
_ -> FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left (FilePath -> Either FilePath FilePath)
-> FilePath -> Either FilePath FilePath
forall a b. (a -> b) -> a -> b
$ "No version found"
where
getVersion :: FilePath -> Maybe FilePath
getVersion s :: FilePath
s | "{- " FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
s Bool -> Bool -> Bool
&& " -}" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
s
= FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop 3 (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop 3 FilePath
s)
| Bool
otherwise
= Maybe FilePath
forall a. Maybe a
Nothing
tryOnExistingFile :: (FilePath -> IO a) -> FilePath -> IO (Maybe a)
tryOnExistingFile :: (FilePath -> IO a) -> FilePath -> IO (Maybe a)
tryOnExistingFile action :: FilePath -> IO a
action fn :: FilePath
fn = (IOException -> IO (Maybe a)) -> IO (Maybe a) -> IO (Maybe a)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
C.handle IOException -> IO (Maybe a)
forall a. IOException -> IO (Maybe a)
ignoreIOException (IO (Maybe a) -> IO (Maybe a)) -> IO (Maybe a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
fn
if Bool
exists then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` FilePath -> IO a
action FilePath
fn
else Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
ignoreIOException :: C.IOException -> IO (Maybe a)
ignoreIOException :: IOException -> IO (Maybe a)
ignoreIOException _ = Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
tryWriteFile :: FilePath
-> String
-> IO ()
tryWriteFile :: FilePath -> FilePath -> IO ()
tryWriteFile fn :: FilePath
fn contents :: FilePath
contents = do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
fn
if Bool
exists then (IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
C.handle IOException -> IO ()
issueWarning (FilePath -> FilePath -> IO ()
writeFileUTF8 FilePath
fn FilePath
contents)
else FilePath -> FilePath -> IO ()
writeFileUTF8 FilePath
fn FilePath
contents
where
issueWarning :: C.IOException -> IO ()
issueWarning :: IOException -> IO ()
issueWarning _ = do
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "*** Warning: cannot update file `" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "' (update ignored)"
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeFileUTF8 :: FilePath -> String -> IO ()
writeFileUTF8 :: FilePath -> FilePath -> IO ()
writeFileUTF8 fn' :: FilePath
fn' str :: FilePath
str =
FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
fn' IOMode
WriteMode (\hdl :: Handle
hdl -> Handle -> TextEncoding -> IO ()
hSetEncoding Handle
hdl TextEncoding
utf8 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> FilePath -> IO ()
hPutStr Handle
hdl FilePath
str)