module M.Reg (Reg, mkreg0, mkreg1, lkcodebyid, lkobjbycode, lkobjbyid) where
import Data.Bifunctor
import Data.Data
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as H
import Data.IntMap.Lazy (IntMap)
import Data.IntMap.Lazy qualified as I
import Data.List (intercalate)
import Data.Text (Text)
import GHC.Generics
import Text.Printf
data Reg a = Reg
{
forall a. Reg a -> IntMap a
regca :: IntMap a,
forall a. Reg a -> HashMap Text Int
regic :: HashMap Text Int
}
deriving (Reg a -> Reg a -> Bool
(Reg a -> Reg a -> Bool) -> (Reg a -> Reg a -> Bool) -> Eq (Reg a)
forall a. Eq a => Reg a -> Reg a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Reg a -> Reg a -> Bool
== :: Reg a -> Reg a -> Bool
$c/= :: forall a. Eq a => Reg a -> Reg a -> Bool
/= :: Reg a -> Reg a -> Bool
Eq, Eq (Reg a)
Eq (Reg a) =>
(Reg a -> Reg a -> Ordering)
-> (Reg a -> Reg a -> Bool)
-> (Reg a -> Reg a -> Bool)
-> (Reg a -> Reg a -> Bool)
-> (Reg a -> Reg a -> Bool)
-> (Reg a -> Reg a -> Reg a)
-> (Reg a -> Reg a -> Reg a)
-> Ord (Reg a)
Reg a -> Reg a -> Bool
Reg a -> Reg a -> Ordering
Reg a -> Reg a -> Reg a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Reg a)
forall a. Ord a => Reg a -> Reg a -> Bool
forall a. Ord a => Reg a -> Reg a -> Ordering
forall a. Ord a => Reg a -> Reg a -> Reg a
$ccompare :: forall a. Ord a => Reg a -> Reg a -> Ordering
compare :: Reg a -> Reg a -> Ordering
$c< :: forall a. Ord a => Reg a -> Reg a -> Bool
< :: Reg a -> Reg a -> Bool
$c<= :: forall a. Ord a => Reg a -> Reg a -> Bool
<= :: Reg a -> Reg a -> Bool
$c> :: forall a. Ord a => Reg a -> Reg a -> Bool
> :: Reg a -> Reg a -> Bool
$c>= :: forall a. Ord a => Reg a -> Reg a -> Bool
>= :: Reg a -> Reg a -> Bool
$cmax :: forall a. Ord a => Reg a -> Reg a -> Reg a
max :: Reg a -> Reg a -> Reg a
$cmin :: forall a. Ord a => Reg a -> Reg a -> Reg a
min :: Reg a -> Reg a -> Reg a
Ord, (forall x. Reg a -> Rep (Reg a) x)
-> (forall x. Rep (Reg a) x -> Reg a) -> Generic (Reg a)
forall x. Rep (Reg a) x -> Reg a
forall x. Reg a -> Rep (Reg a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Reg a) x -> Reg a
forall a x. Reg a -> Rep (Reg a) x
$cfrom :: forall a x. Reg a -> Rep (Reg a) x
from :: forall x. Reg a -> Rep (Reg a) x
$cto :: forall a x. Rep (Reg a) x -> Reg a
to :: forall x. Rep (Reg a) x -> Reg a
Generic, Typeable, Typeable (Reg a)
Typeable (Reg a) =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Reg a -> c (Reg a))
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Reg a))
-> (Reg a -> Constr)
-> (Reg a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Reg a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Reg a)))
-> ((forall b. Data b => b -> b) -> Reg a -> Reg a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Reg a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Reg a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Reg a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Reg a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Reg a -> m (Reg a))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Reg a -> m (Reg a))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Reg a -> m (Reg a))
-> Data (Reg a)
Reg a -> Constr
Reg a -> DataType
(forall b. Data b => b -> b) -> Reg a -> Reg a
forall a. Data a => Typeable (Reg a)
forall a. Data a => Reg a -> Constr
forall a. Data a => Reg a -> DataType
forall a. Data a => (forall b. Data b => b -> b) -> Reg a -> Reg a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Reg a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Reg a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Reg a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Reg a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Reg a -> m (Reg a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Reg a -> m (Reg a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Reg a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Reg a -> c (Reg a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Reg a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Reg a))
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Reg a -> u
forall u. (forall d. Data d => d -> u) -> Reg a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Reg a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Reg a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Reg a -> m (Reg a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Reg a -> m (Reg a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Reg a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Reg a -> c (Reg a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Reg a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Reg a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Reg a -> c (Reg a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Reg a -> c (Reg a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Reg a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Reg a)
$ctoConstr :: forall a. Data a => Reg a -> Constr
toConstr :: Reg a -> Constr
$cdataTypeOf :: forall a. Data a => Reg a -> DataType
dataTypeOf :: Reg a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Reg a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Reg a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Reg a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Reg a))
$cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> Reg a -> Reg a
gmapT :: (forall b. Data b => b -> b) -> Reg a -> Reg a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Reg a -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Reg a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Reg a -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Reg a -> r
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Reg a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Reg a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Reg a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Reg a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Reg a -> m (Reg a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Reg a -> m (Reg a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Reg a -> m (Reg a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Reg a -> m (Reg a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Reg a -> m (Reg a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Reg a -> m (Reg a)
Data, (forall a b. (a -> b) -> Reg a -> Reg b)
-> (forall a b. a -> Reg b -> Reg a) -> Functor Reg
forall a b. a -> Reg b -> Reg a
forall a b. (a -> b) -> Reg a -> Reg b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Reg a -> Reg b
fmap :: forall a b. (a -> b) -> Reg a -> Reg b
$c<$ :: forall a b. a -> Reg b -> Reg a
<$ :: forall a b. a -> Reg b -> Reg a
Functor)
instance (Show a) => Show (Reg a) where
show :: Reg a -> String
show Reg {IntMap a
HashMap Text Int
regca :: forall a. Reg a -> IntMap a
regic :: forall a. Reg a -> HashMap Text Int
regca :: IntMap a
regic :: HashMap Text Int
..} =
String
"["
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((((Int, a), (Text, Int)) -> String)
-> [((Int, a), (Text, Int))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, a), (Text, Int)) -> String
forall {t} {t} {t} {a} {b}.
(PrintfArg t, PrintfArg t, PrintfType t, Show a) =>
((t, a), (t, b)) -> t
s ([(Int, a)] -> [(Text, Int)] -> [((Int, a), (Text, Int))]
forall a b. [a] -> [b] -> [(a, b)]
zip (IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
I.toList IntMap a
regca) (HashMap Text Int -> [(Text, Int)]
forall k v. HashMap k v -> [(k, v)]
H.toList HashMap Text Int
regic)))
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
where
s :: ((t, a), (t, b)) -> t
s ((t
c, a
a), (t
i, b
_)) = String -> t -> t -> String -> t
forall r. PrintfType r => String -> r
printf String
"(%d, %s; %s)" t
c t
i (a -> String
forall a. Show a => a -> String
show a
a)
mkreg0 :: [(Text, a)] -> Maybe (Reg a)
mkreg0 :: forall a. [(Text, a)] -> Maybe (Reg a)
mkreg0 = (a -> a) -> [(Text, a)] -> Maybe (Reg a)
forall b a. (b -> a) -> [(Text, b)] -> Maybe (Reg a)
mkreg1 a -> a
forall a. a -> a
id
{-# INLINE mkreg0 #-}
mkreg1 :: (b -> a) -> [(Text, b)] -> Maybe (Reg a)
mkreg1 :: forall b a. (b -> a) -> [(Text, b)] -> Maybe (Reg a)
mkreg1 b -> a
f =
Reg a -> Maybe (Reg a)
forall {a}. Reg a -> Maybe (Reg a)
check
(Reg a -> Maybe (Reg a))
-> ([(Text, b)] -> Reg a) -> [(Text, b)] -> Maybe (Reg a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap a -> HashMap Text Int -> Reg a)
-> (IntMap a, HashMap Text Int) -> Reg a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry IntMap a -> HashMap Text Int -> Reg a
forall a. IntMap a -> HashMap Text Int -> Reg a
Reg
((IntMap a, HashMap Text Int) -> Reg a)
-> ([(Text, b)] -> (IntMap a, HashMap Text Int))
-> [(Text, b)]
-> Reg a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, a)] -> IntMap a)
-> ([(Text, Int)] -> HashMap Text Int)
-> ([(Int, a)], [(Text, Int)])
-> (IntMap a, HashMap Text Int)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
I.fromAscList [(Text, Int)] -> HashMap Text Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList
(([(Int, a)], [(Text, Int)]) -> (IntMap a, HashMap Text Int))
-> ([(Text, b)] -> ([(Int, a)], [(Text, Int)]))
-> [(Text, b)]
-> (IntMap a, HashMap Text Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, (Text, b))] -> ([(Int, a)], [(Text, Int)])
unzip'
([(Int, (Text, b))] -> ([(Int, a)], [(Text, Int)]))
-> ([(Text, b)] -> [(Int, (Text, b))])
-> [(Text, b)]
-> ([(Int, a)], [(Text, Int)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [(Text, b)] -> [(Int, (Text, b))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
Item [Int]
0 ..]
where
unzip' :: [(Int, (Text, b))] -> ([(Int, a)], [(Text, Int)])
unzip' =
((Int, (Text, b))
-> ([(Int, a)], [(Text, Int)]) -> ([(Int, a)], [(Text, Int)]))
-> ([(Int, a)], [(Text, Int)])
-> [(Int, (Text, b))]
-> ([(Int, a)], [(Text, Int)])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\(Int
c, (Text
i, b
a)) ~([(Int, a)]
p0, [(Text, Int)]
p1) -> ((Int
c, b -> a
f b
a) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: [(Int, a)]
p0, (Text
i, Int
c) (Text, Int) -> [(Text, Int)] -> [(Text, Int)]
forall a. a -> [a] -> [a]
: [(Text, Int)]
p1))
([], [])
check :: Reg a -> Maybe (Reg a)
check r :: Reg a
r@Reg {IntMap a
HashMap Text Int
regca :: forall a. Reg a -> IntMap a
regic :: forall a. Reg a -> HashMap Text Int
regca :: IntMap a
regic :: HashMap Text Int
..}
| IntMap a -> Int
forall a. IntMap a -> Int
I.size IntMap a
regca Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== HashMap Text Int -> Int
forall k v. HashMap k v -> Int
H.size HashMap Text Int
regic = Reg a -> Maybe (Reg a)
forall a. a -> Maybe a
Just Reg a
r
| Bool
otherwise = Maybe (Reg a)
forall a. Maybe a
Nothing
lkobjbycode :: Int -> Reg a -> Maybe a
lkobjbycode :: forall a. Int -> Reg a -> Maybe a
lkobjbycode Int
c Reg {IntMap a
regca :: forall a. Reg a -> IntMap a
regca :: IntMap a
regca} = Int -> IntMap a -> Maybe a
forall a. Int -> IntMap a -> Maybe a
I.lookup Int
c IntMap a
regca
{-# INLINE lkobjbycode #-}
lkcodebyid :: Text -> Reg a -> Maybe Int
lkcodebyid :: forall a. Text -> Reg a -> Maybe Int
lkcodebyid Text
i Reg {HashMap Text Int
regic :: forall a. Reg a -> HashMap Text Int
regic :: HashMap Text Int
regic} = Text -> HashMap Text Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
i HashMap Text Int
regic
{-# INLINE lkcodebyid #-}
lkobjbyid :: Text -> Reg a -> Maybe a
lkobjbyid :: forall a. Text -> Reg a -> Maybe a
lkobjbyid Text
i Reg a
r = Text -> Reg a -> Maybe Int
forall a. Text -> Reg a -> Maybe Int
lkcodebyid Text
i Reg a
r Maybe Int -> (Int -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Reg a -> Maybe a
forall a. Int -> Reg a -> Maybe a
`lkobjbycode` Reg a
r)
{-# INLINE lkobjbyid #-}