module Caskfile (getFileIdFromPath, listCaskFiles, removePrevFiles, getLastFileId, getCurrentFileId, prependEntry, readEntryFromPos, createCaskLock, readEntries) where import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Int (Int64) import Entry (Entry (..), getEntryLength) import Serializable (decode, encode) import System.Directory (doesFileExist, listDirectory, removeFile) import System.FilePath (takeBaseName, takeDirectory, takeExtension, (</>)) getFileIdFromPath :: FilePath -> Int getFileIdFromPath :: String -> Int getFileIdFromPath = String -> Int forall a. Read a => String -> a read (String -> Int) -> (String -> String) -> String -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> String takeBaseName listCaskFiles :: FilePath -> IO [FilePath] listCaskFiles :: String -> IO [String] listCaskFiles String dirpath = do [String] workfiles <- String -> IO [String] listDirectory String dirpath case (String -> Bool) -> [String] -> [String] forall a. (a -> Bool) -> [a] -> [a] filter (\String workfile -> String -> String takeExtension String workfile String -> String -> Bool forall a. Eq a => a -> a -> Bool == String ".cask") [String] workfiles of [] -> [String] -> IO [String] forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure [] [String] files -> [String] -> IO [String] forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure [String] files removePrevFiles :: FilePath -> IO () removePrevFiles :: String -> IO () removePrevFiles String filepath = do let fileid :: Int fileid = String -> Int getFileIdFromPath String filepath let dir :: String dir = String -> String takeDirectory String filepath [String] caskfiles <- String -> IO [String] listCaskFiles String dir let casks :: [Int] casks = (String -> Int) -> [String] -> [Int] forall a b. (a -> b) -> [a] -> [b] map String -> Int getFileIdFromPath [String] caskfiles let caskIdsToRemove :: [Int] caskIdsToRemove = (Int -> Bool) -> [Int] -> [Int] forall a. (a -> Bool) -> [a] -> [a] filter (Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int fileid) [Int] casks let caskfilesToRemove :: [String] caskfilesToRemove = (Int -> String) -> [Int] -> [String] forall a b. (a -> b) -> [a] -> [b] map (\Int fileid' -> String dir String -> String -> String </> Int -> String forall a. Show a => a -> String show Int fileid' String -> String -> String forall a. [a] -> [a] -> [a] ++ String ".cask") [Int] caskIdsToRemove (String -> IO ()) -> [String] -> IO () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ String -> IO () removeFile [String] caskfilesToRemove getLastFileId :: FilePath -> IO Int getLastFileId :: String -> IO Int getLastFileId String dirpath = do [String] caskfiles <- String -> IO [String] listCaskFiles String dirpath let fileIds :: [Int] fileIds = (String -> Int) -> [String] -> [Int] forall a b. (a -> b) -> [a] -> [b] map String -> Int getFileIdFromPath [String] caskfiles case [Int] fileIds of [] -> Int -> IO Int forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure Int 0 [Int] _ -> Int -> IO Int forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Int -> IO Int) -> Int -> IO Int forall a b. (a -> b) -> a -> b $ [Int] -> Int forall a. Ord a => [a] -> a forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum [Int] fileIds getCurrentFileId :: FilePath -> IO Int getCurrentFileId :: String -> IO Int getCurrentFileId String dirpath = (Int -> Int) -> IO Int -> IO Int forall a b. (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Int 1 Int -> Int -> Int forall a. Num a => a -> a -> a +) (String -> IO Int getLastFileId String dirpath) prependEntry :: FilePath -> Entry -> IO Entry prependEntry :: String -> Entry -> IO Entry prependEntry String filepath Entry entry = do Bool exists <- String -> IO Bool doesFileExist String filepath ByteString contents <- if Bool exists then String -> IO ByteString B.readFile String filepath else ByteString -> IO ByteString forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ByteString B.empty String -> ByteString -> IO () BL.writeFile String filepath (ByteString -> IO ()) -> ByteString -> IO () forall a b. (a -> b) -> a -> b $ Entry -> ByteString forall a. Serializable a => a -> ByteString encode Entry entry ByteString -> ByteString -> ByteString forall a. Semigroup a => a -> a -> a <> ByteString -> ByteString BL.fromStrict ByteString contents Entry -> IO Entry forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure Entry entry decodeWithOffset :: BL.ByteString -> Int -> IO [(Int, Entry)] decodeWithOffset :: ByteString -> Int -> IO [(Int, Entry)] decodeWithOffset ByteString content Int offset = do let content' :: ByteString content' = Int64 -> ByteString -> ByteString BL.drop (Int -> Int64 forall a b. (Integral a, Num b) => a -> b fromIntegral Int offset) ByteString content if ByteString content' ByteString -> ByteString -> Bool forall a. Eq a => a -> a -> Bool == ByteString BL.empty then do [(Int, Entry)] -> IO [(Int, Entry)] forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure [] else do let entry :: Entry entry = ByteString -> Entry forall a. Serializable a => ByteString -> a decode ByteString content' [(Int, Entry)] entries <- ByteString -> Int -> IO [(Int, Entry)] decodeWithOffset ByteString content (Int -> IO [(Int, Entry)]) -> Int -> IO [(Int, Entry)] forall a b. (a -> b) -> a -> b $ Int offset Int -> Int -> Int forall a. Num a => a -> a -> a + Entry -> Int getEntryLength Entry entry [(Int, Entry)] -> IO [(Int, Entry)] forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ([(Int, Entry)] -> IO [(Int, Entry)]) -> [(Int, Entry)] -> IO [(Int, Entry)] forall a b. (a -> b) -> a -> b $ (Int offset, Entry entry) (Int, Entry) -> [(Int, Entry)] -> [(Int, Entry)] forall a. a -> [a] -> [a] : [(Int, Entry)] entries readEntries :: FilePath -> IO [(Int, Entry)] readEntries :: String -> IO [(Int, Entry)] readEntries String filepath = do ByteString content <- String -> IO ByteString BL.readFile String filepath ByteString -> Int -> IO [(Int, Entry)] decodeWithOffset ByteString content Int 0 readEntryFromPos :: FilePath -> Int64 -> Int64 -> Int64 -> IO Entry readEntryFromPos :: String -> Int64 -> Int64 -> Int64 -> IO Entry readEntryFromPos String filepath Int64 ksize Int64 vsize Int64 offset = do let offset' :: Int64 offset' = Int64 offset Int64 -> Int64 -> Int64 forall a. Num a => a -> a -> a - Int64 vsize Int64 -> Int64 -> Int64 forall a. Num a => a -> a -> a - Int64 ksize Int64 -> Int64 -> Int64 forall a. Num a => a -> a -> a - Int64 8 Int64 -> Int64 -> Int64 forall a. Num a => a -> a -> a - Int64 8 Int64 -> Int64 -> Int64 forall a. Num a => a -> a -> a - Int64 8 Int64 -> Int64 -> Int64 forall a. Num a => a -> a -> a - Int64 4 ByteString content <- String -> IO ByteString BL.readFile String filepath Entry -> IO Entry forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Entry -> IO Entry) -> Entry -> IO Entry forall a b. (a -> b) -> a -> b $ ByteString -> Entry forall a. Serializable a => ByteString -> a decode (ByteString -> Entry) -> ByteString -> Entry forall a b. (a -> b) -> a -> b $ Int64 -> ByteString -> ByteString BL.drop Int64 offset' ByteString content createCaskLock :: FilePath -> IO () createCaskLock :: String -> IO () createCaskLock String dirpath = do String -> ByteString -> IO () BL.writeFile (String dirpath String -> String -> String </> String "cask.lock") ByteString ""