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

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

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

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

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

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

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

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

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

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

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

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

duplicates :: Eq a => [a] -> [Int]
duplicates :: forall a. Eq a => [a] -> [Int]
duplicates = forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
iforall a. Num a => a -> a -> a
+Int
1) ((Int
i, b
x) forall a. a -> [a] -> [a]
: [(Int, b)]
seen) [(Int, b)]
acc' [b]
xs
          where acc' :: [(Int, b)]
acc' = case (forall a. Eq a => a -> [(Int, a)] -> [(Int, a)]
getPairsWithValue b
x [(Int, b)]
acc, 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) forall a. a -> [a] -> [a]
: [(Int, b)]
ys forall a. [a] -> [a] -> [a]
++ [(Int, b)]
acc
                  ([(Int, b)]
_, [(Int, b)]
_)   -> (Int
i, b
x) 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 :: forall a. Eq a => a -> [(Int, a)] -> [(Int, a)]
getPairsWithValue a
_ []       = []
getPairsWithValue a
y ((Int
i, a
x):[(Int, a)]
xs)
  | a
x forall a. Eq a => a -> a -> Bool
== a
y    = (Int
i, a
x) forall a. a -> [a] -> [a]
: forall a. Eq a => a -> [(Int, a)] -> [(Int, a)]
getPairsWithValue a
y [(Int, a)]
xs
  | Bool
otherwise = forall a. Eq a => a -> [(Int, a)] -> [(Int, a)]
getPairsWithValue a
y [(Int, a)]
xs