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

module Binrep.Generic
  ( Cfg(..), cfg
  , cSumTagHex, cSumTagNullTerm, cDef
  , cNoSum, EDerivedSumInstanceWithNonSumCfg(..)
  , 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 )

import Data.Void ( Void )
import Control.Exception ( Exception, throw )

import Binrep.Util ( tshow )

cfg :: (Eq a, Show a) => (String -> a) -> Cfg a
cfg :: forall a. (Eq a, Show a) => (String -> a) -> Cfg a
cfg String -> a
f = Cfg { cSumTag :: String -> a
cSumTag = String -> a
f, cSumTagEq :: a -> a -> Bool
cSumTagEq = forall a. Eq a => a -> a -> Bool
(==), cSumTagShow :: a -> Text
cSumTagShow = forall a. Show a => a -> Text
tshow }

-- | 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 = forall a. [(a, String)] -> a
forceRead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Num a) => ReadS a
readHex 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 []        -> forall a. HasCallStack => String -> a
error String
"no parse"
                  [(a
x, String
"")] -> a
x
                  [(a
_x, String
_)] -> forall a. HasCallStack => String -> a
error String
"incomplete parse"
                  ((a, String)
_:[(a, String)]
_)     -> 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 = forall {k} x (p :: k). x -> Refined p x
reallyUnsafeRefine forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

-- | Default generic derivation configuration, using 'cSumTagNullTerm'.
cDef :: Cfg (AsByteString 'C)
cDef :: Cfg (AsByteString 'C)
cDef = forall a. (Eq a, Show a) => (String -> a) -> Cfg a
cfg String -> AsByteString 'C
cSumTagNullTerm

-- | Special generic derivation configuration you may use for non-sum data
--   types.
--
-- When generically deriving binrep instances for a non-sum type, you may like
-- to ignore sum tag handling. You could use 'cDef', but this will silently
-- change behaviour if your type becomes a sum type. This configuration will
-- generate clear runtime errors when used with a sum type.
--
-- By selecting 'Void' for the sum tag type, consumption actions (serializing,
-- getting length in bytes) will runtime error, while generation actions
-- (parsing) will hit the 'Void' instance first and always safely error out.
cNoSum :: Cfg Void
cNoSum :: Cfg Void
cNoSum = forall a. (Eq a, Show a) => (String -> a) -> Cfg a
cfg forall a b. (a -> b) -> a -> b
$ \String
_ -> forall a e. Exception e => e -> a
throw EDerivedSumInstanceWithNonSumCfg
EDerivedSumInstanceWithNonSumCfg

-- This indirection enables us to test for this precise exception being thrown
-- in an incorrect configuration! Awesome!
data EDerivedSumInstanceWithNonSumCfg = EDerivedSumInstanceWithNonSumCfg
instance Show EDerivedSumInstanceWithNonSumCfg where
    show :: EDerivedSumInstanceWithNonSumCfg -> String
show EDerivedSumInstanceWithNonSumCfg
EDerivedSumInstanceWithNonSumCfg =
        String
"Binrep.Generic.cNoSum: non-sum generic derivation configuration used with a sum type"
instance Exception EDerivedSumInstanceWithNonSumCfg