{- |
    Module      :  $Header$
    Description :  Utility functions for reading and writing files
    Copyright   :  (c) 1999 - 2003, Wolfgang Lux
                       2011 - 2014, Björn Peemöller (bjp@informatik.uni-kiel.de)
                       2017       , Finn Teegen (fte@informatik.uni-kiel.de)
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable
-}

{-# LANGUAGE CPP #-}

module Curry.Files.PathUtils
  ( -- * Retrieving curry files
    lookupCurryFile
  , lookupCurryModule
  , lookupCurryInterface
  , lookupFile

    -- * Reading and writing modules from files
  , getModuleModTime
  , writeModule
  , readModule
  , writeBinaryModule
  , addVersion
  , checkVersion
  ) where

import qualified Control.Exception    as C (IOException, handle)
import           Control.Monad             (liftM)
import           Data.List                 (isPrefixOf, isSuffixOf)
import qualified Data.ByteString.Lazy as B (ByteString, writeFile)
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

-- ---------------------------------------------------------------------------
-- Searching for files
-- ---------------------------------------------------------------------------

-- |Search in the given list of paths for the given 'FilePath' and eventually
-- return the file name of the found file.
--
-- - If the file name already contains a directory, then the paths to search
--   in are ignored.
-- - If the file name has no extension, then a source file extension is
--   assumed.
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

-- |Search for a given curry module in the given source file and
-- library paths. Note that the current directory is always searched first.
-- Returns the path of the found file.
lookupCurryModule :: [FilePath]          -- ^ list of paths to source files
                  -> [FilePath]          -- ^ list of paths to library files
                  -> ModuleIdent         -- ^ module identifier
                  -> 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)

-- |Search for an interface file in the import search path using the
-- interface extension 'icurryExt'. Note that the current directory is
-- always searched first.
lookupCurryInterface :: [FilePath]          -- ^ list of paths to search in
                     -> ModuleIdent         -- ^ module identifier
                     -> IO (Maybe FilePath) -- ^ the file path if found
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)

-- |Search in the given directories for the file with the specified file
-- extensions and eventually return the 'FilePath' of the file.
lookupFile :: [FilePath]          -- ^ Directories to search in
           -> [String]            -- ^ Accepted file extensions
           -> FilePath            -- ^ Initial file name
           -> IO (Maybe FilePath) -- ^ 'FilePath' of the file if found
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

-- ---------------------------------------------------------------------------
-- Reading and writing files
-- ---------------------------------------------------------------------------

-- | Write the content to a file in the given directory.
writeModule :: FilePath -- ^ original path
            -> String   -- ^ file content
            -> 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

-- | Write the content in binary to a file in the given directory.
writeBinaryModule :: FilePath -- ^ original path
                  -> B.ByteString   -- ^ file content
                  -> IO ()
writeBinaryModule :: FilePath -> ByteString -> IO ()
writeBinaryModule fn :: FilePath
fn contents :: ByteString
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 -> ByteString -> IO ()
tryWriteBinaryFile (FilePath
fn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "-bin") ByteString
contents

-- | Read the specified module and returns either 'Just String' if
-- reading was successful or 'Nothing' otherwise.
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

-- | Get the modification time of a file, if existent
#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

-- |Add the given version string to the file content
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

-- |Check a source file for the given version string
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

-- ---------------------------------------------------------------------------
-- Helper functions
-- ---------------------------------------------------------------------------

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

-- | Try to write a file. If it already exists and is not writable,
-- a warning is issued. This solves some file dependency problems
-- in global installations.
tryWriteFile :: FilePath -- ^ original path
             -> String   -- ^ file content
             -> 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)

-- | Try to write a file. If it already exists and is not writable,
-- a warning is issued. This solves some file dependency problems
-- in global installations.
tryWriteBinaryFile :: FilePath -- ^ original path
                   -> B.ByteString   -- ^ file content
                   -> IO ()
tryWriteBinaryFile :: FilePath -> ByteString -> IO ()
tryWriteBinaryFile fn :: FilePath
fn contents :: ByteString
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 -> ByteString -> IO ()
B.writeFile FilePath
fn ByteString
contents)
            else FilePath -> ByteString -> IO ()
B.writeFile FilePath
fn ByteString
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 ()