{-# LANGUAGE FunctionalDependencies #-}

module Binrep.Get
  ( Getter, Get(..), runGet, runGetter
  , GetWith(..), runGetWith
  ) where

import FlatParse.Basic qualified as FP
import FlatParse.Basic ( Parser )
import Data.ByteString qualified as B
import Data.Word
import Data.Int
import GHC.Exts

type Getter a = Parser String a

class Get a where
    -- | Parse from binary.
    get :: Getter a

runGet :: Get a => B.ByteString -> Either String (a, B.ByteString)
runGet :: forall a. Get a => ByteString -> Either String (a, ByteString)
runGet = Getter a -> ByteString -> Either String (a, ByteString)
forall a. Getter a -> ByteString -> Either String (a, ByteString)
runGetter Getter a
forall a. Get a => Getter a
get

runGetter :: Getter a -> B.ByteString -> Either String (a, B.ByteString)
runGetter :: forall a. Getter a -> ByteString -> Either String (a, ByteString)
runGetter Getter a
g ByteString
bs = case Getter a -> ByteString -> Result String a
forall e a. Parser e a -> ByteString -> Result e a
FP.runParser Getter a
g ByteString
bs of
                   FP.OK a
a ByteString
bs' -> (a, ByteString) -> Either String (a, ByteString)
forall a b. b -> Either a b
Right (a
a, ByteString
bs')
                   Result String a
FP.Fail     -> String -> Either String (a, ByteString)
forall a b. a -> Either a b
Left String
"TODO fail"
                   FP.Err String
e    -> String -> Either String (a, ByteString)
forall a b. a -> Either a b
Left String
e

-- | Parse heterogeneous lists in order. No length indicator, so either fails or
--   succeeds by reaching EOF. Probably not what you usually want, but sometimes
--   used at the "top" of binary formats.
instance Get a => Get [a] where
    get :: Getter [a]
get = do [a]
as <- Parser String a -> Getter [a]
forall e a. Parser e a -> Parser e [a]
FP.many Parser String a
forall a. Get a => Getter a
get
             Parser String ()
forall e. Parser e ()
FP.eof
             [a] -> Getter [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
as

instance (Get a, Get b) => Get (a, b) where
    get :: Getter (a, b)
get = do
        a
a <- Getter a
forall a. Get a => Getter a
get
        b
b <- Getter b
forall a. Get a => Getter a
get
        (a, b) -> Getter (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)

instance Get B.ByteString where
    get :: Getter ByteString
get = Getter ByteString
forall e. Parser e ByteString
FP.takeRestBs

instance Get Word8 where get :: Getter Word8
get = Getter Word8
forall e. Parser e Word8
FP.anyWord8
instance Get  Int8 where get :: Getter Int8
get = Getter Int8
forall e. Parser e Int8
FP.anyInt8

-- | A type that can be parsed from binary given some environment.
--
-- Making this levity polymorphic makes things pretty strange, but is useful.
-- See @Binrep.Example.FileTable@.
class GetWith (r :: TYPE rep) a | a -> r where
    -- | Parse from binary with the given environment.
    getWith :: r -> Getter a
    -- can no longer provide default implementation due to levity polymorphism
    --default getWith :: Get a => r -> Getter a
    --getWith _ = get

--deriving anyclass instance Get a => GetWith r [a]

-- Note that @r@ is not levity polymorphic, GHC forces it to be lifted. You
-- can't bind (LHS) a levity polymorphic value.
runGetWith
    :: GetWith (r :: TYPE LiftedRep) a
    => r -> B.ByteString -> Either String (a, B.ByteString)
runGetWith :: forall r a.
GetWith r a =>
r -> ByteString -> Either String (a, ByteString)
runGetWith r
r ByteString
bs = Getter a -> ByteString -> Either String (a, ByteString)
forall a. Getter a -> ByteString -> Either String (a, ByteString)
runGetter (r -> Getter a
forall r a. GetWith r a => r -> Getter a
getWith r
r) ByteString
bs