{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Instana.SDK.Internal.Id
( Id
, generate
, fromString
, toByteString
, toString
, toText
, createFromIntsForTest
)
where
import Control.Monad (replicateM)
import Data.Aeson (FromJSON, ToJSON, Value)
import qualified Data.Aeson as Aeson
import Data.Aeson.Types (Parser)
import qualified Data.ByteString.Char8 as BSC8
import qualified Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics
import Numeric (showHex)
import qualified System.Random as Random
data Id =
IntComponents [Int]
| IdString String
deriving (Id -> Id -> Bool
(Id -> Id -> Bool) -> (Id -> Id -> Bool) -> Eq Id
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c== :: Id -> Id -> Bool
Eq, (forall x. Id -> Rep Id x)
-> (forall x. Rep Id x -> Id) -> Generic Id
forall x. Rep Id x -> Id
forall x. Id -> Rep Id x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Id x -> Id
$cfrom :: forall x. Id -> Rep Id x
Generic, Int -> Id -> ShowS
[Id] -> ShowS
Id -> String
(Int -> Id -> ShowS)
-> (Id -> String) -> ([Id] -> ShowS) -> Show Id
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Id] -> ShowS
$cshowList :: [Id] -> ShowS
show :: Id -> String
$cshow :: Id -> String
showsPrec :: Int -> Id -> ShowS
$cshowsPrec :: Int -> Id -> ShowS
Show)
instance FromJSON Id where
parseJSON :: Value -> Parser Id
parseJSON :: Value -> Parser Id
parseJSON = String -> (Text -> Parser Id) -> Value -> Parser Id
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText "Id string" ((Text -> Parser Id) -> Value -> Parser Id)
-> (Text -> Parser Id) -> Value -> Parser Id
forall a b. (a -> b) -> a -> b
$
\string :: Text
string -> Id -> Parser Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> Parser Id) -> Id -> Parser Id
forall a b. (a -> b) -> a -> b
$ String -> Id
IdString (String -> Id) -> String -> Id
forall a b. (a -> b) -> a -> b
$ (Text -> String
T.unpack Text
string)
instance ToJSON Id where
toJSON :: Id -> Value
toJSON :: Id -> Value
toJSON =
Text -> Value
Aeson.String (Text -> Value) -> (Id -> Text) -> Id -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Text
toText
instance Data.String.IsString Id where
fromString :: String -> Id
fromString = String -> Id
fromString
appendAsHex :: Int -> String -> Int -> String
appendAsHex :: Int -> String -> Int -> String
appendAsHex noOfComponents :: Int
noOfComponents accumulator :: String
accumulator intValue :: Int
intValue =
String -> Int -> String
appendPaddedHex String
accumulator Int
intValue
where
toHex :: Int -> String
toHex = ((Int -> ShowS) -> String -> Int -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex) "" (Int -> String) -> (Int -> Int) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
abs
padding :: Int
padding = 64 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
noOfComponents Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 4
toPaddedHex :: Int -> String
toPaddedHex = Int -> ShowS
leftPad Int
padding ShowS -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
toHex
appendPaddedHex :: String -> Int -> String
appendPaddedHex = (Int -> ShowS) -> String -> Int -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (String -> ShowS) -> (Int -> String) -> Int -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
toPaddedHex)
leftPad :: Int -> String -> String
leftPad :: Int -> ShowS
leftPad digits :: Int
digits s :: String
s
| String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
digits = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
digits Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) '0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
| Bool
otherwise = String
s
generate :: IO Id
generate :: IO Id
generate = do
let
requiredNumberOfIntComponents :: Int
requiredNumberOfIntComponents = 64 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
bitsPerInt
([Int]
randomInts :: [Int]) <-
Int -> IO Int -> IO [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
requiredNumberOfIntComponents IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => m a
Random.randomIO
Id -> IO Id
forall (m :: * -> *) a. Monad m => a -> m a
return (Id -> IO Id) -> Id -> IO Id
forall a b. (a -> b) -> a -> b
$ [Int] -> Id
IntComponents ([Int] -> Id) -> [Int] -> Id
forall a b. (a -> b) -> a -> b
$ [Int]
randomInts
bitsPerInt :: Int
bitsPerInt :: Int
bitsPerInt =
Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase (2 :: Double) (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)
toString :: Id -> String
toString :: Id -> String
toString theId :: Id
theId =
case Id
theId of
IntComponents intComponents :: [Int]
intComponents ->
let
noOfComponents :: Int
noOfComponents = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
intComponents
in
(String -> Int -> String) -> String -> [Int] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
(Int -> String -> Int -> String
appendAsHex Int
noOfComponents)
""
([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
intComponents)
IdString string :: String
string ->
String
string
fromString :: String -> Id
fromString :: String -> Id
fromString = String -> Id
IdString
toText :: Id -> Text
toText :: Id -> Text
toText =
String -> Text
T.pack (String -> Text) -> (Id -> String) -> Id -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> String
toString
toByteString :: Id -> BSC8.ByteString
toByteString :: Id -> ByteString
toByteString =
String -> ByteString
BSC8.pack (String -> ByteString) -> (Id -> String) -> Id -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> String
toString
createFromIntsForTest :: [Int] -> Id
createFromIntsForTest :: [Int] -> Id
createFromIntsForTest = [Int] -> Id
IntComponents