{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Data.Snowchecked.Encoding.Text
( module Data.Snowchecked.Encoding.Class
, module Data.Text.Conversions
) where
import qualified Data.List as L
import Data.Maybe (fromMaybe)
import Data.Snowchecked.Encoding.Integral
import Data.Snowchecked.Encoding.Class
import Data.Snowchecked.Internal.Import
import qualified Data.Text as T
import Data.Text.Conversions
import Data.Snowchecked (snowcheckedConfigBitCount)
import Data.Ratio ((%))
import Data.Char (isHexDigit)
instance {-# INCOHERENT #-} (ToText a, FromText a) => IsFlake (Base16 a) where
fromFlake :: Flake -> Base16 a
fromFlake flake :: Flake
flake@Flake{SnowcheckedConfig
flakeConfig :: Flake -> SnowcheckedConfig
flakeConfig :: SnowcheckedConfig
flakeConfig} = forall a. a -> Base16 a
Base16 forall a b. (a -> b) -> a -> b
$ forall a b. (ToText a, FromText b) => a -> b
convertText String
str
where
hexLength :: Int
hexLength = forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall a b. (a -> b) -> a -> b
$
SnowcheckedConfig -> Word32
snowcheckedConfigBitCount SnowcheckedConfig
flakeConfig forall a. Integral a => a -> a -> Ratio a
% Word32
4
pad0 :: String -> String
pad0 String
str' =
if forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
str' forall a. Ord a => a -> a -> Bool
< Int
hexLength then
String -> String
pad0 (Char
'0'forall a. a -> [a] -> [a]
:String
str')
else
String
str'
str :: String
str = String -> String
pad0 forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Show a) => a -> String -> String
showHex (forall a. IsFlake a => Flake -> a
fromFlake @Integer Flake
flake) String
""
{-# INLINEABLE fromFlake #-}
{-# SPECIALIZE fromFlake :: Flake -> Base16 String #-}
{-# SPECIALIZE fromFlake :: Flake -> Base16 T.Text #-}
parseFish :: forall (m :: * -> *).
MonadFail m =>
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) =
m Integer
calculateN forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
n ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Flakeish
{ fishCheck :: Word256
fishCheck = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. (Num a, Bits a) => a -> Int -> a
cutBits Integer
n Int
checkBitsInt
, fishNodeId :: Word256
fishNodeId = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. (Num a, Bits a) => a -> Int -> Int -> a
shiftCutBits Integer
n Int
checkBitsInt Int
nodeBitsInt
, fishCount :: Word256
fishCount = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. (Num a, Bits a) => a -> Int -> Int -> a
shiftCutBits Integer
n (Int
checkBitsInt forall a. Num a => a -> a -> a
+ Int
nodeBitsInt) Int
countBitsInt
, fishTime :: Word256
fishTime = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. (Num a, Bits a) => a -> Int -> Int -> a
shiftCutBits Integer
n (Int
checkBitsInt forall a. Num a => a -> a -> a
+ Int
nodeBitsInt forall a. Num a => a -> a -> a
+ Int
countBitsInt) Int
timeBitsInt
}
where
str :: String
str = forall a b. (ToText a, FromText b) => a -> b
convertText @_ @String a
raw
cleaned :: String
cleaned =
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhile (Char
'0' forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. (a -> Bool) -> [a] -> [a]
L.filter Char -> Bool
isHexDigit forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a -> a
fromMaybe String
str (forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix String
"0x" String
str)
calculateN :: m Integer
calculateN = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *} {a}.
MonadFail m =>
[(a, String)] -> m (a, String)
findBestResult (forall a. (Eq a, Num a) => ReadS a
readHex @Integer String
cleaned)
findBestResult :: [(a, String)] -> m (a, String)
findBestResult [] = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not find any results"
findBestResult (this :: (a, String)
this@(a
_,String
""):[(a, String)]
_) = forall (m :: * -> *) a. Monad m => a -> m a
return (a, String)
this
findBestResult [(a, String)
onlyResult] = forall (m :: * -> *) a. Monad m => a -> m a
return (a, String)
onlyResult
findBestResult (this :: (a, String)
this@(a
_,String
nRest):[(a, String)]
others) =
[(a, String)] -> m (a, String)
findBestResult [(a, String)]
others forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \other :: (a, String)
other@(a
_, String
mRest) ->
if forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
nRest forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
mRest then
forall (m :: * -> *) a. Monad m => a -> m a
return (a, String)
this
else
forall (m :: * -> *) a. Monad m => a -> m a
return (a, String)
other
checkBitsInt :: Int
checkBitsInt = forall a. Integral a => a -> Int
toInt Word8
confCheckBits
nodeBitsInt :: Int
nodeBitsInt = forall a. Integral a => a -> Int
toInt Word8
confNodeBits
timeBitsInt :: Int
timeBitsInt = forall a. Integral a => a -> Int
toInt Word8
confTimeBits
countBitsInt :: Int
countBitsInt = forall a. Integral a => a -> Int
toInt Word8
confCountBits
{-# INLINEABLE parseFish #-}
{-# SPECIALIZE parseFish :: (MonadFail m) => SnowcheckedConfig -> Base16 T.Text -> m Flakeish #-}
{-# SPECIALIZE parseFish :: (MonadFail m) => SnowcheckedConfig -> Base16 String -> m Flakeish #-}