module Recents where
import Control.Monad (filterM)
import Data.List (sort)
import Settings
import Stack (Stack)
import System.Environment (lookupEnv)
import System.FilePath ((</>), splitFileName, takeExtension, dropExtension, splitPath, joinPath)
import qualified Stack as S
import qualified System.Directory as D
import qualified System.IO.Strict as IOS (readFile)

getRecents :: IO (Stack FilePath)
getRecents = do
  rf <- getRecentsFile
  exists <- D.doesFileExist rf
  if exists
    then removeDeletedFiles rf *> clampRecents rf
    else return S.empty

removeDeletedFiles :: FilePath -> IO (Stack FilePath)
removeDeletedFiles fp = do
  contents <- IOS.readFile fp
  existing <- S.fromList <$> filterM D.doesFileExist (lines contents)
  writeRecents existing
  return existing

parseRecents :: String -> Stack FilePath
parseRecents = S.fromList . lines

clampRecents :: FilePath -> IO (Stack FilePath)
clampRecents fp = do
  rs <- parseRecents <$> IOS.readFile fp
  maxRs <- getMaxRecents
  let clamped = S.takeStack maxRs rs
  writeRecents clamped
  return clamped

addRecent :: FilePath -> IO ()
addRecent fp = do
  rs <- getRecents
  maxRecents <- getMaxRecents
  let rs'  = fp `S.insert` rs 
      rs'' = if S.size rs' <= maxRecents
              then rs'
              else S.removeLast rs'
  writeRecents rs''

writeRecents :: Stack FilePath -> IO ()
writeRecents stack = do
  file <- getRecentsFile
  writeFile file $ unlines (S.toList stack)

getRecentsFile :: IO FilePath
getRecentsFile = do
  maybeSnap <- lookupEnv "SNAP_USER_DATA"
  xdg <- D.getXdgDirectory D.XdgData "hascard"

  let dir = case maybeSnap of
                Just path | not (null path) -> path
                          | otherwise       -> xdg
                Nothing                     -> xdg
  D.createDirectoryIfMissing True dir

  return (dir </> "recents")

initLast :: [a] -> ([a], a)
initLast [x] = ([], x)
initLast (x:xs) = let (xs', y) = initLast xs
                   in (x:xs', y)

prep :: [FilePath] -> ([String], [FilePath])
prep [] = ([], [])
prep fps@(fp:_) = if all ((== takeExtension fp) . takeExtension) fps
  then unzip (map ((\(pre, fn) -> (pre, dropExtension fn)) . splitFileName) fps)
  else unzip (map splitFileName fps)

shortenFilepaths :: [FilePath] -> [FilePath]
shortenFilepaths = uncurry shortenFilepaths' . prep 
  where
    shortenFilepaths' prefixes abbreviations =
      let ds = duplicates abbreviations in
        if null ds then abbreviations else
          shortenFilepaths' 
            (flip map (zip [0..] prefixes) (
              \(i, pre) -> if i `elem` ds then
                joinPath (init (splitPath pre)) else pre
            ))
            (flip map (zip [0..] abbreviations) (
              \(i, abbr) -> if i `elem` ds then 
                last (splitPath (prefixes !! i)) ++ abbr
                else abbr) )
          

duplicates :: Eq a => [a] -> [Int]
duplicates = sort . map fst . duplicates' 0 [] []
  where duplicates' _ _    acc []     = acc
        duplicates' i seen acc (x:xs) = duplicates' (i+1) ((i, x) : seen) acc' xs
          where acc' = case (getPairsWithValue x acc, getPairsWithValue x seen) of
                  ([], []) -> acc
                  ([], ys) -> (i, x) : ys ++ acc
                  (_, _)   -> (i, x) : acc
                -- acc' = if getPairsWithValue x seen then (i, x) : acc else acc 

getPairsWithValue :: Eq a => a -> [(Int, a)] -> [(Int, a)]
getPairsWithValue _ []       = []
getPairsWithValue y ((i, x):xs)
  | x == y    = (i, x) : getPairsWithValue y xs
  | otherwise = getPairsWithValue y xs