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
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