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 :: IO (Stack FilePath)
getRecents = do
  FilePath
rf <- IO FilePath
getRecentsFile
  Bool
exists <- FilePath -> IO Bool
D.doesFileExist FilePath
rf
  if Bool
exists
    then FilePath -> IO (Stack FilePath)
removeDeletedFiles FilePath
rf IO (Stack FilePath) -> IO (Stack FilePath) -> IO (Stack FilePath)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> FilePath -> IO (Stack FilePath)
clampRecents FilePath
rf
    else Stack FilePath -> IO (Stack FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Stack FilePath
forall a. Stack a
S.empty

removeDeletedFiles :: FilePath -> IO (Stack FilePath)
removeDeletedFiles :: FilePath -> IO (Stack FilePath)
removeDeletedFiles FilePath
fp = do
  FilePath
contents <- FilePath -> IO FilePath
IOS.readFile FilePath
fp
  Stack FilePath
existing <- [FilePath] -> Stack FilePath
forall a. Ord a => [a] -> Stack a
S.fromList ([FilePath] -> Stack FilePath)
-> IO [FilePath] -> IO (Stack FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
D.doesFileExist (FilePath -> [FilePath]
lines FilePath
contents)
  Stack FilePath -> IO ()
writeRecents Stack FilePath
existing
  Stack FilePath -> IO (Stack FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Stack FilePath
existing

parseRecents :: String -> Stack FilePath
parseRecents :: FilePath -> Stack FilePath
parseRecents = [FilePath] -> Stack FilePath
forall a. Ord a => [a] -> Stack a
S.fromList ([FilePath] -> Stack FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> Stack FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines

clampRecents :: FilePath -> IO (Stack FilePath)
clampRecents :: FilePath -> IO (Stack FilePath)
clampRecents FilePath
fp = do
  Stack FilePath
rs <- FilePath -> Stack FilePath
parseRecents (FilePath -> Stack FilePath) -> IO FilePath -> IO (Stack FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
IOS.readFile FilePath
fp
  Int
maxRs <- IO Int
getMaxRecents
  let clamped :: Stack FilePath
clamped = Int -> Stack FilePath -> Stack FilePath
forall a. Ord a => Int -> Stack a -> Stack a
S.takeStack Int
maxRs Stack FilePath
rs
  Stack FilePath -> IO ()
writeRecents Stack FilePath
clamped
  Stack FilePath -> IO (Stack FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Stack FilePath
clamped

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

writeRecents :: Stack FilePath -> IO ()
writeRecents :: Stack FilePath -> IO ()
writeRecents Stack FilePath
stack = do
  FilePath
file <- IO FilePath
getRecentsFile
  FilePath -> FilePath -> IO ()
writeFile FilePath
file (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines (Stack FilePath -> [FilePath]
forall (t :: * -> *) a. Foldable t => t a -> [a]
S.toList Stack FilePath
stack)

getRecentsFile :: IO FilePath
getRecentsFile :: IO FilePath
getRecentsFile = do
  Maybe FilePath
maybeSnap <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"SNAP_USER_DATA"
  FilePath
xdg <- XdgDirectory -> FilePath -> IO FilePath
D.getXdgDirectory XdgDirectory
D.XdgData FilePath
"hascard"

  let dir :: FilePath
dir = case Maybe FilePath
maybeSnap of
                Just FilePath
path | Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
path) -> FilePath
path
                          | Bool
otherwise       -> FilePath
xdg
                Maybe FilePath
Nothing                     -> FilePath
xdg
  Bool -> FilePath -> IO ()
D.createDirectoryIfMissing Bool
True FilePath
dir

  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"recents")

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

prep :: [FilePath] -> ([String], [FilePath])
prep :: [FilePath] -> ([FilePath], [FilePath])
prep [] = ([], [])
prep fps :: [FilePath]
fps@(FilePath
fp:[FilePath]
_) = if (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> FilePath
takeExtension FilePath
fp) (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension) [FilePath]
fps
  then [(FilePath, FilePath)] -> ([FilePath], [FilePath])
forall a b. [(a, b)] -> ([a], [b])
unzip ((FilePath -> (FilePath, FilePath))
-> [FilePath] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map ((\(FilePath
pre, FilePath
fn) -> (FilePath
pre, FilePath -> FilePath
dropExtension FilePath
fn)) ((FilePath, FilePath) -> (FilePath, FilePath))
-> (FilePath -> (FilePath, FilePath))
-> FilePath
-> (FilePath, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
splitFileName) [FilePath]
fps)
  else [(FilePath, FilePath)] -> ([FilePath], [FilePath])
forall a b. [(a, b)] -> ([a], [b])
unzip ((FilePath -> (FilePath, FilePath))
-> [FilePath] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> (FilePath, FilePath)
splitFileName [FilePath]
fps)

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

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

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