{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Codec.Candid.FieldName
( FieldName
, labledField
, hashedField
, fieldHash
, candidHash
, invertHash
, unescapeFieldName
, escapeFieldName
) where
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.ByteString.Lazy as BS
import Data.Text.Prettyprint.Doc
import Data.String
import Data.Maybe
import Data.Word
import Data.Char
import Numeric.Natural
import Data.Function
import Text.Read (readMaybe)
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
candidHash :: T.Text -> Word32
candidHash :: Text -> Word32
candidHash Text
s = (Word32 -> Word8 -> Word32) -> Word32 -> ByteString -> Word32
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl (\Word32
h Word8
c -> Word32
h Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
223 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c) Word32
0 (ByteString -> Word32) -> ByteString -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
s
invertHash :: Word32 -> Maybe T.Text
invertHash :: Word32 -> Maybe Text
invertHash Word32
w32 | Word32
w32 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
32 = Maybe Text
forall a. Maybe a
Nothing
invertHash Word32
w32 = [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
guesses
where
x :: Word64
x = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w32 :: Word64
chars :: String
chars = [Char
'a'..Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'_']
ords :: [Word64]
ords = Word64
0 Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: (Char -> Word64) -> String -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> (Char -> Int) -> Char -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) String
chars
non_mod :: a -> a
non_mod a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
- (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
2a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
32::Int))
guesses :: [Text]
guesses =
[ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
guess
| Word64
c8 <- [Word64]
ords, Word64
c7 <- [Word64]
ords, Word64
c6 <- [Word64]
ords, Word64
c5 <- [Word64]
ords
, let high_chars :: Word64
high_chars = Word64
c5 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
223Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
4::Int) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
c6 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
223Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
5::Int) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
c7 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
223Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6::Int) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
c8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
223Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
7::Int)
, let guess :: String
guess = Word64 -> String
simple (Word64 -> String) -> Word64 -> String
forall a b. (a -> b) -> a -> b
$ Word64
x Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64 -> Word64
forall a. Integral a => a -> a
non_mod Word64
high_chars
, (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
chars) String
guess
]
simple :: Word64 -> String
simple :: Word64 -> String
simple Word64
0 = String
""
simple Word64
x = Int -> Char
chr (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
b) Char -> ShowS
forall a. a -> [a] -> [a]
: Word64 -> String
simple Word64
a
where (Word64
a, Word64
b) = Word64
x Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word64
223
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
'_'