{-# 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'

-- | Converts a character to a hex value (if there is one).
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

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