{-# LANGUAGE DeriveDataTypeable #-}
module Util.UniqueString(
UniqueStringSource,
newUniqueStringSource,
newUniqueString,
maxUniqueStringSources,
UniqueStringCounter,
firstUniqueStringCounter,
stepUniqueStringCounter,
readUniqueStringSource,
createUniqueStringSource,
newNonUnique,
firstUniqueString,
) where
import Data.Array
import Control.Concurrent
import Util.ExtendedPrelude
import Util.Dynamics
printableCharsStr :: String
=
String
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-_+=|~[];:,<>/?"
printableCharsLen :: Int
printableCharsLen :: Int
printableCharsLen = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
printableCharsStr
printableCharsArr :: Array Int Char
printableCharsArr :: Array Int Char
printableCharsArr = (Int, Int) -> String -> Array Int Char
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
printableCharsLenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
printableCharsStr
newtype UniqueStringSource = UniqueStringSource (MVar UniqueStringCounter)
deriving (Typeable)
newUniqueStringSource :: IO UniqueStringSource
newUniqueStringSource :: IO UniqueStringSource
newUniqueStringSource =
do
MVar UniqueStringCounter
mVar <- UniqueStringCounter -> IO (MVar UniqueStringCounter)
forall a. a -> IO (MVar a)
newMVar UniqueStringCounter
firstUniqueStringCounter
UniqueStringSource -> IO UniqueStringSource
forall (m :: * -> *) a. Monad m => a -> m a
return (MVar UniqueStringCounter -> UniqueStringSource
UniqueStringSource MVar UniqueStringCounter
mVar)
newUniqueString :: UniqueStringSource -> IO String
newUniqueString :: UniqueStringSource -> IO String
newUniqueString (UniqueStringSource MVar UniqueStringCounter
mVar) =
do
UniqueStringCounter
uniqueStringCounter <- MVar UniqueStringCounter -> IO UniqueStringCounter
forall a. MVar a -> IO a
takeMVar MVar UniqueStringCounter
mVar
let
(String
str,UniqueStringCounter
nextUniqueStringCounter) =
UniqueStringCounter -> (String, UniqueStringCounter)
stepUniqueStringCounter UniqueStringCounter
uniqueStringCounter
MVar UniqueStringCounter -> UniqueStringCounter -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar UniqueStringCounter
mVar UniqueStringCounter
nextUniqueStringCounter
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
str
readUniqueStringSource :: UniqueStringSource -> IO [Int]
readUniqueStringSource :: UniqueStringSource -> IO [Int]
readUniqueStringSource (UniqueStringSource MVar UniqueStringCounter
mVar) =
do
(UniqueStringCounter [Int]
l) <- MVar UniqueStringCounter -> IO UniqueStringCounter
forall a. MVar a -> IO a
readMVar MVar UniqueStringCounter
mVar
[Int] -> IO [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
l
createUniqueStringSource :: [Int] -> IO UniqueStringSource
createUniqueStringSource :: [Int] -> IO UniqueStringSource
createUniqueStringSource [Int]
l =
do
MVar UniqueStringCounter
mVar <- UniqueStringCounter -> IO (MVar UniqueStringCounter)
forall a. a -> IO (MVar a)
newMVar ([Int] -> UniqueStringCounter
UniqueStringCounter [Int]
l)
UniqueStringSource -> IO UniqueStringSource
forall (m :: * -> *) a. Monad m => a -> m a
return (MVar UniqueStringCounter -> UniqueStringSource
UniqueStringSource MVar UniqueStringCounter
mVar)
maxUniqueStringSources :: [UniqueStringSource] -> IO UniqueStringSource
maxUniqueStringSources :: [UniqueStringSource] -> IO UniqueStringSource
maxUniqueStringSources [UniqueStringSource]
stringSources =
do
[UniqueStringCounter]
stringCounters <- (UniqueStringSource -> IO UniqueStringCounter)
-> [UniqueStringSource] -> IO [UniqueStringCounter]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
(\ (UniqueStringSource MVar UniqueStringCounter
mVar) -> MVar UniqueStringCounter -> IO UniqueStringCounter
forall a. MVar a -> IO a
readMVar MVar UniqueStringCounter
mVar)
[UniqueStringSource]
stringSources
let
maxCounter :: UniqueStringCounter
maxCounter = (UniqueStringCounter -> UniqueStringCounter -> UniqueStringCounter)
-> UniqueStringCounter
-> [UniqueStringCounter]
-> UniqueStringCounter
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl UniqueStringCounter -> UniqueStringCounter -> UniqueStringCounter
forall a. Ord a => a -> a -> a
max UniqueStringCounter
firstUniqueStringCounter [UniqueStringCounter]
stringCounters
MVar UniqueStringCounter
mVar <- UniqueStringCounter -> IO (MVar UniqueStringCounter)
forall a. a -> IO (MVar a)
newMVar UniqueStringCounter
maxCounter
UniqueStringSource -> IO UniqueStringSource
forall (m :: * -> *) a. Monad m => a -> m a
return (MVar UniqueStringCounter -> UniqueStringSource
UniqueStringSource MVar UniqueStringCounter
mVar)
newtype UniqueStringCounter = UniqueStringCounter [Int]
firstUniqueStringCounter :: UniqueStringCounter
firstUniqueStringCounter :: UniqueStringCounter
firstUniqueStringCounter = [Int] -> UniqueStringCounter
UniqueStringCounter [Int
0]
stepUniqueStringCounter :: UniqueStringCounter -> (String,UniqueStringCounter)
stepUniqueStringCounter :: UniqueStringCounter -> (String, UniqueStringCounter)
stepUniqueStringCounter (uniqueStringCounter :: UniqueStringCounter
uniqueStringCounter @ (UniqueStringCounter [Int]
ilist)) =
(UniqueStringCounter -> String
toStringUniqueStringCounter UniqueStringCounter
uniqueStringCounter,
[Int] -> UniqueStringCounter
UniqueStringCounter ([Int] -> [Int]
step [Int]
ilist))
where
step :: [Int] -> [Int]
step [] = [Int
1]
step (Int
first:[Int]
rest) =
if Int
first Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
printableCharsLen Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
then
Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int] -> [Int]
step [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
toStringUniqueStringCounter :: UniqueStringCounter -> String
toStringUniqueStringCounter :: UniqueStringCounter -> String
toStringUniqueStringCounter (UniqueStringCounter [Int]
ilist) =
(Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
i -> Array Int Char
printableCharsArr Array Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
! Int
i) [Int]
ilist
instance Eq UniqueStringCounter where
== :: UniqueStringCounter -> UniqueStringCounter -> Bool
(==) = (UniqueStringCounter -> [Int])
-> UniqueStringCounter -> UniqueStringCounter -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
mapEq (\ (UniqueStringCounter [Int]
l) -> [Int]
l)
instance Ord UniqueStringCounter where
compare :: UniqueStringCounter -> UniqueStringCounter -> Ordering
compare (UniqueStringCounter [Int]
l1) (UniqueStringCounter [Int]
l2)
= [Int] -> [Int] -> Ordering
forall a. Ord a => [a] -> [a] -> Ordering
comp [Int]
l1 [Int]
l2
where
comp :: [a] -> [a] -> Ordering
comp [] [] = Ordering
EQ
comp (a
_:[a]
_) [] = Ordering
GT
comp [] (a
_:[a]
_) = Ordering
LT
comp (a
c1:[a]
cs1) (a
c2:[a]
cs2) = case [a] -> [a] -> Ordering
comp [a]
cs1 [a]
cs2 of
Ordering
EQ -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
c1 a
c2
Ordering
other -> Ordering
other
firstUniqueString :: String
firstUniqueString :: String
firstUniqueString =
let
(String
s,UniqueStringCounter
_) = UniqueStringCounter -> (String, UniqueStringCounter)
stepUniqueStringCounter UniqueStringCounter
firstUniqueStringCounter
in
String
s
newNonUnique :: String -> String
newNonUnique :: String -> String
newNonUnique String
str = String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Array Int Char
printableCharsArr Array Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
! Int
0]