-- | Derive 'BLen', 'Put', 'Get' and 'CBLen' instances generically.

module Binrep.Generic
  ( Cfg(..)
  , cSumTagHex, cSumTagNullTerm, cDef
  , blenGeneric, putGeneric, getGeneric, CBLenGeneric
  ) where

import Binrep.Generic.Internal
import Binrep.Generic.BLen
import Binrep.Generic.Put
import Binrep.Generic.Get
import Binrep.Generic.CBLen

import Binrep.Type.ByteString ( AsByteString, Rep(..) )
import Refined.Unsafe ( reallyUnsafeRefine )
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text

import Numeric ( readHex )

-- TODO better error handling (see what aeson does)

-- | Obtain the tag for a sum type value by applying a function to the
--   constructor name, and reading the result as a hexadecimal number.
cSumTagHex :: forall a. Integral a => (String -> String) -> String -> a
cSumTagHex :: forall a. Integral a => (String -> String) -> String -> a
cSumTagHex String -> String
f = [(a, String)] -> a
forall a. [(a, String)] -> a
forceRead ([(a, String)] -> a) -> (String -> [(a, String)]) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(a, String)]
forall a. (Eq a, Num a) => ReadS a
readHex (String -> [(a, String)])
-> (String -> String) -> String -> [(a, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f

-- | Successfully parse exactly one result, or runtime error.
forceRead :: [(a, String)] -> a
forceRead :: forall a. [(a, String)] -> a
forceRead = \case []        -> String -> a
forall a. HasCallStack => String -> a
error String
"no parse"
                  [(a
x, String
"")] -> a
x
                  [(a
_x, String
_)] -> String -> a
forall a. HasCallStack => String -> a
error String
"incomplete parse"
                  ((a, String)
_:[(a, String)]
_)     -> String -> a
forall a. HasCallStack => String -> a
error String
"too many parses (how??)"

-- | Obtain the tag for a sum type value using the constructor name directly
--   (with a null terminator).
--
-- This is probably not what you want in a binary representation, but it's safe
-- and may be useful for debugging.
--
-- The refine force is safe under the assumption that Haskell constructor names
-- are UTF-8 with no null bytes allowed. I haven't confirmed that, but I'm
-- fairly certain.
cSumTagNullTerm :: String -> AsByteString 'C
cSumTagNullTerm :: String -> AsByteString 'C
cSumTagNullTerm = ByteString -> AsByteString 'C
forall {k} x (p :: k). x -> Refined p x
reallyUnsafeRefine (ByteString -> AsByteString 'C)
-> (String -> ByteString) -> String -> AsByteString 'C
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

cDef :: Cfg (AsByteString 'C)
cDef :: Cfg (AsByteString 'C)
cDef = Cfg { cSumTag :: String -> AsByteString 'C
cSumTag = String -> AsByteString 'C
cSumTagNullTerm }