PathUtils.hs

{- |
    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
  , 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

-- ---------------------------------------------------------------------------
-- 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 paths fn = lookupFile paths exts fn
  where
  exts  | null fnExt = sourceExts
        | otherwise  = [fnExt]
  fnExt              = takeExtension 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 paths libPaths m =
  lookupFile (paths ++ libPaths) moduleExts (moduleNameToFile 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 paths m = lookupFile paths [icurryExt] (moduleNameToFile 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 paths exts file = lookup' files
  where
  files     = [ normalise (p </> f) | p <- paths, f <- baseNames ]
  baseNames = map (replaceExtension file) exts

  lookup' []       = return Nothing
  lookup' (f : fs) = do
    exists <- doesFileExist f
    if exists then return (Just f) else lookup' fs

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

-- | Write the content to a file in the given directory.
writeModule :: FilePath -- ^ original path
            -> String   -- ^ file content
            -> IO ()
writeModule fn contents = do
  createDirectoryIfMissing True $ takeDirectory fn
  tryWriteFile fn contents


-- | Read the specified module and returns either 'Just String' if
-- reading was successful or 'Nothing' otherwise.
readModule :: FilePath -> IO (Maybe String)
readModule = tryOnExistingFile readFileUTF8
 where
  readFileUTF8 :: FilePath -> IO String
  readFileUTF8 fn = do
    hdl <- openFile fn ReadMode
    hSetEncoding hdl utf8
    hGetContents 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 = tryOnExistingFile getModificationTime

-- |Add the given version string to the file content
addVersion :: String -> String -> String
addVersion v content = "{- " ++ v ++ " -}\n" ++ content

-- |Check a source file for the given version string
checkVersion :: String -> String -> Either String String
checkVersion expected src = case lines src of
  [] -> Left "empty file"
  (l:ls) -> case getVersion l of
    Just v | v == expected -> Right (unlines ls)
           | otherwise     -> Left $ "Expected version `" ++ expected
                                     ++ "', but found version `" ++ v ++ "'"
    _                      -> Left $ "No version found"

  where
    getVersion s | "{- " `isPrefixOf` s && " -}" `isSuffixOf` s
                 = Just (reverse $ drop 3 $ reverse $ drop 3 s)
                 | otherwise
                 = Nothing

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

tryOnExistingFile :: (FilePath -> IO a) -> FilePath -> IO (Maybe a)
tryOnExistingFile action fn = C.handle ignoreIOException $ do
  exists <- doesFileExist fn
  if exists then Just `liftM` action fn
            else return Nothing

ignoreIOException :: C.IOException -> IO (Maybe a)
ignoreIOException _ = return 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 fn contents = do
  exists <- doesFileExist fn
  if exists then C.handle issueWarning (writeFileUTF8 fn contents)
            else writeFileUTF8 fn contents
 where
  issueWarning :: C.IOException -> IO ()
  issueWarning _ = do
    putStrLn $ "*** Warning: cannot update file `" ++ fn ++ "' (update ignored)"
    return ()
  writeFileUTF8 :: FilePath -> String -> IO ()
  writeFileUTF8 fn' str =
    withFile fn' WriteMode (\hdl -> hSetEncoding hdl utf8 >> hPutStr hdl str)