{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Codec.Candid.FieldName
( FieldName
, labledField
, hashedField
, fieldHash
, candidHash
, invertHash
, unescapeFieldName
, escapeFieldName
) where
import qualified Data.Text as T
import Prettyprinter
import Data.String
import Data.Word
import Numeric.Natural
import Data.Function
import Text.Read (readMaybe)
import Codec.Candid.Hash
data FieldName = FieldName
{ FieldName -> Word32
fieldHash :: Word32
, FieldName -> Maybe Text
fieldName :: Maybe T.Text
}
deriving Int -> FieldName -> ShowS
[FieldName] -> ShowS
FieldName -> String
(Int -> FieldName -> ShowS)
-> (FieldName -> String)
-> ([FieldName] -> ShowS)
-> Show FieldName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldName] -> ShowS
$cshowList :: [FieldName] -> ShowS
show :: FieldName -> String
$cshow :: FieldName -> String
showsPrec :: Int -> FieldName -> ShowS
$cshowsPrec :: Int -> FieldName -> ShowS
Show
labledField :: T.Text -> FieldName
labledField :: Text -> FieldName
labledField Text
s = Word32 -> Maybe Text -> FieldName
FieldName (Text -> Word32
candidHash Text
s) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s)
hashedField :: Word32 -> FieldName
hashedField :: Word32 -> FieldName
hashedField Word32
h = Word32 -> Maybe Text -> FieldName
FieldName Word32
h Maybe Text
forall a. Maybe a
Nothing
instance Eq FieldName where
== :: FieldName -> FieldName -> Bool
(==) = Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Word32 -> Word32 -> Bool)
-> (FieldName -> Word32) -> FieldName -> FieldName -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldName -> Word32
fieldHash
/= :: FieldName -> FieldName -> Bool
(/=) = Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (Word32 -> Word32 -> Bool)
-> (FieldName -> Word32) -> FieldName -> FieldName -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldName -> Word32
fieldHash
instance Ord FieldName where
compare :: FieldName -> FieldName -> Ordering
compare = Word32 -> Word32 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word32 -> Word32 -> Ordering)
-> (FieldName -> Word32) -> FieldName -> FieldName -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldName -> Word32
fieldHash
< :: FieldName -> FieldName -> Bool
(<) = Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
(<) (Word32 -> Word32 -> Bool)
-> (FieldName -> Word32) -> FieldName -> FieldName -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldName -> Word32
fieldHash
> :: FieldName -> FieldName -> Bool
(>) = Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
(>) (Word32 -> Word32 -> Bool)
-> (FieldName -> Word32) -> FieldName -> FieldName -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldName -> Word32
fieldHash
<= :: FieldName -> FieldName -> Bool
(<=) = Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (Word32 -> Word32 -> Bool)
-> (FieldName -> Word32) -> FieldName -> FieldName -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldName -> Word32
fieldHash
>= :: FieldName -> FieldName -> Bool
(>=) = Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
(>=) (Word32 -> Word32 -> Bool)
-> (FieldName -> Word32) -> FieldName -> FieldName -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldName -> Word32
fieldHash
instance IsString FieldName where
fromString :: String -> FieldName
fromString = Text -> FieldName
labledField (Text -> FieldName) -> (String -> Text) -> String -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString
instance Pretty FieldName where
pretty :: FieldName -> Doc ann
pretty (FieldName Word32
_ (Just Text
x)) = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
x
pretty (FieldName Word32
h Maybe Text
Nothing)
| Just Text
x <- Word32 -> Maybe Text
invertHash Word32
h = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
x
| Bool
otherwise = Word32 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word32
h
unescapeFieldName :: T.Text -> FieldName
unescapeFieldName :: Text -> FieldName
unescapeFieldName Text
n
| Just (Char
'_',Text
r') <- Text -> Maybe (Char, Text)
T.uncons Text
n
, Just (Text
r,Char
'_') <- Text -> Maybe (Text, Char)
T.unsnoc Text
r'
, Just (Natural
n' :: Natural) <- String -> Maybe Natural
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
r)
, Natural
n' Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32)
= Word32 -> FieldName
hashedField (Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n')
| Just (Text
n', Char
'_') <- Text -> Maybe (Text, Char)
T.unsnoc Text
n
= Text -> FieldName
labledField Text
n'
| Bool
otherwise
= Text -> FieldName
labledField Text
n
escapeFieldName :: FieldName -> T.Text
escapeFieldName :: FieldName -> Text
escapeFieldName (FieldName Word32
_ (Just Text
"")) = Text
""
escapeFieldName (FieldName Word32
_ (Just Text
n)) | Text -> Char
T.last Text
n Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' = Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_"
escapeFieldName (FieldName Word32
_ (Just Text
n)) = Text
n
escapeFieldName (FieldName Word32
h Maybe Text
Nothing) = Char -> Text
T.singleton Char
'_' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Word32 -> String
forall a. Show a => a -> String
show Word32
h) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
'_'