{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- This module keeps the FieldName type abstract,
-- to ensure that the field name hash is correct
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

-- | A type for a Candid field name. Essentially a 'Word32' with maybe a textual label attached
data FieldName = FieldName
    { FieldName -> Word32
fieldHash :: Word32 -- ^ Extract the raw field hash value
    , 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

-- | Create a 'FieldName' from a label
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)

-- | Create a 'FieldName' from the raw hash
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


-- | The inverse of 'escapeFieldName'
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

-- | Represent a 'FieldName' (which may be numeric) in contexts where only text
-- is allowed, using the same encoding/decoding algorithm as Motoko.
--
-- This used in the 'Codec.Candid.Class.Candid' instance for 'Data.Row.Rec' and
-- 'Data.Row.Vec'
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
'_'