module Graphs.NewNames (
NameSource,
NameSourceBranch,
branch,
useBranch,
initialBranch,
getNewName,
FrozenNameSource,
freezeNameSource,
defrostNameSource,
) where
import Util.Computation
import Control.Concurrent
data NameSource = NameSource {
NameSource -> [Int]
nameSourceId :: [Int],
NameSource -> MVar Int
branchCounter :: MVar Int,
NameSource -> MVar Int
nameCounter :: MVar Int
}
newtype NameSourceBranch = NameSourceBranch [Int] deriving (ReadPrec [NameSourceBranch]
ReadPrec NameSourceBranch
Int -> ReadS NameSourceBranch
ReadS [NameSourceBranch]
(Int -> ReadS NameSourceBranch)
-> ReadS [NameSourceBranch]
-> ReadPrec NameSourceBranch
-> ReadPrec [NameSourceBranch]
-> Read NameSourceBranch
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NameSourceBranch]
$creadListPrec :: ReadPrec [NameSourceBranch]
readPrec :: ReadPrec NameSourceBranch
$creadPrec :: ReadPrec NameSourceBranch
readList :: ReadS [NameSourceBranch]
$creadList :: ReadS [NameSourceBranch]
readsPrec :: Int -> ReadS NameSourceBranch
$creadsPrec :: Int -> ReadS NameSourceBranch
Read,Int -> NameSourceBranch -> ShowS
[NameSourceBranch] -> ShowS
NameSourceBranch -> String
(Int -> NameSourceBranch -> ShowS)
-> (NameSourceBranch -> String)
-> ([NameSourceBranch] -> ShowS)
-> Show NameSourceBranch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameSourceBranch] -> ShowS
$cshowList :: [NameSourceBranch] -> ShowS
show :: NameSourceBranch -> String
$cshow :: NameSourceBranch -> String
showsPrec :: Int -> NameSourceBranch -> ShowS
$cshowsPrec :: Int -> NameSourceBranch -> ShowS
Show)
branch :: NameSource -> IO NameSourceBranch
branch :: NameSource -> IO NameSourceBranch
branch (NameSource
{nameSourceId :: NameSource -> [Int]
nameSourceId = [Int]
nameSourceId,branchCounter :: NameSource -> MVar Int
branchCounter = MVar Int
branchCounter}) =
do
Int
branchNo <- MVar Int -> IO Int
forall a. MVar a -> IO a
takeMVar MVar Int
branchCounter
MVar Int -> Int -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Int
branchCounter (Int
branchNoInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
NameSourceBranch -> IO NameSourceBranch
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> NameSourceBranch
NameSourceBranch (Int
branchNoInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
nameSourceId))
useBranch :: NameSourceBranch -> IO NameSource
useBranch :: NameSourceBranch -> IO NameSource
useBranch (NameSourceBranch [Int]
nameSourceId) =
do
MVar Int
branchCounter <- Int -> IO (MVar Int)
forall a. a -> IO (MVar a)
newMVar Int
0
MVar Int
nameCounter <- Int -> IO (MVar Int)
forall a. a -> IO (MVar a)
newMVar Int
0
NameSource -> IO NameSource
forall (m :: * -> *) a. Monad m => a -> m a
return (NameSource :: [Int] -> MVar Int -> MVar Int -> NameSource
NameSource {
nameSourceId :: [Int]
nameSourceId = [Int]
nameSourceId,
branchCounter :: MVar Int
branchCounter = MVar Int
branchCounter,
nameCounter :: MVar Int
nameCounter = MVar Int
nameCounter
})
initialBranch :: NameSourceBranch
initialBranch :: NameSourceBranch
initialBranch = [Int] -> NameSourceBranch
NameSourceBranch []
getNewName :: NameSource -> IO String
getNewName :: NameSource -> IO String
getNewName
(NameSource {nameSourceId :: NameSource -> [Int]
nameSourceId = [Int]
nameSourceId,nameCounter :: NameSource -> MVar Int
nameCounter=MVar Int
nameCounter}) =
do
Int
nameNo <- MVar Int -> IO Int
forall a. MVar a -> IO a
takeMVar MVar Int
nameCounter
MVar Int -> Int -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Int
nameCounter (Int
nameNoInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> String
listToString (Int
nameNoInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
nameSourceId))
listToString :: [Int] -> String
listToString :: [Int] -> String
listToString [Int]
numbers = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ Int
n -> Char
'.'Char -> ShowS
forall a. a -> [a] -> [a]
:(Int -> String
forall a. Show a => a -> String
show Int
n)) [Int]
numbers)
data FrozenNameSource = FrozenNameSource {
FrozenNameSource -> [Int]
frozenId :: [Int],
FrozenNameSource -> Int
frozenBranch :: Int,
FrozenNameSource -> Int
frozenName :: Int
} deriving (ReadPrec [FrozenNameSource]
ReadPrec FrozenNameSource
Int -> ReadS FrozenNameSource
ReadS [FrozenNameSource]
(Int -> ReadS FrozenNameSource)
-> ReadS [FrozenNameSource]
-> ReadPrec FrozenNameSource
-> ReadPrec [FrozenNameSource]
-> Read FrozenNameSource
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FrozenNameSource]
$creadListPrec :: ReadPrec [FrozenNameSource]
readPrec :: ReadPrec FrozenNameSource
$creadPrec :: ReadPrec FrozenNameSource
readList :: ReadS [FrozenNameSource]
$creadList :: ReadS [FrozenNameSource]
readsPrec :: Int -> ReadS FrozenNameSource
$creadsPrec :: Int -> ReadS FrozenNameSource
Read,Int -> FrozenNameSource -> ShowS
[FrozenNameSource] -> ShowS
FrozenNameSource -> String
(Int -> FrozenNameSource -> ShowS)
-> (FrozenNameSource -> String)
-> ([FrozenNameSource] -> ShowS)
-> Show FrozenNameSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FrozenNameSource] -> ShowS
$cshowList :: [FrozenNameSource] -> ShowS
show :: FrozenNameSource -> String
$cshow :: FrozenNameSource -> String
showsPrec :: Int -> FrozenNameSource -> ShowS
$cshowsPrec :: Int -> FrozenNameSource -> ShowS
Show)
freezeNameSource :: NameSource -> IO FrozenNameSource
freezeNameSource :: NameSource -> IO FrozenNameSource
freezeNameSource (NameSource {
nameSourceId :: NameSource -> [Int]
nameSourceId = [Int]
nameSourceId,
branchCounter :: NameSource -> MVar Int
branchCounter = MVar Int
branchCounter,
nameCounter :: NameSource -> MVar Int
nameCounter = MVar Int
nameCounter
}) =
do
Int
frozenBranch <- MVar Int -> IO Int
forall a. MVar a -> IO a
takeMVar MVar Int
branchCounter
Int
frozenName <- MVar Int -> IO Int
forall a. MVar a -> IO a
takeMVar MVar Int
nameCounter
MVar Int -> Int -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Int
nameCounter Int
frozenName
MVar Int -> Int -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Int
branchCounter Int
frozenBranch
FrozenNameSource -> IO FrozenNameSource
forall (m :: * -> *) a. Monad m => a -> m a
return (FrozenNameSource :: [Int] -> Int -> Int -> FrozenNameSource
FrozenNameSource {
frozenId :: [Int]
frozenId = [Int]
nameSourceId,
frozenBranch :: Int
frozenBranch = Int
frozenBranch,
frozenName :: Int
frozenName = Int
frozenName
})
defrostNameSource :: NameSource -> FrozenNameSource -> IO ()
defrostNameSource :: NameSource -> FrozenNameSource -> IO ()
defrostNameSource
(NameSource {
nameSourceId :: NameSource -> [Int]
nameSourceId = [Int]
nameSourceId,
branchCounter :: NameSource -> MVar Int
branchCounter = MVar Int
branchCounter,
nameCounter :: NameSource -> MVar Int
nameCounter = MVar Int
nameCounter
})
(FrozenNameSource {
frozenId :: FrozenNameSource -> [Int]
frozenId = [Int]
frozenId,
frozenBranch :: FrozenNameSource -> Int
frozenBranch = Int
frozenBranch,
frozenName :: FrozenNameSource -> Int
frozenName = Int
frozenName
}) =
do
let
fail :: String -> IO a
fail String
mess =
IOError -> IO a
forall a. IOError -> IO a
ioError(String -> IOError
userError(String
"NewNames.defrostNameSource: "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
mess))
if ([Int]
nameSourceId [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int]
frozenId)
then
String -> IO ()
forall a. String -> IO a
fail String
"Name source mismatch"
else
IO ()
forall (m :: * -> *). Monad m => m ()
done
Int
oldBranch <- MVar Int -> IO Int
forall a. MVar a -> IO a
takeMVar MVar Int
branchCounter
MVar Int -> Int -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Int
branchCounter Int
frozenBranch
Int
oldName <- MVar Int -> IO Int
forall a. MVar a -> IO a
takeMVar MVar Int
nameCounter
MVar Int -> Int -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Int
nameCounter Int
frozenName