{-# LANGUAGE CPP #-}

module Freedesktop.Trash (
    TrashFile(..),
    trashGetOrphans,
    trashGetFiles,
    trashSortFiles,
    trashRestore,
    genTrashFile,
    moveToTrash,
    getPathSize,
    formatTrashDate,
    encodeTrashPath,
    expungeTrash,
    getTrashPaths
) where


import Network.URL(encString,decString, ok_url)
import System.Posix.Env(getEnv,getEnvDefault)
import System.FilePath.Posix((</>),(<.>),dropExtension,splitExtension)
import System.Directory(getDirectoryContents,removeDirectoryRecursive)
import Data.Maybe(fromJust,catMaybes)
import System.Locale(iso8601DateFormat,defaultTimeLocale)
import Text.ParserCombinators.Parsec(parse,many,try,(<|>),string,noneOf,oneOf,many)
import Data.Time(getCurrentTimeZone,parseTime,localTimeToUTC,UTCTime,formatTime,utcToLocalTime,FormatTime)
import Data.Either(partitionEithers)
import Control.Monad(when)
import Data.Algorithm.Diff(getDiff,Diff(..))
import Data.List(sort)
import System.Posix.Files(fileSize,getSymbolicLinkStatus,isRegularFile,isDirectory,rename,removeLink,fileExist)
#if MIN_VERSION_base(4,6,0)
import System.IO.Error(catchIOError,tryIOError)
eCatch = catchIOError
eTry = tryIOError
#else
import qualified System.IO.Error(try, catch)
eCatch = System.IO.Error.catch
eTry = System.IO.Error.try
#endif


data TrashFile = TrashFile {
    infoPath   :: FilePath,
    dataPath   :: FilePath,
    origPath   :: FilePath,
    deleteTime :: UTCTime,
    totalSize  :: Integer
    } deriving (Show)

trashHeaderString = "[Trash Info]\n"

headerLine = string trashHeaderString

dateLine = do
    _ <- string "DeletionDate="
    dateString <- many $ oneOf "0123456789-T:"
    _ <- many $ noneOf "\n"
    _ <- string "\n"
    return (parseTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%S") dateString) >>=
        maybe (fail "Invalid date format") (return.Left)

nameLine = do
    _ <- string "Path="
    n <- many $ noneOf " \n\t"
    _ <- many $ noneOf "\n"
    _ <- string "\n"
    return (decString False n) >>=
        maybe (fail "Invalid url-encoded filename") (return.Right)

searchHeader = (try headerLine) <|>
    (ignoreLine >> searchHeader)

line = (try nameLine) <|>
    (try dateLine) <|>
    (ignoreLine >> line)

ignoreLine = many (noneOf "\n") >> string "\n"

infoFile timeZone = do
    _ <- searchHeader
    (dates,names) <- fmap partitionEithers $ many line
    when (length dates /= 1 || length names /= 1) $ fail "Exactly one name and date not found."
    return (localTimeToUTC timeZone (head dates), head names)

genTrashFile riPath rdPath timeZone name = do
    let iPath = riPath </> name <.> "trashinfo"
    let dPath = rdPath </> name
    size <- getPathSize dPath
    parsed <- readFile iPath >>=
         (\x -> return (parse (infoFile timeZone) "" x))
    either (\x -> print iPath >> print x >> return Nothing)
        (\(x,y) -> return.Just $ TrashFile iPath dPath y x size)
        parsed

trashSortFiles iPath fPath= do
    timeZone <- getCurrentTimeZone
    iFiles <- fmap (sort.filter (\x -> x /= ".." && x /= ".")) $ getDirectoryContents iPath
    dataFiles <- fmap (sort.filter (\x -> x /= ".." && x /= ".")) $ getDirectoryContents fPath
    let  dFiles = sort $ map (<.>"trashinfo") dataFiles
         diff   = getDiff iFiles dFiles
    files <- fmap catMaybes $ mapM (genTrashFile iPath fPath timeZone) (diffBth diff)
    return (files, (diffFst diff, map dropExtension $ diffSnd diff))
    where diffFst ((First l):xs) = l : diffFst xs
          diffFst []         = []
          diffFst (_:xs)     = diffFst xs
          diffSnd ((Second l):xs) = dropExtension l : diffSnd xs
          diffSnd []         = []
          diffSnd (_:xs)     = diffSnd xs
          diffBth ((Both l _):xs) = dropExtension l : diffBth xs
          diffBth []         = []
          diffBth (_:xs)     = diffBth xs

trashGetOrphans iPath fPath = fmap snd $ trashSortFiles iPath fPath

trashGetFiles iPath fPath = fmap fst $ trashSortFiles iPath fPath

formatTrashDate :: FormatTime a => a -> String
formatTrashDate = formatTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%S")

encodeTrashPath = encString False ok_url

doRemoveFile file = eCatch (removeDirectoryRecursive file)
    (\_ -> eTry (removeLink file) >> return ())
    >> return ()

expungeTrash file = do
    doRemoveFile (dataPath file)
    doRemoveFile (infoPath file)

trashRestore file condName = do
    rename (dataPath file) $ maybe (origPath file) id condName
    expungeTrash file

getPathSize path = do
    stat <- getSymbolicLinkStatus path
    if (isDirectory stat)
      then do
        files <- fmap (map (path</>) . filter (\x -> x /= ".." && x /= ".")) $ getDirectoryContents path
        fmap sum (mapM getPathSize files)
      else do
        if (isRegularFile stat)
          then return (fromIntegral $ fileSize stat)
          else return 0

getTrashPaths = do
    defaultRoot <- fmap ((</> ".local/share/").fromJust) $ getEnv "HOME"
    rootPath <- fmap (</> "Trash") $ getEnvDefault "XDG_DATA_HOME" defaultRoot
    let iPath = rootPath </> "info"
    let fPath = rootPath </> "files"
    return (iPath,fPath)

getFreeTrashSlot :: TrashFile -> Maybe Int -> IO TrashFile
getFreeTrashSlot trashFile Nothing = do
    iExists <- fileExist $ infoPath trashFile
    dExists <- fileExist $ dataPath trashFile
    if (iExists || dExists)
      then getFreeTrashSlot trashFile (Just 0)
      else return trashFile
getFreeTrashSlot trashFile (Just index) = do
    let (iPath',iExt2)     = splitExtension $ infoPath trashFile
        (iPath,iExt1)      = splitExtension $ iPath'
        (dPath,dExt)       = splitExtension $ dataPath trashFile
        iTry               = iPath <.> show index <.> iExt1 <.> iExt2
        dTry               = dPath <.> show index <.> dExt

    iExists <- fileExist iTry
    dExists <- fileExist dTry
    if (iExists || dExists)
      then getFreeTrashSlot trashFile (Just $ index + 1)
      else return trashFile{infoPath=iTry, dataPath=dTry}

doMoveToTrash trashFile = do
    timeZone <- getCurrentTimeZone
    rename (origPath trashFile) (dataPath trashFile)
    writeFile (infoPath trashFile)
        (  trashHeaderString
        ++ "Path=" ++ (encodeTrashPath $ origPath trashFile) ++ "\n"
        ++ "DeletionDate=" ++ formatTrashDate (utcToLocalTime timeZone $ deleteTime trashFile) ++ "\n"
        )

moveToTrash trashFile = do
    yes <- fileExist $ origPath trashFile
    target <- getFreeTrashSlot trashFile Nothing
    when yes $ doMoveToTrash target