module Path
(
Path
,Abs
,Rel
,File
,Dir
,parseAbsDir
,parseRelDir
,parseAbsFile
,parseRelFile
,PathParseException
,mkAbsDir
,mkRelDir
,mkAbsFile
,mkRelFile
,(</>)
,stripDir
,isParentOf
,parentAbs
,filename
,toFilePath
)
where
import Control.Exception (Exception)
import Control.Monad.Catch (MonadThrow(..))
import Data.Data
import Data.List
import Data.Maybe
import Language.Haskell.TH
import Path.Internal
import qualified System.FilePath as FilePath
data Abs
data Rel
data File
data Dir
data PathParseException
= InvalidAbsDir FilePath
| InvalidRelDir FilePath
| InvalidAbsFile FilePath
| InvalidRelFile FilePath
deriving (Show,Typeable)
instance Exception PathParseException
parseAbsDir :: MonadThrow m
=> FilePath -> m (Path Abs Dir)
parseAbsDir filepath =
if FilePath.isAbsolute filepath &&
not (null (normalizeDir filepath)) &&
not (isPrefixOf "~/" filepath)
then return (Path (normalizeDir filepath))
else throwM (InvalidAbsDir filepath)
parseRelDir :: MonadThrow m
=> FilePath -> m (Path Rel Dir)
parseRelDir filepath =
if not (FilePath.isAbsolute filepath) &&
not (null filepath) &&
not (isPrefixOf "~/" filepath) &&
not (null (normalizeDir filepath))
then return (Path (normalizeDir filepath))
else throwM (InvalidRelDir filepath)
parseAbsFile :: MonadThrow m
=> FilePath -> m (Path Abs File)
parseAbsFile filepath =
if FilePath.isAbsolute filepath &&
not (FilePath.hasTrailingPathSeparator filepath) &&
not (isPrefixOf "~/" filepath) &&
not (null (normalizeFile filepath))
then return (Path (normalizeFile filepath))
else throwM (InvalidAbsFile filepath)
parseRelFile :: MonadThrow m
=> FilePath -> m (Path Rel File)
parseRelFile filepath =
if not (FilePath.isAbsolute filepath || FilePath.hasTrailingPathSeparator filepath) &&
not (null filepath) &&
not (isPrefixOf "~/" filepath) &&
not (null (normalizeFile filepath))
then return (Path (normalizeFile filepath))
else throwM (InvalidRelFile filepath)
mkAbsDir :: FilePath -> Q Exp
mkAbsDir s =
case parseAbsDir s of
Left err -> error (show err)
Right (Path str) ->
[|Path $(return (LitE (StringL str))) :: Path Abs Dir|]
mkRelDir :: FilePath -> Q Exp
mkRelDir s =
case parseRelDir s of
Left err -> error (show err)
Right (Path str) ->
[|Path $(return (LitE (StringL str))) :: Path Rel Dir|]
mkAbsFile :: FilePath -> Q Exp
mkAbsFile s =
case parseAbsFile s of
Left err -> error (show err)
Right (Path str) ->
[|Path $(return (LitE (StringL str))) :: Path Abs File|]
mkRelFile :: FilePath -> Q Exp
mkRelFile s =
case parseRelFile s of
Left err -> error (show err)
Right (Path str) ->
[|Path $(return (LitE (StringL str))) :: Path Rel File|]
toFilePath :: Path b t -> FilePath
toFilePath (Path l) = l
(</>) :: Path b Dir -> Path Rel t -> Path b t
(</>) (Path a) (Path b) = Path (a ++ b)
stripDir :: Path b Dir -> Path b t -> Maybe (Path Rel t)
stripDir (Path p) (Path l) =
fmap Path (stripPrefix p l)
isParentOf :: Path b Dir -> Path b t -> Bool
isParentOf p l =
isJust (stripDir p l)
parentAbs :: Path Abs t -> Path Abs t
parentAbs (Path fp) =
Path (normalizeDir (FilePath.takeDirectory (FilePath.dropTrailingPathSeparator fp)))
filename :: Path b File -> Path Rel File
filename (Path l) = Path (normalizeFile (FilePath.takeFileName l))
normalizeDir :: FilePath -> FilePath
normalizeDir =
clean . FilePath.addTrailingPathSeparator . FilePath.normalise
where clean "./" = ""
clean ('/':'/':xs) = clean ('/':xs)
clean x = x
normalizeFile :: FilePath -> FilePath
normalizeFile =
clean . FilePath.normalise
where clean "./" = ""
clean ('/':'/':xs) = clean ('/':xs)
clean x = x