module Binrep.Example.Tar where

import Binrep
import Binrep.Generic
import Binrep.Generic qualified as BR
import Binrep.Type.Common ( Endianness(..) )
import Binrep.Type.Int
import Binrep.Type.NullPadded
import Binrep.Type.AsciiNat

import GHC.Generics ( Generic )

import Data.Word ( Word8 )

import GHC.TypeNats

import Data.ByteString qualified as B

import FlatParse.Basic qualified as FP

type BS = B.ByteString

brCfgNoSum :: BR.Cfg (I 'U 'I1 'LE)
brCfgNoSum :: Cfg (I 'U 'I1 'LE)
brCfgNoSum = BR.Cfg { cSumTag :: String -> I 'U 'I1 'LE
BR.cSumTag = String -> I 'U 'I1 'LE
forall a. HasCallStack => a
undefined }

-- | The naturals in tars are sized octal ASCII digit strings that end with a
--   null byte (and may start with leading ASCII zeroes). The size includes the
--   terminating null, so you get @n-1@ digits. What a farce.
--
-- Don't use this constructor directly! The size must be checked to ensure it
-- fits.
newtype TarNat n = TarNat { forall {k} (n :: k). TarNat n -> AsciiNat 8
getTarNat :: AsciiNat 8 }
    deriving stock ((forall x. TarNat n -> Rep (TarNat n) x)
-> (forall x. Rep (TarNat n) x -> TarNat n) -> Generic (TarNat n)
forall x. Rep (TarNat n) x -> TarNat n
forall x. TarNat n -> Rep (TarNat n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (n :: k) x. Rep (TarNat n) x -> TarNat n
forall k (n :: k) x. TarNat n -> Rep (TarNat n) x
$cto :: forall k (n :: k) x. Rep (TarNat n) x -> TarNat n
$cfrom :: forall k (n :: k) x. TarNat n -> Rep (TarNat n) x
Generic, Int -> TarNat n -> ShowS
[TarNat n] -> ShowS
TarNat n -> String
(Int -> TarNat n -> ShowS)
-> (TarNat n -> String) -> ([TarNat n] -> ShowS) -> Show (TarNat n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k). Int -> TarNat n -> ShowS
forall k (n :: k). [TarNat n] -> ShowS
forall k (n :: k). TarNat n -> String
showList :: [TarNat n] -> ShowS
$cshowList :: forall k (n :: k). [TarNat n] -> ShowS
show :: TarNat n -> String
$cshow :: forall k (n :: k). TarNat n -> String
showsPrec :: Int -> TarNat n -> ShowS
$cshowsPrec :: forall k (n :: k). Int -> TarNat n -> ShowS
Show, TarNat n -> TarNat n -> Bool
(TarNat n -> TarNat n -> Bool)
-> (TarNat n -> TarNat n -> Bool) -> Eq (TarNat n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (n :: k). TarNat n -> TarNat n -> Bool
/= :: TarNat n -> TarNat n -> Bool
$c/= :: forall k (n :: k). TarNat n -> TarNat n -> Bool
== :: TarNat n -> TarNat n -> Bool
$c== :: forall k (n :: k). TarNat n -> TarNat n -> Bool
Eq)

type instance CBLen (TarNat n) = n
instance KnownNat n => BLen (TarNat n)

-- | No need to check for underflow etc. as TarNat guarantees good sizing.
instance KnownNat n => Put (TarNat n) where
    put :: TarNat n -> Builder
put (TarNat AsciiNat 8
an) = ByteString -> Builder
forall a. Put a => a -> Builder
put ByteString
pfxNulls Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> AsciiNat 8 -> Builder
forall a. Put a => a -> Builder
put AsciiNat 8
an Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall a. Put a => a -> Builder
put @Word8 Word8
0x00
      where
        pfxNulls :: ByteString
pfxNulls = Int -> Word8 -> ByteString
B.replicate (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pfxNullCount) Word8
0x30
        pfxNullCount :: Int
pfxNullCount = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- AsciiNat 8 -> Int
forall a. BLen a => a -> Int
blen AsciiNat 8
an Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        n :: Int
n = forall (n :: Nat). KnownNat n => Int
typeNatToBLen @n

instance KnownNat n => Get (TarNat n) where
    get :: Getter (TarNat n)
get = do
        AsciiNat 8
an <- Int -> Parser String (AsciiNat 8) -> Parser String (AsciiNat 8)
forall e a. Int -> Parser e a -> Parser e a
FP.isolate (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Parser String (AsciiNat 8)
forall a. Get a => Getter a
get
        forall a. Get a => Getter a
get @Word8 Getter Word8 -> (Word8 -> Getter (TarNat n)) -> Getter (TarNat n)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Word8
0x00 -> TarNat n -> Getter (TarNat n)
forall (m :: * -> *) a. Monad m => a -> m a
return (TarNat n -> Getter (TarNat n)) -> TarNat n -> Getter (TarNat n)
forall a b. (a -> b) -> a -> b
$ AsciiNat 8 -> TarNat n
forall {k} (n :: k). AsciiNat 8 -> TarNat n
TarNat AsciiNat 8
an
          Word8
w    -> String -> Getter (TarNat n)
forall e a. e -> Parser e a
FP.err (String -> Getter (TarNat n)) -> String -> Getter (TarNat n)
forall a b. (a -> b) -> a -> b
$ String
"TODO expected null byte, got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
w
      where
        n :: Int
n = forall (n :: Nat). KnownNat n => Int
typeNatToBLen @n

-- Partial header
data Tar = Tar
  { Tar -> NullPadded 100 ByteString
tarFileName :: NullPadded 100 BS
  , Tar -> TarNat 8
tarFileMode :: TarNat 8
  , Tar -> TarNat 8
tarFileUIDOwner :: TarNat 8
  , Tar -> TarNat 8
tarFileUIDGroup :: TarNat 8
  , Tar -> TarNat 12
tarFileFileSize :: TarNat 12
  , Tar -> TarNat 12
tarFileLastMod :: TarNat 12
  } deriving stock ((forall x. Tar -> Rep Tar x)
-> (forall x. Rep Tar x -> Tar) -> Generic Tar
forall x. Rep Tar x -> Tar
forall x. Tar -> Rep Tar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tar x -> Tar
$cfrom :: forall x. Tar -> Rep Tar x
Generic, Int -> Tar -> ShowS
[Tar] -> ShowS
Tar -> String
(Int -> Tar -> ShowS)
-> (Tar -> String) -> ([Tar] -> ShowS) -> Show Tar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tar] -> ShowS
$cshowList :: [Tar] -> ShowS
show :: Tar -> String
$cshow :: Tar -> String
showsPrec :: Int -> Tar -> ShowS
$cshowsPrec :: Int -> Tar -> ShowS
Show, Tar -> Tar -> Bool
(Tar -> Tar -> Bool) -> (Tar -> Tar -> Bool) -> Eq Tar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tar -> Tar -> Bool
$c/= :: Tar -> Tar -> Bool
== :: Tar -> Tar -> Bool
$c== :: Tar -> Tar -> Bool
Eq)

instance BLen Tar where blen :: Tar -> Int
blen = Cfg (I 'U 'I1 'LE) -> Tar -> Int
forall a w. (Generic a, GBLen (Rep a), BLen w) => Cfg w -> a -> Int
blenGeneric Cfg (I 'U 'I1 'LE)
brCfgNoSum
instance Put  Tar where put :: Tar -> Builder
put  = Cfg (I 'U 'I1 'LE) -> Tar -> Builder
forall a w.
(Generic a, GPut (Rep a), Put w) =>
Cfg w -> a -> Builder
putGeneric  Cfg (I 'U 'I1 'LE)
brCfgNoSum
instance Get  Tar where get :: Getter Tar
get  = Cfg (I 'U 'I1 'LE) -> Getter Tar
forall a w.
(Generic a, GGet (Rep a), Get w, Eq w, Show w) =>
Cfg w -> Parser String a
getGeneric  Cfg (I 'U 'I1 'LE)
brCfgNoSum