{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE RecordWildCards      #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# OPTIONS_GHC -Wno-orphans      #-}
{-|
 This module provides a generalized conversion function between a
 'Flake' and all types that are members of both 'FromText' and 'ToText'.
 It is specialized for the strict 'Text' and 'String' types. It is marked as
 incoherent due to the constraint being no smaller than the instance type,
 so it is undecidable.

 To specify how you want the conversion to be performed, you need to wrap the
 text-like type the 'Base16' constructor.  Other encodings (eg: Base64) may
 be added later.

 Note that when converting to a 'Flake', the implementation silently discards
 characters other than digits, 'a'-'f', and 'A'-'F'.  This allows you to
 apply formatting to the Flake.
-}

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 #-}