{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE RecordWildCards      #-}
{-# LANGUAGE UndecidableInstances #-}
{-# 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           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)

-- | Convert a hex value to a character.
--
--   WARNING: This function returns the null character ('\0') if you pass in a value > 15.
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'
{-# INLINE c #-}

-- | Converts a character to a hex value (if there is one).
b :: Char -> Maybe Word8
b :: Char -> Maybe Word8
b Char
ch = forall a. Read a => String -> Maybe a
readMaybe [Char
ch] 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' -> forall a. a -> Maybe a
Just Word8
10
			Char
'a' -> forall a. a -> Maybe a
Just Word8
10
			Char
'B' -> forall a. a -> Maybe a
Just Word8
11
			Char
'b' -> forall a. a -> Maybe a
Just Word8
11
			Char
'C' -> forall a. a -> Maybe a
Just Word8
12
			Char
'c' -> forall a. a -> Maybe a
Just Word8
12
			Char
'D' -> forall a. a -> Maybe a
Just Word8
13
			Char
'd' -> forall a. a -> Maybe a
Just Word8
13
			Char
'E' -> forall a. a -> Maybe a
Just Word8
14
			Char
'e' -> forall a. a -> Maybe a
Just Word8
14
			Char
'F' -> forall a. a -> Maybe a
Just Word8
15
			Char
'f' -> forall a. a -> Maybe a
Just Word8
15
			Char
_   -> forall a. Maybe a
Nothing
{-# INLINE b #-}

-- | Converts a byte to two hex characters: low nibble and then high nibble.
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 = forall a bitCount.
(Num a, Bits a, Integral bitCount) =>
a -> bitCount -> a
cutBits Word8
w8 Integer
4
		highNibble :: Word8
highNibble = forall a cutBitCount shiftBitCount.
(Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) =>
a -> shiftBitCount -> cutBitCount -> a
shiftCutBits Word8
w8 Integer
4 Integer
4
{-# INLINE byteToHex #-}

instance {-# INCOHERENT #-} (ToText a, FromText a) => IsFlake (Base16 a) where
	fromFlake :: Flake -> Base16 a
fromFlake Flake
flake = 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
			str :: String
str = forall a. (Word8 -> a -> a) -> a -> ByteString -> a
LBS.foldr Word8 -> String -> String
bytesToChars [] forall a b. (a -> b) -> a -> b
$ 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 forall a. a -> [a] -> [a]
: Char
highC forall a. a -> [a] -> [a]
: String
rest
	{-# 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) = 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 bitCount.
(Num a, Bits a, Integral bitCount) =>
a -> bitCount -> a
cutBits Integer
n Integer
checkBitsInteger
			, fishNodeId :: Word256
fishNodeId = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a cutBitCount shiftBitCount.
(Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) =>
a -> shiftBitCount -> cutBitCount -> a
shiftCutBits Integer
n (Integer
checkBitsInteger forall a. Num a => a -> a -> a
+ Integer
nodeBitsInteger) Integer
countBitsInteger
			, fishTime :: Word256
fishTime = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a cutBitCount shiftBitCount.
(Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) =>
a -> shiftBitCount -> cutBitCount -> a
shiftCutBits Integer
n (Integer
checkBitsInteger forall a. Num a => a -> a -> a
+ Integer
nodeBitsInteger forall a. Num a => a -> a -> a
+ Integer
countBitsInteger) Integer
timeBitsInteger
			}
		where
			nibbles :: [Word8]
nibbles = forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr Char -> [Maybe Word8] -> [Maybe Word8]
toNibbles [] forall a b. (a -> b) -> a -> b
$ forall a. ToText a => a -> Text
toText a
raw
			n :: Integer
n = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr forall {a}. Integral a => a -> Integer -> Integer
addNibbles Integer
0 [Word8]
nibbles
			addNibbles :: a -> Integer -> Integer
addNibbles a
nib Integer
total = forall a. Integral a => a -> Integer
toInteger a
nib forall a. Num a => a -> a -> a
+ ( Integer
total 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 forall a. a -> [a] -> [a]
: [Maybe Word8]
lst
			checkBitsInteger :: Integer
checkBitsInteger = forall a. Integral a => a -> Integer
toInteger Word8
confCheckBits
			nodeBitsInteger :: Integer
nodeBitsInteger = forall a. Integral a => a -> Integer
toInteger Word8
confNodeBits
			timeBitsInteger :: Integer
timeBitsInteger = forall a. Integral a => a -> Integer
toInteger Word8
confTimeBits
			countBitsInteger :: Integer
countBitsInteger = 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 #-}