module Util.UniqueFile(
UniqueFileCounter,
initialUniqueFileCounter,
stepUniqueFileCounter,
UniqueFileStore,
newUniqueFileStore,
ensureDirectories,
getFilePath,
) where
import System.Directory
import Data.Char
import Util.IOExtras
import Util.Registry
import Util.FileNames
import Util.Computation(done)
newtype UniqueFileCounter = UniqueFileCounter [Int] deriving (Int -> UniqueFileCounter -> ShowS
[UniqueFileCounter] -> ShowS
UniqueFileCounter -> String
(Int -> UniqueFileCounter -> ShowS)
-> (UniqueFileCounter -> String)
-> ([UniqueFileCounter] -> ShowS)
-> Show UniqueFileCounter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UniqueFileCounter] -> ShowS
$cshowList :: [UniqueFileCounter] -> ShowS
show :: UniqueFileCounter -> String
$cshow :: UniqueFileCounter -> String
showsPrec :: Int -> UniqueFileCounter -> ShowS
$cshowsPrec :: Int -> UniqueFileCounter -> ShowS
Show,ReadPrec [UniqueFileCounter]
ReadPrec UniqueFileCounter
Int -> ReadS UniqueFileCounter
ReadS [UniqueFileCounter]
(Int -> ReadS UniqueFileCounter)
-> ReadS [UniqueFileCounter]
-> ReadPrec UniqueFileCounter
-> ReadPrec [UniqueFileCounter]
-> Read UniqueFileCounter
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UniqueFileCounter]
$creadListPrec :: ReadPrec [UniqueFileCounter]
readPrec :: ReadPrec UniqueFileCounter
$creadPrec :: ReadPrec UniqueFileCounter
readList :: ReadS [UniqueFileCounter]
$creadList :: ReadS [UniqueFileCounter]
readsPrec :: Int -> ReadS UniqueFileCounter
$creadsPrec :: Int -> ReadS UniqueFileCounter
Read)
initialUniqueFileCounter :: UniqueFileCounter
initialUniqueFileCounter :: UniqueFileCounter
initialUniqueFileCounter = [Int] -> UniqueFileCounter
UniqueFileCounter [Int
0]
stepUniqueFileCounter :: UniqueFileCounter -> (String,UniqueFileCounter)
stepUniqueFileCounter :: UniqueFileCounter -> (String, UniqueFileCounter)
stepUniqueFileCounter (UniqueFileCounter [Int]
ilist) =
([Int] -> String
toString [Int]
ilist,[Int] -> UniqueFileCounter
UniqueFileCounter ([Int] -> [Int]
increment [Int]
ilist))
where
toString :: [Int] -> String
toString :: [Int] -> String
toString [] = ShowS
forall a. HasCallStack => String -> a
error String
"UniqueFile.toString"
toString (Int
first:[Int]
rest) = String -> [Int] -> String
tS [Int -> Char
encodeChar Int
first] [Int]
rest
where
tS :: String -> [Int] -> String
tS :: String -> [Int] -> String
tS String
acc [] = String
acc
tS String
acc (Int
first:[Int]
rest) = String -> [Int] -> String
tS ((Int -> Char
encodeChar Int
first)Char -> ShowS
forall a. a -> [a] -> [a]
:Char
fileSepChar -> ShowS
forall a. a -> [a] -> [a]
:String
acc) [Int]
rest
encodeChar :: Int -> Char
encodeChar :: Int -> Char
encodeChar Int
i=
if Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
26 then
Int -> Char
chr(Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
else if Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
52 then
Int -> Char
chr((Char -> Int
ord Char
'A'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
26)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i)
else if Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
62 then
Int -> Char
chr((Char -> Int
ord Char
'0'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
52)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i)
else case Int
i of
Int
62 -> Char
'@'
Int
63 -> Char
'+'
Int
_ -> String -> Char
forall a. HasCallStack => String -> a
error String
"UniqueFile.encodeChar"
increment :: [Int] -> [Int]
increment :: [Int] -> [Int]
increment (Int
file:[Int]
rest) =
if Int
fileInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==(Int
dividerInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
then
Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:([Int] -> [Int]
incrementDirs [Int]
rest)
else
(Int
fileInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
rest
where
incrementDirs :: [Int] -> [Int]
incrementDirs :: [Int] -> [Int]
incrementDirs [] = [Int
divider]
incrementDirs (Int
first:[Int]
rest) =
if Int
firstInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==(Int
nCharsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
then
Int
dividerInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:([Int] -> [Int]
incrementDirs [Int]
rest)
else
(Int
firstInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
rest
divider :: Int
divider :: Int
divider = Int
22
nChars :: Int
nChars :: Int
nChars = Int
64
data UniqueFileStore = UniqueFileStore {
UniqueFileStore -> String
directory :: FilePath,
UniqueFileStore -> LockedRegistry String ()
alreadyExistsRegistry :: LockedRegistry String (),
UniqueFileStore -> String -> IO ()
createDirAct :: FilePath -> IO ()
}
newUniqueFileStore :: FilePath -> (FilePath -> IO ()) -> IO UniqueFileStore
newUniqueFileStore :: String -> (String -> IO ()) -> IO UniqueFileStore
newUniqueFileStore String
directory String -> IO ()
createDirAct =
do
Bool
exists <- String -> IO Bool
doesDirectoryExist String
directory
if Bool
exists
then
IO ()
forall (m :: * -> *). Monad m => m ()
done
else
String -> IO ()
forall a. HasCallStack => String -> a
error String
"UniqueFile.newUniqueFileStore: directory must alreay exist"
LockedRegistry String ()
alreadyExistsRegistry <- IO (LockedRegistry String ())
forall registry. NewRegistry registry => IO registry
newRegistry
UniqueFileStore -> IO UniqueFileStore
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqueFileStore :: String
-> LockedRegistry String () -> (String -> IO ()) -> UniqueFileStore
UniqueFileStore {
directory :: String
directory = ShowS
trimDir String
directory,
createDirAct :: String -> IO ()
createDirAct = String -> IO ()
createDirAct,
alreadyExistsRegistry :: LockedRegistry String ()
alreadyExistsRegistry = LockedRegistry String ()
alreadyExistsRegistry
})
ensureDirectories :: UniqueFileStore -> String -> IO ()
ensureDirectories :: UniqueFileStore -> String -> IO ()
ensureDirectories (uniqueFileStore :: UniqueFileStore
uniqueFileStore @ UniqueFileStore {directory :: UniqueFileStore -> String
directory = String
directory,
createDirAct :: UniqueFileStore -> String -> IO ()
createDirAct = String -> IO ()
createDirAct,
alreadyExistsRegistry :: UniqueFileStore -> LockedRegistry String ()
alreadyExistsRegistry = LockedRegistry String ()
alreadyExistsRegistry}) String
fullName =
case String -> (String, String)
splitName String
fullName of
(String
subDir,String
rest)
| String
subDir String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
thisDir -> IO ()
forall (m :: * -> *). Monad m => m ()
done
| Bool
True ->
LockedRegistry String ()
-> String -> (Maybe () -> IO (Maybe (), ())) -> IO ()
forall registry from to extra.
GetSetRegistry registry from to =>
registry -> from -> (Maybe to -> IO (Maybe to, extra)) -> IO extra
transformValue LockedRegistry String ()
alreadyExistsRegistry String
subDir
(\ Maybe ()
existsOpt ->
do
case Maybe ()
existsOpt of
Just () ->
IO ()
forall (m :: * -> *). Monad m => m ()
done
Maybe ()
Nothing ->
do
UniqueFileStore -> String -> IO ()
ensureDirectories UniqueFileStore
uniqueFileStore String
subDir
IO () -> IO (Maybe ())
forall a. IO a -> IO (Maybe a)
catchAlreadyExists (String -> IO ()
createDirAct String
subDir)
IO ()
forall (m :: * -> *). Monad m => m ()
done
(Maybe (), ()) -> IO (Maybe (), ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Maybe ()
forall a. a -> Maybe a
Just (),())
)
getFilePath :: UniqueFileStore -> String -> FilePath
getFilePath :: UniqueFileStore -> ShowS
getFilePath (UniqueFileStore {directory :: UniqueFileStore -> String
directory = String
directory}) String
file =
String -> ShowS
combineNames String
directory String
file