-- | A module containing various function for manipulating and examinating
--   files and directories.
module Text.Hakyll.File
    ( toDestination
    , toCache
    , toUrl
    , toRoot
    , removeSpaces
    , makeDirectories
    , getRecursiveContents
    , sortByBaseName
    , havingExtension
    , directory
    , isMoreRecent
    , isFileMoreRecent
    ) where

import System.Directory
import System.FilePath
import System.Time (ClockTime)
import Control.Monad
import Data.List (isPrefixOf, sortBy)
import Data.Ord (comparing)
import Control.Monad.Reader (liftIO)

import Text.Hakyll.Hakyll
import Text.Hakyll.Internal.FileType (isRenderableFile)

-- | Auxiliary function to remove pathSeparators form the start. We don't deal
--   with absolute paths here. We also remove $root from the start.
removeLeadingSeparator :: FilePath -> FilePath
removeLeadingSeparator [] = []
removeLeadingSeparator path
    | head path' `elem` pathSeparators = tail path'
    | otherwise                        = path'
  where
    path' = if "$root" `isPrefixOf` path then drop 5 path
                                         else path

-- | Convert a relative filepath to a filepath in the destination
--   (default: @_site@).
toDestination :: FilePath -> Hakyll FilePath
toDestination url = do dir <- askHakyll siteDirectory
                       enableIndexUrl' <- askHakyll enableIndexUrl
                       let destination = if enableIndexUrl' && separatorEnd
                               then dir </> noSeparator </> "index.html"
                               else dir </> noSeparator
                       return destination
  where
    noSeparator = removeLeadingSeparator url
    separatorEnd = not (null url) && last url == '/'

-- | Convert a relative filepath to a filepath in the cache
--   (default: @_cache@).
toCache :: FilePath -> Hakyll FilePath
toCache path = do dir <- askHakyll cacheDirectory
                  return $ dir </> removeLeadingSeparator path

-- | Get the url for a given page. For most extensions, this would be the path
--   itself. It's only for rendered extensions (@.markdown@, @.rst@, @.lhs@ this
--   function returns a path with a @.html@ extension instead.
toUrl :: FilePath -> Hakyll FilePath
toUrl path = do enableIndexUrl' <- askHakyll enableIndexUrl
                -- If the file does not have a renderable extension, like for
                -- example favicon.ico, we don't have to change it at all.
                return $ if not (isRenderableFile path)
                            then path
                            -- If index url's are enabled, we create pick it
                            -- unless the page is an index already.
                            else if enableIndexUrl' && not isIndex
                                then indexUrl
                                else withSimpleHtmlExtension
  where
    isIndex = dropExtension (takeFileName path) == "index"
    withSimpleHtmlExtension = flip addExtension ".html" $ dropExtension path
    indexUrl = dropExtension path ++ "/"
                            

-- | Get the relative url to the site root, for a given (absolute) url
toRoot :: FilePath -> FilePath
toRoot = emptyException . joinPath . map parent . splitPath
       . takeDirectory . removeLeadingSeparator
  where
    parent = const ".."
    emptyException [] = "."
    emptyException x  = x

-- | Swaps spaces for '-'.
removeSpaces :: FilePath -> FilePath
removeSpaces = map swap
  where
    swap ' ' = '-'
    swap x   = x

-- | Given a path to a file, try to make the path writable by making
--   all directories on the path.
makeDirectories :: FilePath -> Hakyll ()
makeDirectories path = liftIO $ createDirectoryIfMissing True dir
  where
    dir = takeDirectory path

-- | Get all contents of a directory. Note that files starting with a dot (.)
--   will be ignored.
getRecursiveContents :: FilePath -> Hakyll [FilePath]
getRecursiveContents topdir = do
    names <- liftIO $ getDirectoryContents topdir
    let properNames = filter isProper names
    paths <- forM properNames $ \name -> do
        let path = topdir </> name
        isDirectory <- liftIO $ doesDirectoryExist path
        if isDirectory
            then getRecursiveContents path
            else return [path]
    return (concat paths)
  where
    isProper = not . (== '.') . head

-- | Sort a list of filenames on the basename.
sortByBaseName :: [FilePath] -> [FilePath]
sortByBaseName = sortBy compareBaseName
  where
    compareBaseName = comparing takeFileName

-- | A filter that takes all file names with a given extension. Prefix the
--   extension with a dot:
--
--   > havingExtension ".markdown" [ "index.markdown"
--   >                             , "style.css"
--   >                             ] == ["index.markdown"]
havingExtension :: String -> [FilePath] -> [FilePath]
havingExtension extension = filter ((==) extension . takeExtension)

-- | Perform a Hakyll action on every file in a given directory.
directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
directory action dir = getRecursiveContents dir >>= mapM_ action

-- | Check if a timestamp is newer then a number of given files.
isMoreRecent :: ClockTime  -- ^ The time to check.
             -> [FilePath] -- ^ Dependencies of the cached file.
             -> Hakyll Bool
isMoreRecent _ [] = return True
isMoreRecent timeStamp depends = do
    dependsModified <- liftIO $ mapM getModificationTime depends
    return (timeStamp >= maximum dependsModified)

-- | Check if a file is newer then a number of given files.
isFileMoreRecent :: FilePath   -- ^ The cached file.
                 -> [FilePath] -- ^ Dependencies of the cached file.
                 -> Hakyll Bool
isFileMoreRecent file depends = do
    exists <- liftIO $ doesFileExist file
    if not exists
        then return False
        else do timeStamp <- liftIO $ getModificationTime file
                isMoreRecent timeStamp depends