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 IO (Stack String) -> IO (Stack String) -> IO (Stack String)
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> IO (Stack String)
clampRecents String
rf
    else Stack String -> IO (Stack String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Stack String
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 <- [String] -> Stack String
forall a. Ord a => [a] -> Stack a
S.fromList ([String] -> Stack String) -> IO [String] -> IO (Stack String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO Bool) -> [String] -> IO [String]
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
  Stack String -> IO (Stack String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Stack String
existing

parseRecents :: String -> Stack FilePath
parseRecents :: String -> Stack String
parseRecents = [String] -> Stack String
forall a. Ord a => [a] -> Stack a
S.fromList ([String] -> Stack String)
-> (String -> [String]) -> String -> Stack String
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 (String -> Stack String) -> IO String -> IO (Stack String)
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 = Int -> Stack String -> Stack String
forall a. Ord a => Int -> Stack a -> Stack a
S.takeStack Int
maxRs Stack String
rs
  Stack String -> IO ()
writeRecents Stack String
clamped
  Stack String -> IO (Stack String)
forall a. a -> IO a
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 String -> Stack String -> Stack String
forall a. Ord a => a -> Stack a -> Stack a
`S.insert` Stack String
rs 
      rs'' :: Stack String
rs'' = if Stack String -> Int
forall a. Stack a -> Int
S.size Stack String
rs' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxRecents
              then Stack String
rs'
              else Stack String -> Stack String
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 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines (Stack String -> [String]
forall a. OSet a -> [a]
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 (String -> Bool
forall a. [a] -> Bool
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

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

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

duplicates :: Eq a => [a] -> [Int]
duplicates :: forall a. Eq a => [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 :: forall a. Eq a => 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