{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Data.Snowchecked.Encoding.Text
( module Data.Snowchecked.Encoding.Class
, module Data.Text.Conversions
) where
import Control.Applicative ((<|>))
import qualified Data.ByteString.Lazy as LBS
import qualified Data.List as L
import Data.Maybe (catMaybes)
import Data.Snowchecked.Encoding.ByteString.Lazy ()
import Data.Snowchecked.Encoding.Class
import Data.Snowchecked.Internal.Import
import qualified Data.Text as T
import Data.Text.Conversions
import Text.Read (readMaybe)
c :: Word8 -> Char
c :: Word8 -> Char
c Word8
0 = Char
'0'
c Word8
1 = Char
'1'
c Word8
2 = Char
'2'
c Word8
3 = Char
'3'
c Word8
4 = Char
'4'
c Word8
5 = Char
'5'
c Word8
6 = Char
'6'
c Word8
7 = Char
'7'
c Word8
8 = Char
'8'
c Word8
9 = Char
'9'
c Word8
10 = Char
'a'
c Word8
11 = Char
'b'
c Word8
12 = Char
'c'
c Word8
13 = Char
'd'
c Word8
14 = Char
'e'
c Word8
15 = Char
'f'
c Word8
_ = Char
'\0'
b :: Char -> Maybe Word8
b :: Char -> Maybe Word8
b Char
ch = String -> Maybe Word8
forall a. Read a => String -> Maybe a
readMaybe [Char
ch] Maybe Word8 -> Maybe Word8 -> Maybe Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Word8
chLookup
where
chLookup :: Maybe Word8
chLookup = case Char
ch of
Char
'A' -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
10
Char
'a' -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
10
Char
'B' -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
11
Char
'b' -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
11
Char
'C' -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
12
Char
'c' -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
12
Char
'D' -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
13
Char
'd' -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
13
Char
'E' -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
14
Char
'e' -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
14
Char
'F' -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
15
Char
'f' -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
15
Char
_ -> Maybe Word8
forall a. Maybe a
Nothing
byteToHex :: Word8 -> (Char,Char)
byteToHex :: Word8 -> (Char, Char)
byteToHex Word8
w8 = (Word8 -> Char
c Word8
lowNibble, Word8 -> Char
c Word8
highNibble)
where
lowNibble :: Word8
lowNibble = Word8 -> Integer -> Word8
forall a bitCount.
(Num a, Bits a, Integral bitCount) =>
a -> bitCount -> a
cutBits Word8
w8 Integer
4
highNibble :: Word8
highNibble = Word8 -> Integer -> Integer -> Word8
forall a cutBitCount shiftBitCount.
(Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) =>
a -> shiftBitCount -> cutBitCount -> a
shiftCutBits Word8
w8 Integer
4 Integer
4
instance {-# INCOHERENT #-} (ToText a, FromText a) => IsFlake (Base16 a) where
fromFlake :: Flake -> Base16 a
fromFlake Flake
flake = a -> Base16 a
forall a. a -> Base16 a
Base16 (a -> Base16 a) -> a -> Base16 a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a b. (ToText a, FromText b) => a -> b
convertText String
str
where
str :: String
str = (Word8 -> String -> String) -> String -> ByteString -> String
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
LBS.foldr Word8 -> String -> String
bytesToChars [] (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Flake -> ByteString
forall a. IsFlake a => Flake -> a
fromFlake Flake
flake
bytesToChars :: Word8 -> String -> String
bytesToChars Word8
w8 String
rest =
let (Char
lowC, Char
highC) = Word8 -> (Char, Char)
byteToHex Word8
w8 in Char
lowC Char -> String -> String
forall a. a -> [a] -> [a]
: Char
highC Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest
{-# INLINEABLE fromFlake #-}
{-# SPECIALIZE fromFlake :: Flake -> Base16 String #-}
{-# SPECIALIZE fromFlake :: Flake -> Base16 T.Text #-}
parseFish :: SnowcheckedConfig -> Base16 a -> m Flakeish
parseFish SnowcheckedConfig{Word8
confCheckBits :: SnowcheckedConfig -> Word8
confNodeBits :: SnowcheckedConfig -> Word8
confCountBits :: SnowcheckedConfig -> Word8
confTimeBits :: SnowcheckedConfig -> Word8
confCheckBits :: Word8
confNodeBits :: Word8
confCountBits :: Word8
confTimeBits :: Word8
..} (Base16 a
raw) = Flakeish -> m Flakeish
forall (m :: * -> *) a. Monad m => a -> m a
return (Flakeish -> m Flakeish) -> Flakeish -> m Flakeish
forall a b. (a -> b) -> a -> b
$ Flakeish :: Word256 -> Word256 -> Word256 -> Word256 -> Flakeish
Flakeish
{ fishCheck :: Word256
fishCheck = Integer -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word256) -> Integer -> Word256
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a bitCount.
(Num a, Bits a, Integral bitCount) =>
a -> bitCount -> a
cutBits Integer
n Integer
checkBitsInteger
, fishNodeId :: Word256
fishNodeId = Integer -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word256) -> Integer -> Word256
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
forall a cutBitCount shiftBitCount.
(Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) =>
a -> shiftBitCount -> cutBitCount -> a
shiftCutBits Integer
n Integer
checkBitsInteger Integer
nodeBitsInteger
, fishCount :: Word256
fishCount = Integer -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word256) -> Integer -> Word256
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
forall a cutBitCount shiftBitCount.
(Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) =>
a -> shiftBitCount -> cutBitCount -> a
shiftCutBits Integer
n (Integer
checkBitsInteger Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
nodeBitsInteger) Integer
countBitsInteger
, fishTime :: Word256
fishTime = Integer -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word256) -> Integer -> Word256
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> Integer
forall a cutBitCount shiftBitCount.
(Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) =>
a -> shiftBitCount -> cutBitCount -> a
shiftCutBits Integer
n (Integer
checkBitsInteger Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
nodeBitsInteger Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
countBitsInteger) Integer
timeBitsInteger
}
where
nibbles :: [Word8]
nibbles = [Maybe Word8] -> [Word8]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Word8] -> [Word8])
-> (Text -> [Maybe Word8]) -> Text -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Maybe Word8] -> [Maybe Word8])
-> [Maybe Word8] -> Text -> [Maybe Word8]
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr Char -> [Maybe Word8] -> [Maybe Word8]
toNibbles [] (Text -> [Word8]) -> Text -> [Word8]
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. ToText a => a -> Text
toText a
raw
n :: Integer
n = (Word8 -> Integer -> Integer) -> Integer -> [Word8] -> Integer
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr Word8 -> Integer -> Integer
forall a. Integral a => a -> Integer -> Integer
addNibbles Integer
0 [Word8]
nibbles
addNibbles :: a -> Integer -> Integer
addNibbles a
nib Integer
total = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
nib Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ ( Integer
total Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
4 )
toNibbles :: Char -> [Maybe Word8] -> [Maybe Word8]
toNibbles Char
ch [Maybe Word8]
lst = Char -> Maybe Word8
b Char
ch Maybe Word8 -> [Maybe Word8] -> [Maybe Word8]
forall a. a -> [a] -> [a]
: [Maybe Word8]
lst
checkBitsInteger :: Integer
checkBitsInteger = Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
confCheckBits
nodeBitsInteger :: Integer
nodeBitsInteger = Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
confNodeBits
timeBitsInteger :: Integer
timeBitsInteger = Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
confTimeBits
countBitsInteger :: Integer
countBitsInteger = Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger Word8
confCountBits
{-# INLINEABLE parseFish #-}
{-# SPECIALIZE parseFish :: (MonadFail m) => SnowcheckedConfig -> Base16 T.Text -> m Flakeish #-}
{-# SPECIALIZE parseFish :: (MonadFail m) => SnowcheckedConfig -> Base16 String -> m Flakeish #-}