{- path manipulation
 -
 - Copyright 2010-2014 Joey Hess <id@joeyh.name>
 -
 - License: BSD-2-clause
 -}

{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}

module Utility.Path where

import System.FilePath
import Data.List
import Data.Maybe
import Data.Char
import Control.Applicative
import Prelude

import Utility.Monad
import Utility.UserInfo
import Utility.Directory
import Utility.Split

{- Simplifies a path, removing any "." component, collapsing "dir/..", 
 - and removing the trailing path separator.
 -
 - On Windows, preserves whichever style of path separator might be used in
 - the input FilePaths. This is done because some programs in Windows
 - demand a particular path separator -- and which one actually varies!
 -
 - This does not guarantee that two paths that refer to the same location,
 - and are both relative to the same location (or both absolute) will
 - yeild the same result. Run both through normalise from System.FilePath
 - to ensure that.
 -}
simplifyPath :: FilePath -> FilePath
simplifyPath :: FilePath -> FilePath
simplifyPath path :: FilePath
path = FilePath -> FilePath
dropTrailingPathSeparator (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ 
	FilePath -> FilePath -> FilePath
joinDrive FilePath
drive (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
joinPath ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath] -> [FilePath]
norm [] ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitPath FilePath
path'
  where
	(drive :: FilePath
drive, path' :: FilePath
path') = FilePath -> (FilePath, FilePath)
splitDrive FilePath
path

	norm :: [FilePath] -> [FilePath] -> [FilePath]
norm c :: [FilePath]
c [] = [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
c
	norm c :: [FilePath]
c (p :: FilePath
p:ps :: [FilePath]
ps)
		| FilePath
p' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ".." Bool -> Bool -> Bool
&& Bool -> Bool
not ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
c) Bool -> Bool -> Bool
&& FilePath -> FilePath
dropTrailingPathSeparator ([FilePath]
c [FilePath] -> Int -> FilePath
forall a. [a] -> Int -> a
!! 0) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= ".." = 
			[FilePath] -> [FilePath] -> [FilePath]
norm (Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop 1 [FilePath]
c) [FilePath]
ps
		| FilePath
p' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "." = [FilePath] -> [FilePath] -> [FilePath]
norm [FilePath]
c [FilePath]
ps
		| Bool
otherwise = [FilePath] -> [FilePath] -> [FilePath]
norm (FilePath
pFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
c) [FilePath]
ps
	  where
		p' :: FilePath
p' = FilePath -> FilePath
dropTrailingPathSeparator FilePath
p

{- Makes a path absolute.
 -
 - The first parameter is a base directory (ie, the cwd) to use if the path
 - is not already absolute, and should itsef be absolute.
 -
 - Does not attempt to deal with edge cases or ensure security with
 - untrusted inputs.
 -}
absPathFrom :: FilePath -> FilePath -> FilePath
absPathFrom :: FilePath -> FilePath -> FilePath
absPathFrom dir :: FilePath
dir path :: FilePath
path = FilePath -> FilePath
simplifyPath (FilePath -> FilePath -> FilePath
combine FilePath
dir FilePath
path)

{- takeDirectory "foo/bar/" is "foo/bar". This instead yields "foo" -}
parentDir :: FilePath -> FilePath
parentDir :: FilePath -> FilePath
parentDir = FilePath -> FilePath
takeDirectory (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
dropTrailingPathSeparator

{- Just the parent directory of a path, or Nothing if the path has no
- parent (ie for "/" or ".") -}
upFrom :: FilePath -> Maybe FilePath
upFrom :: FilePath -> Maybe FilePath
upFrom dir :: FilePath
dir
	| [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
dirs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = Maybe FilePath
forall a. Maybe a
Nothing
	| Bool
otherwise = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
joinDrive FilePath
drive (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
s ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. [a] -> [a]
init [FilePath]
dirs
  where
	-- on Unix, the drive will be "/" when the dir is absolute,
	-- otherwise ""
	(drive :: FilePath
drive, path :: FilePath
path) = FilePath -> (FilePath, FilePath)
splitDrive FilePath
dir
	s :: FilePath
s = [Char
pathSeparator]
	dirs :: [FilePath]
dirs = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
split FilePath
s FilePath
path

prop_upFrom_basics :: FilePath -> Bool
prop_upFrom_basics :: FilePath -> Bool
prop_upFrom_basics dir :: FilePath
dir
	| FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
dir = Bool
True
	| FilePath
dir FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "/" = Maybe FilePath
p Maybe FilePath -> Maybe FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe FilePath
forall a. Maybe a
Nothing
	| Bool
otherwise = Maybe FilePath
p Maybe FilePath -> Maybe FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
dir
  where
	p :: Maybe FilePath
p = FilePath -> Maybe FilePath
upFrom FilePath
dir

{- Checks if the first FilePath is, or could be said to contain the second.
 - For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
 - are all equivilant.
 -}
dirContains :: FilePath -> FilePath -> Bool
dirContains :: FilePath -> FilePath -> Bool
dirContains a :: FilePath
a b :: FilePath
b = FilePath
a FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b Bool -> Bool -> Bool
|| FilePath
a' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b' Bool -> Bool -> Bool
|| (FilePath -> FilePath
addTrailingPathSeparator FilePath
a') FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
b'
  where
	a' :: FilePath
a' = FilePath -> FilePath
norm FilePath
a
	b' :: FilePath
b' = FilePath -> FilePath
norm FilePath
b
	norm :: FilePath -> FilePath
norm = FilePath -> FilePath
normalise (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
simplifyPath

{- Converts a filename into an absolute path.
 -
 - Unlike Directory.canonicalizePath, this does not require the path
 - already exists. -}
absPath :: FilePath -> IO FilePath
absPath :: FilePath -> IO FilePath
absPath file :: FilePath
file = do
	FilePath
cwd <- IO FilePath
getCurrentDirectory
	FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
absPathFrom FilePath
cwd FilePath
file

{- Constructs a relative path from the CWD to a file.
 -
 - For example, assuming CWD is /tmp/foo/bar:
 -    relPathCwdToFile "/tmp/foo" == ".."
 -    relPathCwdToFile "/tmp/foo/bar" == "" 
 -}
relPathCwdToFile :: FilePath -> IO FilePath
relPathCwdToFile :: FilePath -> IO FilePath
relPathCwdToFile f :: FilePath
f = do
	FilePath
c <- IO FilePath
getCurrentDirectory
	FilePath -> FilePath -> IO FilePath
relPathDirToFile FilePath
c FilePath
f

{- Constructs a relative path from a directory to a file. -}
relPathDirToFile :: FilePath -> FilePath -> IO FilePath
relPathDirToFile :: FilePath -> FilePath -> IO FilePath
relPathDirToFile from :: FilePath
from to :: FilePath
to = FilePath -> FilePath -> FilePath
relPathDirToFileAbs (FilePath -> FilePath -> FilePath)
-> IO FilePath -> IO (FilePath -> FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
absPath FilePath
from IO (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> IO FilePath
absPath FilePath
to

{- This requires the first path to be absolute, and the
 - second path cannot contain ../ or ./
 -
 - On Windows, if the paths are on different drives,
 - a relative path is not possible and the path is simply
 - returned as-is.
 -}
relPathDirToFileAbs :: FilePath -> FilePath -> FilePath
relPathDirToFileAbs :: FilePath -> FilePath -> FilePath
relPathDirToFileAbs from :: FilePath
from to :: FilePath
to
#ifdef mingw32_HOST_OS
	| normdrive from /= normdrive to = to
#endif
	| Bool
otherwise = [FilePath] -> FilePath
joinPath ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
dotdots [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
uncommon
  where
	pfrom :: [FilePath]
pfrom = FilePath -> [FilePath]
sp FilePath
from
	pto :: [FilePath]
pto = FilePath -> [FilePath]
sp FilePath
to
	sp :: FilePath -> [FilePath]
sp = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
dropTrailingPathSeparator ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitPath (FilePath -> [FilePath])
-> (FilePath -> FilePath) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
dropDrive
	common :: [FilePath]
common = ((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst ([(FilePath, FilePath)] -> [FilePath])
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ((FilePath, FilePath) -> Bool)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (FilePath, FilePath) -> Bool
forall a. Eq a => (a, a) -> Bool
same ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
pfrom [FilePath]
pto
	same :: (a, a) -> Bool
same (c :: a
c,d :: a
d) = a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
d
	uncommon :: [FilePath]
uncommon = Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop Int
numcommon [FilePath]
pto
	dotdots :: [FilePath]
dotdots = Int -> FilePath -> [FilePath]
forall a. Int -> a -> [a]
replicate ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
pfrom Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numcommon) ".."
	numcommon :: Int
numcommon = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
common
#ifdef mingw32_HOST_OS
	normdrive = map toLower . takeWhile (/= ':') . takeDrive
#endif

prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
prop_relPathDirToFile_basics from :: FilePath
from to :: FilePath
to
	| FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
from Bool -> Bool -> Bool
|| FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
to = Bool
True
	| FilePath
from FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
to = FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
r
	| Bool
otherwise = Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
r)
  where
	r :: FilePath
r = FilePath -> FilePath -> FilePath
relPathDirToFileAbs FilePath
from FilePath
to 

prop_relPathDirToFile_regressionTest :: Bool
prop_relPathDirToFile_regressionTest :: Bool
prop_relPathDirToFile_regressionTest = Bool
same_dir_shortcurcuits_at_difference
  where
	{- Two paths have the same directory component at the same
	 - location, but it's not really the same directory.
	 - Code used to get this wrong. -}
	same_dir_shortcurcuits_at_difference :: Bool
same_dir_shortcurcuits_at_difference =
		FilePath -> FilePath -> FilePath
relPathDirToFileAbs ([FilePath] -> FilePath
joinPath [Char
pathSeparator Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: "tmp", "r", "lll", "xxx", "yyy", "18"])
			([FilePath] -> FilePath
joinPath [Char
pathSeparator Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: "tmp", "r", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"])
				FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== [FilePath] -> FilePath
joinPath ["..", "..", "..", "..", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"]

{- Given an original list of paths, and an expanded list derived from it,
 - which may be arbitrarily reordered, generates a list of lists, where
 - each sublist corresponds to one of the original paths.
 -
 - When the original path is a directory, any items in the expanded list
 - that are contained in that directory will appear in its segment.
 -
 - The order of the original list of paths is attempted to be preserved in
 - the order of the returned segments. However, doing so has a O^NM
 - growth factor. So, if the original list has more than 100 paths on it,
 - we stop preserving ordering at that point. Presumably a user passing
 - that many paths in doesn't care too much about order of the later ones.
 -}
segmentPaths :: [FilePath] -> [FilePath] -> [[FilePath]]
segmentPaths :: [FilePath] -> [FilePath] -> [[FilePath]]
segmentPaths [] new :: [FilePath]
new = [[FilePath]
new]
segmentPaths [_] new :: [FilePath]
new = [[FilePath]
new] -- optimisation
segmentPaths (l :: FilePath
l:ls :: [FilePath]
ls) new :: [FilePath]
new = [FilePath]
found [FilePath] -> [[FilePath]] -> [[FilePath]]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath] -> [[FilePath]]
segmentPaths [FilePath]
ls [FilePath]
rest
  where
	(found :: [FilePath]
found, rest :: [FilePath]
rest) = if [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 100
		then (FilePath -> Bool) -> [FilePath] -> ([FilePath], [FilePath])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (FilePath
l FilePath -> FilePath -> Bool
`dirContains`) [FilePath]
new
		else (FilePath -> Bool) -> [FilePath] -> ([FilePath], [FilePath])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\p :: FilePath
p -> Bool -> Bool
not (FilePath
l FilePath -> FilePath -> Bool
`dirContains` FilePath
p)) [FilePath]
new

{- This assumes that it's cheaper to call segmentPaths on the result,
 - than it would be to run the action separately with each path. In
 - the case of git file list commands, that assumption tends to hold.
 -}
runSegmentPaths :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
runSegmentPaths :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
runSegmentPaths a :: [FilePath] -> IO [FilePath]
a paths :: [FilePath]
paths = [FilePath] -> [FilePath] -> [[FilePath]]
segmentPaths [FilePath]
paths ([FilePath] -> [[FilePath]]) -> IO [FilePath] -> IO [[FilePath]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> IO [FilePath]
a [FilePath]
paths

{- Converts paths in the home directory to use ~/ -}
relHome :: FilePath -> IO String
relHome :: FilePath -> IO FilePath
relHome path :: FilePath
path = do
	FilePath
home <- IO FilePath
myHomeDir
	FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ if FilePath -> FilePath -> Bool
dirContains FilePath
home FilePath
path
		then "~/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath -> FilePath
relPathDirToFileAbs FilePath
home FilePath
path
		else FilePath
path

{- Checks if a command is available in PATH.
 -
 - The command may be fully-qualified, in which case, this succeeds as
 - long as it exists. -}
inPath :: String -> IO Bool
inPath :: FilePath -> IO Bool
inPath command :: FilePath
command = Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FilePath -> Bool) -> IO (Maybe FilePath) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
searchPath FilePath
command

{- Finds a command in PATH and returns the full path to it.
 -
 - The command may be fully qualified already, in which case it will
 - be returned if it exists.
 -
 - Note that this will find commands in PATH that are not executable.
 -}
searchPath :: String -> IO (Maybe FilePath)
searchPath :: FilePath -> IO (Maybe FilePath)
searchPath command :: FilePath
command
	| FilePath -> Bool
isAbsolute FilePath
command = FilePath -> IO (Maybe FilePath)
check FilePath
command
	| Bool
otherwise = IO [FilePath]
getSearchPath IO [FilePath]
-> ([FilePath] -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO (Maybe FilePath))
-> [FilePath] -> IO (Maybe FilePath)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
getM FilePath -> IO (Maybe FilePath)
indir
  where
	indir :: FilePath -> IO (Maybe FilePath)
indir d :: FilePath
d = FilePath -> IO (Maybe FilePath)
check (FilePath -> IO (Maybe FilePath))
-> FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
command
	check :: FilePath -> IO (Maybe FilePath)
check f :: FilePath
f = (FilePath -> IO Bool) -> [FilePath] -> IO (Maybe FilePath)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
firstM FilePath -> IO Bool
doesFileExist
#ifdef mingw32_HOST_OS
		[f, f ++ ".exe"]
#else
		[FilePath
f]
#endif

{- Checks if a filename is a unix dotfile. All files inside dotdirs
 - count as dotfiles. -}
dotfile :: FilePath -> Bool
dotfile :: FilePath -> Bool
dotfile file :: FilePath
file
	| FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "." = Bool
False
	| FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== ".." = Bool
False
	| FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "" = Bool
False
	| Bool
otherwise = "." FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
f Bool -> Bool -> Bool
|| FilePath -> Bool
dotfile (FilePath -> FilePath
takeDirectory FilePath
file)
  where
	f :: FilePath
f = FilePath -> FilePath
takeFileName FilePath
file

{- Given a string that we'd like to use as the basis for FilePath, but that
 - was provided by a third party and is not to be trusted, returns the closest
 - sane FilePath.
 -
 - All spaces and punctuation and other wacky stuff are replaced
 - with '_', except for '.'
 - "../" will thus turn into ".._", which is safe.
 -}
sanitizeFilePath :: String -> FilePath
sanitizeFilePath :: FilePath -> FilePath
sanitizeFilePath = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
sanitize
  where
	sanitize :: Char -> Char
sanitize c :: Char
c
		| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.' = Char
c
		| Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSymbol Char
c Bool -> Bool -> Bool
|| Char -> Bool
isControl Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/' = '_'
		| Bool
otherwise = Char
c

{- Similar to splitExtensions, but knows that some things in FilePaths
 - after a dot are too long to be extensions. -}
splitShortExtensions :: FilePath -> (FilePath, [String])
splitShortExtensions :: FilePath -> (FilePath, [FilePath])
splitShortExtensions = Int -> FilePath -> (FilePath, [FilePath])
splitShortExtensions' 5 -- enough for ".jpeg"
splitShortExtensions' :: Int -> FilePath -> (FilePath, [String])
splitShortExtensions' :: Int -> FilePath -> (FilePath, [FilePath])
splitShortExtensions' maxextension :: Int
maxextension = [FilePath] -> FilePath -> (FilePath, [FilePath])
go []
  where
	go :: [FilePath] -> FilePath -> (FilePath, [FilePath])
go c :: [FilePath]
c f :: FilePath
f
		| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxextension Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
base) = 
			[FilePath] -> FilePath -> (FilePath, [FilePath])
go (FilePath
extFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
c) FilePath
base
		| Bool
otherwise = (FilePath
f, [FilePath]
c)
	  where
		(base :: FilePath
base, ext :: FilePath
ext) = FilePath -> (FilePath, FilePath)
splitExtension FilePath
f
		len :: Int
len = FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
ext