-- | Names for biological things.
--
-- Species names are internalized and represented as an @Int@. This allows
-- using them in structures like an @IntMap@.
--
-- For other names, we newtype-wrap normal text internalization.
--

module Biobase.Types.Names where

import Control.Applicative
import Control.DeepSeq (NFData(..))
import Data.Aeson as A
import Data.Binary      as DB
import Data.Hashable
import Data.Interned
import Data.Interned.Text
import Data.Serialize   as DS
import Data.Serialize.Text
import Data.String as IS
import Data.String.Conversions (ConvertibleStrings(..), cs)
import Data.String.Conversions.Monomorphic (toST, fromST)
import Data.Text.Binary
import Data.Text (Text, pack, unpack)
import Data.Vector.Unboxed.Deriving
import GHC.Generics

import Biobase.Types.Names.Internal



-- * Int-internalized species names.

-- | A species name. Represented with an @Int@, but behaves like a @Text@.

newtype SpeciesName = SpeciesName { SpeciesName -> Int
getSpeciesNameRep :: Int }
  deriving (SpeciesName -> SpeciesName -> Bool
(SpeciesName -> SpeciesName -> Bool)
-> (SpeciesName -> SpeciesName -> Bool) -> Eq SpeciesName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpeciesName -> SpeciesName -> Bool
$c/= :: SpeciesName -> SpeciesName -> Bool
== :: SpeciesName -> SpeciesName -> Bool
$c== :: SpeciesName -> SpeciesName -> Bool
Eq,(forall x. SpeciesName -> Rep SpeciesName x)
-> (forall x. Rep SpeciesName x -> SpeciesName)
-> Generic SpeciesName
forall x. Rep SpeciesName x -> SpeciesName
forall x. SpeciesName -> Rep SpeciesName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpeciesName x -> SpeciesName
$cfrom :: forall x. SpeciesName -> Rep SpeciesName x
Generic)

derivingUnbox "SpeciesName"
  [t| SpeciesName -> Int |]
  [|  getSpeciesNameRep  |]
  [|  SpeciesName        |]

instance Ord SpeciesName where
  SpeciesName Int
l compare :: SpeciesName -> SpeciesName -> Ordering
`compare` SpeciesName Int
r = Int -> Text
speciesNameBimapLookupInt Int
l Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int -> Text
speciesNameBimapLookupInt Int
r
  {-# Inline compare #-}

-- | Smart constructor that performs the correct internalization.

speciesName :: Text -> SpeciesName
speciesName :: Text -> SpeciesName
speciesName = Int -> SpeciesName
SpeciesName (Int -> SpeciesName) -> (Text -> Int) -> Text -> SpeciesName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
speciesNameBimapAdd
{-# Inline speciesName #-}

instance IsString SpeciesName where
  fromString :: String -> SpeciesName
fromString = Text -> SpeciesName
speciesName (Text -> SpeciesName) -> (String -> Text) -> String -> SpeciesName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
IS.fromString
  {-# Inline fromString #-}

instance Show SpeciesName where
  showsPrec :: Int -> SpeciesName -> ShowS
showsPrec Int
p SpeciesName
i String
r = Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ SpeciesName -> Text
forall a. ConvertibleStrings a Text => a -> Text
toST SpeciesName
i) String
r
  {-# Inline showsPrec #-}

instance Read SpeciesName where
  readsPrec :: Int -> ReadS SpeciesName
readsPrec Int
p String
str = [ (Text -> SpeciesName
speciesName (Text -> SpeciesName) -> Text -> SpeciesName
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
IS.fromString String
s, String
y) | (String
s,String
y) <- Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
str ]
  {-# Inline readsPrec #-}

instance Hashable SpeciesName

instance ConvertibleStrings Text SpeciesName where
  convertString :: Text -> SpeciesName
convertString = Text -> SpeciesName
speciesName

instance ConvertibleStrings SpeciesName Text where
  convertString :: SpeciesName -> Text
convertString = Int -> Text
speciesNameBimapLookupInt (Int -> Text) -> (SpeciesName -> Int) -> SpeciesName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpeciesName -> Int
getSpeciesNameRep

instance NFData SpeciesName

instance Binary SpeciesName where
  put :: SpeciesName -> Put
put = Text -> Put
forall t. Binary t => t -> Put
DB.put (Text -> Put) -> (SpeciesName -> Text) -> SpeciesName -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpeciesName -> Text
forall a. ConvertibleStrings a Text => a -> Text
toST
  get :: Get SpeciesName
get = Text -> SpeciesName
forall a. ConvertibleStrings Text a => Text -> a
fromST (Text -> SpeciesName) -> Get Text -> Get SpeciesName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
forall t. Binary t => Get t
DB.get
  {-# Inline put #-}
  {-# Inline get #-}

instance Serialize SpeciesName where
  put :: Putter SpeciesName
put = Putter Text
forall t. Serialize t => Putter t
DS.put Putter Text -> (SpeciesName -> Text) -> Putter SpeciesName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpeciesName -> Text
forall a. ConvertibleStrings a Text => a -> Text
toST
  get :: Get SpeciesName
get = Text -> SpeciesName
forall a. ConvertibleStrings Text a => Text -> a
fromST (Text -> SpeciesName) -> Get Text -> Get SpeciesName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
forall t. Serialize t => Get t
DS.get
  {-# Inline put #-}
  {-# Inline get #-}

instance FromJSON SpeciesName where
  parseJSON :: Value -> Parser SpeciesName
parseJSON Value
s = Text -> SpeciesName
forall a. ConvertibleStrings Text a => Text -> a
fromST (Text -> SpeciesName) -> Parser Text -> Parser SpeciesName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
s
  {-# Inline parseJSON #-}

instance ToJSON SpeciesName where
  toJSON :: SpeciesName -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (SpeciesName -> Text) -> SpeciesName -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpeciesName -> Text
forall a. ConvertibleStrings a Text => a -> Text
toST
  {-# Inline toJSON #-}



-- * Internalize taxonomic rank names

-- | The taxonomic rank. This encodes the name for a given rank.

newtype TaxonomicRank = TaxonomicRank { TaxonomicRank -> InternedText
getTaxonomicRank :: InternedText }
  deriving (String -> TaxonomicRank
(String -> TaxonomicRank) -> IsString TaxonomicRank
forall a. (String -> a) -> IsString a
fromString :: String -> TaxonomicRank
$cfromString :: String -> TaxonomicRank
IsString,TaxonomicRank -> TaxonomicRank -> Bool
(TaxonomicRank -> TaxonomicRank -> Bool)
-> (TaxonomicRank -> TaxonomicRank -> Bool) -> Eq TaxonomicRank
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TaxonomicRank -> TaxonomicRank -> Bool
$c/= :: TaxonomicRank -> TaxonomicRank -> Bool
== :: TaxonomicRank -> TaxonomicRank -> Bool
$c== :: TaxonomicRank -> TaxonomicRank -> Bool
Eq,Eq TaxonomicRank
Eq TaxonomicRank
-> (TaxonomicRank -> TaxonomicRank -> Ordering)
-> (TaxonomicRank -> TaxonomicRank -> Bool)
-> (TaxonomicRank -> TaxonomicRank -> Bool)
-> (TaxonomicRank -> TaxonomicRank -> Bool)
-> (TaxonomicRank -> TaxonomicRank -> Bool)
-> (TaxonomicRank -> TaxonomicRank -> TaxonomicRank)
-> (TaxonomicRank -> TaxonomicRank -> TaxonomicRank)
-> Ord TaxonomicRank
TaxonomicRank -> TaxonomicRank -> Bool
TaxonomicRank -> TaxonomicRank -> Ordering
TaxonomicRank -> TaxonomicRank -> TaxonomicRank
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
min :: TaxonomicRank -> TaxonomicRank -> TaxonomicRank
$cmin :: TaxonomicRank -> TaxonomicRank -> TaxonomicRank
max :: TaxonomicRank -> TaxonomicRank -> TaxonomicRank
$cmax :: TaxonomicRank -> TaxonomicRank -> TaxonomicRank
>= :: TaxonomicRank -> TaxonomicRank -> Bool
$c>= :: TaxonomicRank -> TaxonomicRank -> Bool
> :: TaxonomicRank -> TaxonomicRank -> Bool
$c> :: TaxonomicRank -> TaxonomicRank -> Bool
<= :: TaxonomicRank -> TaxonomicRank -> Bool
$c<= :: TaxonomicRank -> TaxonomicRank -> Bool
< :: TaxonomicRank -> TaxonomicRank -> Bool
$c< :: TaxonomicRank -> TaxonomicRank -> Bool
compare :: TaxonomicRank -> TaxonomicRank -> Ordering
$ccompare :: TaxonomicRank -> TaxonomicRank -> Ordering
$cp1Ord :: Eq TaxonomicRank
Ord,Int -> TaxonomicRank -> ShowS
[TaxonomicRank] -> ShowS
TaxonomicRank -> String
(Int -> TaxonomicRank -> ShowS)
-> (TaxonomicRank -> String)
-> ([TaxonomicRank] -> ShowS)
-> Show TaxonomicRank
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TaxonomicRank] -> ShowS
$cshowList :: [TaxonomicRank] -> ShowS
show :: TaxonomicRank -> String
$cshow :: TaxonomicRank -> String
showsPrec :: Int -> TaxonomicRank -> ShowS
$cshowsPrec :: Int -> TaxonomicRank -> ShowS
Show,(forall x. TaxonomicRank -> Rep TaxonomicRank x)
-> (forall x. Rep TaxonomicRank x -> TaxonomicRank)
-> Generic TaxonomicRank
forall x. Rep TaxonomicRank x -> TaxonomicRank
forall x. TaxonomicRank -> Rep TaxonomicRank x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TaxonomicRank x -> TaxonomicRank
$cfrom :: forall x. TaxonomicRank -> Rep TaxonomicRank x
Generic)

instance NFData TaxonomicRank where
  rnf :: TaxonomicRank -> ()
rnf (TaxonomicRank InternedText
it) = Int -> ()
forall a. NFData a => a -> ()
rnf (InternedText -> Int
internedTextId InternedText
it)
  {-# Inline rnf #-}

instance ConvertibleStrings Text TaxonomicRank where
  convertString :: Text -> TaxonomicRank
convertString = InternedText -> TaxonomicRank
TaxonomicRank (InternedText -> TaxonomicRank)
-> (Text -> InternedText) -> Text -> TaxonomicRank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> InternedText
forall t. Interned t => Uninterned t -> t
intern

instance ConvertibleStrings TaxonomicRank Text where
  convertString :: TaxonomicRank -> Text
convertString = InternedText -> Text
forall t. Uninternable t => t -> Uninterned t
unintern (InternedText -> Text)
-> (TaxonomicRank -> InternedText) -> TaxonomicRank -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TaxonomicRank -> InternedText
getTaxonomicRank

instance Hashable TaxonomicRank where
  hashWithSalt :: Int -> TaxonomicRank -> Int
hashWithSalt Int
s (TaxonomicRank InternedText
it) = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (InternedText -> Int
internedTextId InternedText
it)
  {-# Inline hashWithSalt #-}

instance Read TaxonomicRank where
  readsPrec :: Int -> ReadS TaxonomicRank
readsPrec Int
p String
str = [ (String -> TaxonomicRank
forall a. IsString a => String -> a
IS.fromString String
s, String
y) | (String
s,String
y) <- Int -> ReadS String
forall a. Read a => Int -> ReadS a
readsPrec Int
p String
str ]
  {-# Inline readsPrec #-}

instance Binary TaxonomicRank where
  put :: TaxonomicRank -> Put
put = Text -> Put
forall t. Binary t => t -> Put
DB.put (Text -> Put) -> (TaxonomicRank -> Text) -> TaxonomicRank -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TaxonomicRank -> Text
forall a. ConvertibleStrings a Text => a -> Text
toST
  get :: Get TaxonomicRank
get = Text -> TaxonomicRank
forall a. ConvertibleStrings Text a => Text -> a
fromST (Text -> TaxonomicRank) -> Get Text -> Get TaxonomicRank
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
forall t. Binary t => Get t
DB.get
  {-# Inline put #-}
  {-# Inline get #-}

instance Serialize TaxonomicRank where
  put :: Putter TaxonomicRank
put = Putter Text
forall t. Serialize t => Putter t
DS.put Putter Text -> (TaxonomicRank -> Text) -> Putter TaxonomicRank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TaxonomicRank -> Text
forall a. ConvertibleStrings a Text => a -> Text
toST
  get :: Get TaxonomicRank
get = Text -> TaxonomicRank
forall a. ConvertibleStrings Text a => Text -> a
fromST (Text -> TaxonomicRank) -> Get Text -> Get TaxonomicRank
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
forall t. Serialize t => Get t
DS.get
  {-# Inline put #-}
  {-# Inline get #-}

instance FromJSON TaxonomicRank where
  parseJSON :: Value -> Parser TaxonomicRank
parseJSON Value
s = Text -> TaxonomicRank
forall a. ConvertibleStrings Text a => Text -> a
fromST (Text -> TaxonomicRank) -> Parser Text -> Parser TaxonomicRank
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
s
  {-# Inline parseJSON #-}

instance ToJSON TaxonomicRank where
  toJSON :: TaxonomicRank -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (TaxonomicRank -> Text) -> TaxonomicRank -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TaxonomicRank -> Text
forall a. ConvertibleStrings a Text => a -> Text
toST
  {-# Inline toJSON #-}