{-# LANGUAGE CPP #-}
module Agda.Utils.FileName
( AbsolutePath(AbsolutePath)
, filePath
, mkAbsolute
, absolute
, canonicalizeAbsolutePath
, sameFile
, doesFileExistCaseSensitive
, isNewerThan
, relativizeAbsolutePath
) where
import System.Directory
import System.FilePath
import Control.Applicative ( liftA2 )
import Control.DeepSeq
#ifdef mingw32_HOST_OS
import Control.Exception ( bracket )
import System.Win32 ( findFirstFile, findClose, getFindDataFileName )
#endif
import Data.Function (on)
import Data.Hashable ( Hashable )
import Data.Text ( Text )
import qualified Data.Text as Text
import Agda.Utils.Monad
import Agda.Utils.Impossible
newtype AbsolutePath = AbsolutePath { AbsolutePath -> Text
textPath :: Text }
deriving (Int -> AbsolutePath -> ShowS
[AbsolutePath] -> ShowS
AbsolutePath -> FilePath
(Int -> AbsolutePath -> ShowS)
-> (AbsolutePath -> FilePath)
-> ([AbsolutePath] -> ShowS)
-> Show AbsolutePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbsolutePath -> ShowS
showsPrec :: Int -> AbsolutePath -> ShowS
$cshow :: AbsolutePath -> FilePath
show :: AbsolutePath -> FilePath
$cshowList :: [AbsolutePath] -> ShowS
showList :: [AbsolutePath] -> ShowS
Show, AbsolutePath -> AbsolutePath -> Bool
(AbsolutePath -> AbsolutePath -> Bool)
-> (AbsolutePath -> AbsolutePath -> Bool) -> Eq AbsolutePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AbsolutePath -> AbsolutePath -> Bool
== :: AbsolutePath -> AbsolutePath -> Bool
$c/= :: AbsolutePath -> AbsolutePath -> Bool
/= :: AbsolutePath -> AbsolutePath -> Bool
Eq, Eq AbsolutePath
Eq AbsolutePath =>
(AbsolutePath -> AbsolutePath -> Ordering)
-> (AbsolutePath -> AbsolutePath -> Bool)
-> (AbsolutePath -> AbsolutePath -> Bool)
-> (AbsolutePath -> AbsolutePath -> Bool)
-> (AbsolutePath -> AbsolutePath -> Bool)
-> (AbsolutePath -> AbsolutePath -> AbsolutePath)
-> (AbsolutePath -> AbsolutePath -> AbsolutePath)
-> Ord AbsolutePath
AbsolutePath -> AbsolutePath -> Bool
AbsolutePath -> AbsolutePath -> Ordering
AbsolutePath -> AbsolutePath -> AbsolutePath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AbsolutePath -> AbsolutePath -> Ordering
compare :: AbsolutePath -> AbsolutePath -> Ordering
$c< :: AbsolutePath -> AbsolutePath -> Bool
< :: AbsolutePath -> AbsolutePath -> Bool
$c<= :: AbsolutePath -> AbsolutePath -> Bool
<= :: AbsolutePath -> AbsolutePath -> Bool
$c> :: AbsolutePath -> AbsolutePath -> Bool
> :: AbsolutePath -> AbsolutePath -> Bool
$c>= :: AbsolutePath -> AbsolutePath -> Bool
>= :: AbsolutePath -> AbsolutePath -> Bool
$cmax :: AbsolutePath -> AbsolutePath -> AbsolutePath
max :: AbsolutePath -> AbsolutePath -> AbsolutePath
$cmin :: AbsolutePath -> AbsolutePath -> AbsolutePath
min :: AbsolutePath -> AbsolutePath -> AbsolutePath
Ord, Eq AbsolutePath
Eq AbsolutePath =>
(Int -> AbsolutePath -> Int)
-> (AbsolutePath -> Int) -> Hashable AbsolutePath
Int -> AbsolutePath -> Int
AbsolutePath -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> AbsolutePath -> Int
hashWithSalt :: Int -> AbsolutePath -> Int
$chash :: AbsolutePath -> Int
hash :: AbsolutePath -> Int
Hashable, AbsolutePath -> ()
(AbsolutePath -> ()) -> NFData AbsolutePath
forall a. (a -> ()) -> NFData a
$crnf :: AbsolutePath -> ()
rnf :: AbsolutePath -> ()
NFData)
filePath :: AbsolutePath -> FilePath
filePath :: AbsolutePath -> FilePath
filePath = Text -> FilePath
Text.unpack (Text -> FilePath)
-> (AbsolutePath -> Text) -> AbsolutePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePath -> Text
textPath
mkAbsolute :: FilePath -> AbsolutePath
mkAbsolute :: FilePath -> AbsolutePath
mkAbsolute FilePath
f
| FilePath -> Bool
isAbsolute FilePath
f =
Text -> AbsolutePath
AbsolutePath (Text -> AbsolutePath) -> Text -> AbsolutePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
dropTrailingPathSeparator ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
normalise FilePath
f
| Bool
otherwise = AbsolutePath
forall a. HasCallStack => a
__IMPOSSIBLE__
absolute :: FilePath -> IO AbsolutePath
absolute :: FilePath -> IO AbsolutePath
absolute FilePath
f = FilePath -> AbsolutePath
mkAbsolute (FilePath -> AbsolutePath) -> IO FilePath -> IO AbsolutePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
ex <- FilePath -> IO Bool
doesFileExist FilePath
f IO Bool -> IO Bool -> IO Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
`or2M` FilePath -> IO Bool
doesDirectoryExist FilePath
f
if ex then do
dir <- canonicalizePath (takeDirectory f)
return (dir </> takeFileName f)
else do
cwd <- getCurrentDirectory
return (cwd </> f)
canonicalizeAbsolutePath :: AbsolutePath -> IO AbsolutePath
canonicalizeAbsolutePath :: AbsolutePath -> IO AbsolutePath
canonicalizeAbsolutePath (AbsolutePath Text
f) =
Text -> AbsolutePath
AbsolutePath (Text -> AbsolutePath)
-> (FilePath -> Text) -> FilePath -> AbsolutePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack (FilePath -> AbsolutePath) -> IO FilePath -> IO AbsolutePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
canonicalizePath (Text -> FilePath
Text.unpack Text
f)
sameFile :: AbsolutePath -> AbsolutePath -> IO Bool
sameFile :: AbsolutePath -> AbsolutePath -> IO Bool
sameFile = (FilePath -> FilePath -> Bool)
-> IO FilePath -> IO FilePath -> IO Bool
forall a b c. (a -> b -> c) -> IO a -> IO b -> IO c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 FilePath -> FilePath -> Bool
equalFilePath (IO FilePath -> IO FilePath -> IO Bool)
-> (AbsolutePath -> IO FilePath)
-> AbsolutePath
-> AbsolutePath
-> IO Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath)
-> (AbsolutePath -> FilePath) -> AbsolutePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsolutePath -> FilePath
filePath)
doesFileExistCaseSensitive :: FilePath -> IO Bool
#ifdef mingw32_HOST_OS
doesFileExistCaseSensitive f = do
doesFileExist f `and2M` do
bracket (findFirstFile f) (findClose . fst) $
fmap (takeFileName f ==) . getFindDataFileName . snd
#else
doesFileExistCaseSensitive :: FilePath -> IO Bool
doesFileExistCaseSensitive = FilePath -> IO Bool
doesFileExist
#endif
isNewerThan :: FilePath -> FilePath -> IO Bool
isNewerThan :: FilePath -> FilePath -> IO Bool
isNewerThan FilePath
new FilePath
old = do
newExist <- FilePath -> IO Bool
doesFileExist FilePath
new
oldExist <- doesFileExist old
if not (newExist && oldExist)
then return newExist
else do
newT <- getModificationTime new
oldT <- getModificationTime old
return $ newT >= oldT
relativizeAbsolutePath ::
AbsolutePath
-> AbsolutePath
-> Maybe FilePath
relativizeAbsolutePath :: AbsolutePath -> AbsolutePath -> Maybe FilePath
relativizeAbsolutePath AbsolutePath
apath AbsolutePath
aroot
| FilePath
rest FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
path = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
rest
| Bool
otherwise = Maybe FilePath
forall a. Maybe a
Nothing
where
path :: FilePath
path = AbsolutePath -> FilePath
filePath AbsolutePath
apath
root :: FilePath
root = AbsolutePath -> FilePath
filePath AbsolutePath
aroot
rest :: FilePath
rest = FilePath -> ShowS
makeRelative FilePath
root FilePath
path