module Network.Mom.Stompl.Client.Factory (
Con(..), mkUniqueConId,
Sub(..), mkUniqueSubId,
Tx (..), mkUniqueTxId,
Rec(..), mkUniqueRecc, parseRec)
where
import System.IO.Unsafe
import Control.Concurrent
import Data.Char (isDigit)
newtype Con = Con Int
deriving (Con -> Con -> Bool
(Con -> Con -> Bool) -> (Con -> Con -> Bool) -> Eq Con
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Con -> Con -> Bool
$c/= :: Con -> Con -> Bool
== :: Con -> Con -> Bool
$c== :: Con -> Con -> Bool
Eq)
instance Show Con where
show :: Con -> String
show (Con Int
i) = Int -> String
forall a. Show a => a -> String
show Int
i
data Sub = Sub Int | NoSub
deriving (Sub -> Sub -> Bool
(Sub -> Sub -> Bool) -> (Sub -> Sub -> Bool) -> Eq Sub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sub -> Sub -> Bool
$c/= :: Sub -> Sub -> Bool
== :: Sub -> Sub -> Bool
$c== :: Sub -> Sub -> Bool
Eq)
instance Show Sub where
show :: Sub -> String
show (Sub Int
i) = Int -> String
forall a. Show a => a -> String
show Int
i
show (Sub
NoSub) = String
""
data Tx = Tx Int | NoTx
deriving (Tx -> Tx -> Bool
(Tx -> Tx -> Bool) -> (Tx -> Tx -> Bool) -> Eq Tx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tx -> Tx -> Bool
$c/= :: Tx -> Tx -> Bool
== :: Tx -> Tx -> Bool
$c== :: Tx -> Tx -> Bool
Eq)
instance Show Tx where
show :: Tx -> String
show (Tx Int
i) = Int -> String
forall a. Show a => a -> String
show Int
i
show (Tx
NoTx) = String
""
data Rec =
Rec Int
| NoRec
deriving (Rec -> Rec -> Bool
(Rec -> Rec -> Bool) -> (Rec -> Rec -> Bool) -> Eq Rec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rec -> Rec -> Bool
$c/= :: Rec -> Rec -> Bool
== :: Rec -> Rec -> Bool
$c== :: Rec -> Rec -> Bool
Eq)
instance Show Rec where
show :: Rec -> String
show (Rec Int
i) = Int -> String
forall a. Show a => a -> String
show Int
i
show Rec
NoRec = String
""
parseRec :: String -> Maybe Rec
parseRec :: String -> Maybe Rec
parseRec String
s =
if String -> Bool
numeric String
s then Rec -> Maybe Rec
forall a. a -> Maybe a
Just (Int -> Rec
Rec (Int -> Rec) -> Int -> Rec
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read String
s) else Maybe Rec
forall a. Maybe a
Nothing
numeric :: String -> Bool
numeric :: String -> Bool
numeric = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit
{-# NOINLINE conid #-}
conid :: MVar Con
conid :: MVar Con
conid = IO (MVar Con) -> MVar Con
forall a. IO a -> a
unsafePerformIO (IO (MVar Con) -> MVar Con) -> IO (MVar Con) -> MVar Con
forall a b. (a -> b) -> a -> b
$ Con -> IO (MVar Con)
forall a. a -> IO (MVar a)
newMVar (Int -> Con
Con Int
1)
{-# NOINLINE subid #-}
subid :: MVar Sub
subid :: MVar Sub
subid = IO (MVar Sub) -> MVar Sub
forall a. IO a -> a
unsafePerformIO (IO (MVar Sub) -> MVar Sub) -> IO (MVar Sub) -> MVar Sub
forall a b. (a -> b) -> a -> b
$ Sub -> IO (MVar Sub)
forall a. a -> IO (MVar a)
newMVar (Int -> Sub
Sub Int
1)
{-# NOINLINE txid #-}
txid :: MVar Tx
txid :: MVar Tx
txid = IO (MVar Tx) -> MVar Tx
forall a. IO a -> a
unsafePerformIO (IO (MVar Tx) -> MVar Tx) -> IO (MVar Tx) -> MVar Tx
forall a b. (a -> b) -> a -> b
$ Tx -> IO (MVar Tx)
forall a. a -> IO (MVar a)
newMVar (Int -> Tx
Tx Int
1)
{-# NOINLINE recc #-}
recc :: MVar Rec
recc :: MVar Rec
recc = IO (MVar Rec) -> MVar Rec
forall a. IO a -> a
unsafePerformIO (IO (MVar Rec) -> MVar Rec) -> IO (MVar Rec) -> MVar Rec
forall a b. (a -> b) -> a -> b
$ Rec -> IO (MVar Rec)
forall a. a -> IO (MVar a)
newMVar (Int -> Rec
Rec Int
1)
mkUniqueConId :: IO Con
mkUniqueConId :: IO Con
mkUniqueConId = MVar Con -> (Con -> Con) -> IO Con
forall a. MVar a -> (a -> a) -> IO a
mkUniqueId MVar Con
conid Con -> Con
incCon
mkUniqueSubId :: IO Sub
mkUniqueSubId :: IO Sub
mkUniqueSubId = MVar Sub -> (Sub -> Sub) -> IO Sub
forall a. MVar a -> (a -> a) -> IO a
mkUniqueId MVar Sub
subid Sub -> Sub
incSub
mkUniqueTxId :: IO Tx
mkUniqueTxId :: IO Tx
mkUniqueTxId = MVar Tx -> (Tx -> Tx) -> IO Tx
forall a. MVar a -> (a -> a) -> IO a
mkUniqueId MVar Tx
txid Tx -> Tx
incTx
mkUniqueRecc :: IO Rec
mkUniqueRecc :: IO Rec
mkUniqueRecc = MVar Rec -> (Rec -> Rec) -> IO Rec
forall a. MVar a -> (a -> a) -> IO a
mkUniqueId MVar Rec
recc Rec -> Rec
incRecc
mkUniqueId :: MVar a -> (a -> a) -> IO a
mkUniqueId :: MVar a -> (a -> a) -> IO a
mkUniqueId MVar a
v a -> a
f = MVar a -> (a -> IO (a, a)) -> IO a
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar a
v ((a -> IO (a, a)) -> IO a) -> (a -> IO (a, a)) -> IO a
forall a b. (a -> b) -> a -> b
$ \a
x ->
let x' :: a
x' = a -> a
f a
x in (a, a) -> IO (a, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x', a
x')
incCon :: Con -> Con
incCon :: Con -> Con
incCon (Con Int
n) = Int -> Con
Con (Int -> Int
incX Int
n)
incSub :: Sub -> Sub
incSub :: Sub -> Sub
incSub (Sub Int
n) = Int -> Sub
Sub (Int -> Int
incX Int
n)
incSub Sub
NoSub = Sub
NoSub
incTx :: Tx -> Tx
incTx :: Tx -> Tx
incTx (Tx Int
n) = Int -> Tx
Tx (Int -> Int
incX Int
n)
incTx Tx
NoTx = Tx
NoTx
incRecc :: Rec -> Rec
incRecc :: Rec -> Rec
incRecc (Rec Int
n) = Int -> Rec
Rec (Int -> Int
incX Int
n)
incRecc (Rec
NoRec) = Rec
NoRec
incX :: Int -> Int
incX :: Int -> Int
incX Int
i = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
99999999 then Int
1 else Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1