module Biobase.Types.Names.Internal where

import Data.IORef (newIORef,IORef,readIORef,atomicWriteIORef,atomicModifyIORef')
import Data.Text (Text)
import System.IO.Unsafe (unsafePerformIO,unsafeDupablePerformIO)

import Data.Bijection.HashMap
import Data.Bijection.Vector



speciesNameBimap :: IORef (Bimap (HashMap Text Int) (Vector Text))
speciesNameBimap :: IORef (Bimap (HashMap Text Int) (Vector Text))
speciesNameBimap = IO (IORef (Bimap (HashMap Text Int) (Vector Text)))
-> IORef (Bimap (HashMap Text Int) (Vector Text))
forall a. IO a -> a
unsafePerformIO (IO (IORef (Bimap (HashMap Text Int) (Vector Text)))
 -> IORef (Bimap (HashMap Text Int) (Vector Text)))
-> IO (IORef (Bimap (HashMap Text Int) (Vector Text)))
-> IORef (Bimap (HashMap Text Int) (Vector Text))
forall a b. (a -> b) -> a -> b
$ Bimap (HashMap Text Int) (Vector Text)
-> IO (IORef (Bimap (HashMap Text Int) (Vector Text)))
forall a. a -> IO (IORef a)
newIORef Bimap (HashMap Text Int) (Vector Text)
forall l r. DomCodCnt l r => Bimap l r
empty
{-# NoInline speciesNameBimap #-}

-- | Add @Text@ and return @Int@ key. Will return key for
-- existing string and thereby serves for lookup in left-to-right
-- direction.

speciesNameBimapAdd :: Text -> Int
speciesNameBimapAdd :: Text -> Int
speciesNameBimapAdd Text
k = IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ IORef (Bimap (HashMap Text Int) (Vector Text))
-> (Bimap (HashMap Text Int) (Vector Text)
    -> (Bimap (HashMap Text Int) (Vector Text), Int))
-> IO Int
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Bimap (HashMap Text Int) (Vector Text))
speciesNameBimap ((Bimap (HashMap Text Int) (Vector Text)
  -> (Bimap (HashMap Text Int) (Vector Text), Int))
 -> IO Int)
-> (Bimap (HashMap Text Int) (Vector Text)
    -> (Bimap (HashMap Text Int) (Vector Text), Int))
-> IO Int
forall a b. (a -> b) -> a -> b
$ \Bimap (HashMap Text Int) (Vector Text)
m ->
  case Bimap (HashMap Text Int) (Vector Text)
-> Dom (HashMap Text Int) -> Maybe (Cod (HashMap Text Int))
forall l r. DomCod l => Bimap l r -> Dom l -> Maybe (Cod l)
lookupL Bimap (HashMap Text Int) (Vector Text)
m Text
Dom (HashMap Text Int)
k of Just Cod (HashMap Text Int)
i  -> (Bimap (HashMap Text Int) (Vector Text)
m,Int
Cod (HashMap Text Int)
i)
                      Maybe (Cod (HashMap Text Int))
Nothing -> let s :: Int
s = Bimap (HashMap Text Int) (Vector Text) -> Int
forall l r. DomCod l => Bimap l r -> Int
size Bimap (HashMap Text Int) (Vector Text)
m
                                 in  (Bimap (HashMap Text Int) (Vector Text)
-> (Dom (HashMap Text Int), Cod (HashMap Text Int))
-> Bimap (HashMap Text Int) (Vector Text)
forall l r.
DomCodCnt l r =>
Bimap l r -> (Dom l, Cod l) -> Bimap l r
insert Bimap (HashMap Text Int) (Vector Text)
m (Text
Dom (HashMap Text Int)
k,Int
Cod (HashMap Text Int)
s) , Int
s)
{-# Inline speciesNameBimapAdd #-}

-- | Lookup the @InternedMultiChar@ based on an @Int@ key. Unsafe totality
-- assumption.

speciesNameBimapLookupInt :: Int -> Text
speciesNameBimapLookupInt :: Int -> Text
speciesNameBimapLookupInt Int
r = Int -> Text -> Text
seq Int
r (Text -> Text) -> (IO Text -> Text) -> IO Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Text -> Text
forall a. IO a -> a
unsafeDupablePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$ IORef (Bimap (HashMap Text Int) (Vector Text))
-> (Bimap (HashMap Text Int) (Vector Text)
    -> (Bimap (HashMap Text Int) (Vector Text), Text))
-> IO Text
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Bimap (HashMap Text Int) (Vector Text))
speciesNameBimap ((Bimap (HashMap Text Int) (Vector Text)
  -> (Bimap (HashMap Text Int) (Vector Text), Text))
 -> IO Text)
-> (Bimap (HashMap Text Int) (Vector Text)
    -> (Bimap (HashMap Text Int) (Vector Text), Text))
-> IO Text
forall a b. (a -> b) -> a -> b
$ \Bimap (HashMap Text Int) (Vector Text)
m ->
  case Bimap (HashMap Text Int) (Vector Text)
-> Dom (Vector Text) -> Maybe (Cod (Vector Text))
forall r l. DomCod r => Bimap l r -> Dom r -> Maybe (Cod r)
lookupR Bimap (HashMap Text Int) (Vector Text)
m Int
Dom (Vector Text)
r of Just Cod (Vector Text)
l  -> (Bimap (HashMap Text Int) (Vector Text)
m,Text
Cod (Vector Text)
l)
                      Maybe (Cod (Vector Text))
Nothing -> [Char] -> (Bimap (HashMap Text Int) (Vector Text), Text)
forall a. HasCallStack => [Char] -> a
error [Char]
"speciesNameBimapLookupInt: totality assumption invalidated"
{-# Inline speciesNameBimapLookupInt #-}