{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module: Filesystem.Path
-- Copyright: 2010 John Millikin
-- License: MIT
--
-- Maintainer:  jmillikin@gmail.com
-- Portability:  portable
--
-- High‐level, byte‐based file and directory path
-- manipulations. You probably want to import "Filesystem.Path.CurrentOS"
-- instead, since it handles detecting which rules to use in the current
-- compilation.
--
module Filesystem.Path
        ( FilePath
        , empty

        -- * Basic properties
        , null
        , root
        , directory
        , parent
        , filename
        , dirname
        , basename
        , absolute
        , relative

        -- * Basic operations
        , append
        , (</>)
        , concat
        , commonPrefix
        , stripPrefix
        , collapse
        , splitDirectories

        -- * Extensions
        , extension
        , extensions
        , hasExtension

        , addExtension
        , (<.>)
        , dropExtension
        , replaceExtension

        , addExtensions
        , dropExtensions
        , replaceExtensions

        , splitExtension
        , splitExtensions
        ) where

import           Prelude hiding (FilePath, concat, null)
import qualified Prelude as Prelude

import           Data.List (foldl')
import           Data.Maybe (isJust, isNothing)
import qualified Data.Semigroup as Sem
import qualified Data.Monoid as M
import qualified Data.Text as T

import           Filesystem.Path.Internal

instance Sem.Semigroup FilePath where
  (<>) = append

instance M.Monoid FilePath where
        mempty = empty
        mappend = append
        mconcat = concat

-------------------------------------------------------------------------------
-- Basic properties
-------------------------------------------------------------------------------

-- | @null p = (p == 'empty')@
null :: FilePath -> Bool
null = (== empty)

-- | Retrieves the 'FilePath'&#x2019;s root.
root :: FilePath -> FilePath
root p = empty { pathRoot = pathRoot p }

-- | Retrieves the 'FilePath'&#x2019;s directory. If the path is already a
-- directory, it is returned unchanged.
directory :: FilePath -> FilePath
directory p = empty
        { pathRoot = pathRoot p
        , pathDirectories = let
                dot' | isJust (pathRoot p) = []
                     | Prelude.null (pathDirectories p) = [dot]
                     | otherwise = []
                in dot' ++ pathDirectories p
        }

-- | Retrieves the 'FilePath'&#x2019;s parent directory.
parent :: FilePath -> FilePath
parent p = empty
        { pathRoot = pathRoot p
        , pathDirectories = let
                starts = map Just [dot, dots]
                directories = if null (filename p)
                        then safeInit (pathDirectories p)
                        else pathDirectories p

                dot' | safeHead directories `elem` starts = []
                     | isNothing (pathRoot p) = [dot]
                     | otherwise = []
                in dot' ++ directories
        }

-- | Retrieve a 'FilePath'&#x2019;s filename component.
--
-- @
-- filename \"foo\/bar.txt\" == \"bar.txt\"
-- @
filename :: FilePath -> FilePath
filename p = empty
        { pathBasename = pathBasename p
        , pathExtensions = pathExtensions p
        }

-- | Retrieve a 'FilePath'&#x2019;s directory name. This is only the
-- /file name/ of the directory, not its full path.
--
-- @
-- dirname \"foo\/bar\/baz.txt\" == \"bar\"
-- dirname \"/\" == \"\"
-- @
--
-- Since: 0.4.1
dirname :: FilePath -> FilePath
dirname p = case reverse (pathDirectories p) of
        [] -> FilePath Nothing [] Nothing []
        (d:_) -> case parseFilename d of
                (base, exts) -> FilePath Nothing [] base exts

-- | Retrieve a 'FilePath'&#x2019;s basename component.
--
-- @
-- basename \"foo/bar.txt\" == \"bar\"
-- @
basename :: FilePath -> FilePath
basename p = empty
        { pathBasename = pathBasename p
        }

-- | Test whether a path is absolute.
absolute :: FilePath -> Bool
absolute p = case pathRoot p of
        Just RootPosix -> True
        Just RootWindowsVolume{} -> True
        Just RootWindowsCurrentVolume -> False
        Just RootWindowsUnc{} -> True
        Just RootWindowsDoubleQMark -> True
        Nothing -> False

-- | Test whether a path is relative.
relative :: FilePath -> Bool
relative p = case pathRoot p of
        Just _ -> False
        _ -> True

-------------------------------------------------------------------------------
-- Basic operations
-------------------------------------------------------------------------------

-- | Appends two 'FilePath's. If the second path is absolute, it is returned
-- unchanged.
append :: FilePath -> FilePath -> FilePath
append x y = cased where
        cased = case pathRoot y of
                Just RootPosix -> y
                Just RootWindowsVolume{} -> y
                Just RootWindowsCurrentVolume -> case pathRoot x of
                        Just RootWindowsVolume{} -> y { pathRoot = pathRoot x }
                        _ -> y
                Just RootWindowsUnc{} -> y
                Just RootWindowsDoubleQMark -> y
                Nothing -> xy
        xy = y
                { pathRoot = pathRoot x
                , pathDirectories = directories
                }
        directories = xDirectories ++ pathDirectories y
        xDirectories = (pathDirectories x ++) $ if null (filename x)
                then []
                else [filenameChunk x]

-- | An alias for 'append'.
(</>) :: FilePath -> FilePath -> FilePath
(</>) = append

-- | A fold over 'append'.
concat :: [FilePath] -> FilePath
concat [] = empty
concat ps = foldr1 append ps

-- | Find the greatest common prefix between a list of 'FilePath's.
commonPrefix :: [FilePath] -> FilePath
commonPrefix [] = empty
commonPrefix ps = foldr1 step ps where
        step x y = if pathRoot x /= pathRoot y
                then empty
                else let cs = commonDirectories x y in
                        if cs /= pathDirectories x || pathBasename x /= pathBasename y
                                then empty { pathRoot = pathRoot x, pathDirectories = cs }
                                else let exts = commonExtensions x y in
                                        x { pathExtensions = exts }

        commonDirectories x y = common (pathDirectories x) (pathDirectories y)
        commonExtensions x y = common (pathExtensions x) (pathExtensions y)

        common [] _ = []
        common _ [] = []
        common (x:xs) (y:ys) = if x == y
                then x : common xs ys
                else []

-- | Remove a prefix from a path.
--
-- @
-- 'stripPrefix' \"\/foo\/\" \"\/foo\/bar\/baz.txt\" == Just \"bar\/baz.txt\"
-- 'stripPrefix' \"\/foo\/\" \"\/bar\/baz.txt\" == Nothing
-- @
--
-- This function operates on logical prefixes, rather than by counting
-- characters. The prefix @\"\/foo\/bar\/baz\"@ is interpreted the path
-- @(\"\/foo\/bar\/\", \"baz\")@, and will be stripped accordingly:
--
-- @
-- 'stripPrefix' \"\/foo\/bar\/baz\" \"\/foo\/bar\/baz\/qux\" == Nothing
-- 'stripPrefix' \"\/foo\/bar\/baz\" \"\/foo\/bar\/baz.txt\" == Just \".txt\"
-- @
--
-- Since: 0.4.1
stripPrefix :: FilePath -> FilePath -> Maybe FilePath
stripPrefix x y = if pathRoot x /= pathRoot y
        then case pathRoot x of
                Nothing -> Just y
                Just _ -> Nothing
        else do
                dirs <- strip (pathDirectories x) (pathDirectories y)
                case dirs of
                        [] -> case (pathBasename x, pathBasename y) of
                                (Nothing, Nothing) -> do
                                        exts <- strip (pathExtensions x) (pathExtensions y)
                                        return (y { pathRoot = Nothing, pathDirectories = dirs, pathExtensions = exts })
                                (Nothing, Just _) -> case pathExtensions x of
                                        [] -> Just (y { pathRoot = Nothing, pathDirectories = dirs })
                                        _ -> Nothing
                                (Just x_b, Just y_b) | x_b == y_b -> do
                                        exts <- strip (pathExtensions x) (pathExtensions y)
                                        return (empty { pathExtensions = exts })
                                _ -> Nothing
                        _ -> case (pathBasename x, pathExtensions x) of
                                (Nothing, []) -> Just (y { pathRoot = Nothing, pathDirectories = dirs })
                                _ -> Nothing

strip :: Eq a => [a] -> [a] -> Maybe [a]
strip [] ys = Just ys
strip _ [] = Nothing
strip (x:xs) (y:ys) = if x == y
        then strip xs ys
        else Nothing

-- | Remove intermediate @\".\"@ and @\"..\"@ directories from a path.
--
-- @
-- 'collapse' \"\/foo\/.\/bar\" == \"\/foo\/bar\"
-- 'collapse' \"\/foo\/bar\/..\/baz\" == \"\/foo\/baz\"
-- 'collapse' \"\/foo\/..\/..\/bar\" == \"\/bar\"
-- 'collapse' \".\/foo\/bar\" == \".\/foo\/baz\"
-- @
--
-- Note that if any of the elements are symbolic links, 'collapse' may change
-- which file the path resolves to.
--
-- Since: 0.2
collapse :: FilePath -> FilePath
collapse p = p { pathDirectories = newDirs } where
        newDirs = case pathRoot p of
                Nothing -> reverse revNewDirs
                Just _ -> dropWhile (\x -> x == dot || x == dots) (reverse revNewDirs)
        (_, revNewDirs) = foldl' step (True, []) (pathDirectories p)

        step (True, acc) c = (False, c:acc)
        step (_, acc) c | c == dot = (False, acc)
        step (_, acc) c | c == dots = case acc of
                [] -> (False, c:acc)
                (h:ts) | h == dot -> (False, c:ts)
                       | h == dots -> (False, c:acc)
                       | otherwise -> (False, ts)
        step (_, acc) c = (False, c:acc)

-- | expand a FilePath into a list of the root name, directories, and file name
--
-- Since: 0.4.7
splitDirectories :: FilePath -> [FilePath]
splitDirectories p = rootName ++ dirNames ++ fileName where
        rootName = case pathRoot p of
                Nothing -> []
                r -> [empty { pathRoot = r }]
        dirNames = map (\d -> empty { pathDirectories = [d] }) (pathDirectories p)
        fileName = case (pathBasename p, pathExtensions p) of
                (Nothing, []) -> []
                _ -> [filename p]

-------------------------------------------------------------------------------
-- Extensions
-------------------------------------------------------------------------------

-- | Get a 'FilePath'&#x2019;s last extension, or 'Nothing' if it has no
-- extensions.
extension :: FilePath -> Maybe T.Text
extension p = case extensions p of
        [] -> Nothing
        es -> Just (last es)

-- | Get a 'FilePath'&#x2019;s full extension list.
extensions :: FilePath -> [T.Text]
extensions = map unescape' . pathExtensions


-- | Get whether a 'FilePath'&#x2019;s last extension is the predicate.
hasExtension :: FilePath -> T.Text -> Bool
hasExtension p e = extension p == Just e

-- | Append an extension to the end of a 'FilePath'.
addExtension :: FilePath -> T.Text -> FilePath
addExtension p ext = addExtensions p [ext]

-- | Append many extensions to the end of a 'FilePath'.
addExtensions :: FilePath -> [T.Text] -> FilePath
addExtensions p exts = p { pathExtensions = newExtensions } where
        newExtensions = pathExtensions p ++ map escape exts

-- | An alias for 'addExtension'.
(<.>) :: FilePath -> T.Text -> FilePath
(<.>) = addExtension

-- | Remove a 'FilePath'&#x2019;s last extension.
dropExtension :: FilePath -> FilePath
dropExtension p = p { pathExtensions = safeInit (pathExtensions p) }

-- | Remove all extensions from a 'FilePath'.
dropExtensions :: FilePath -> FilePath
dropExtensions p = p { pathExtensions = [] }

-- | Replace a 'FilePath'&#x2019;s last extension.
replaceExtension :: FilePath -> T.Text -> FilePath
replaceExtension = addExtension . dropExtension

-- | Remove all extensions from a 'FilePath', and replace them with a new
-- list.
replaceExtensions :: FilePath -> [T.Text] -> FilePath
replaceExtensions = addExtensions . dropExtensions

-- | @splitExtension p = ('dropExtension' p, 'extension' p)@
splitExtension :: FilePath -> (FilePath, Maybe T.Text)
splitExtension p = (dropExtension p, extension p)

-- | @splitExtensions p = ('dropExtensions' p, 'extensions' p)@
splitExtensions :: FilePath -> (FilePath, [T.Text])
splitExtensions p = (dropExtensions p, extensions p)

-------------------------------------------------------------------------------
-- Utils
-------------------------------------------------------------------------------

safeInit :: [a] -> [a]
safeInit xs = case xs of
        [] -> []
        _ -> init xs

safeHead :: [a] -> Maybe a
safeHead [] = Nothing
safeHead (x:_) = Just x