{-# LANGUAGE NoImplicitPrelude, Rank2Types, DeriveGeneric, OverloadedStrings #-}
module Data.Machine.Tar (untarrer, VirtualFile(..)) where

import BasicPrelude hiding (null)
import Control.DeepSeq
import Control.Exception (assert)
import Control.Lens.Fold
import Control.Lens.Getter
import Data.ByteString.Lens
import Data.Machine hiding (takingWhile)
import Data.Machine.ByteString
import Data.Machine.Stack
import GHC.Generics (Generic)
import Filesystem.Path (null)
import Filesystem.Path.Rules (decodeString, encodeString, posix_ghc704, toText)

data VirtualFile = VirtualFile { name :: FilePath
                               , contents :: ByteString
                               } deriving (Generic, Show)

instance NFData VirtualFile

ensuring :: a -> (a -> Bool) -> a
x `ensuring` p = assert (p x) x

parseOctalDigit :: Word8 -> Int
parseOctalDigit = (`ensuring` (\r -> r `elem` [0..7])) . (\i -> i - 48) . fromEnum

parseOctal :: ByteString -> Int
parseOctal = foldlOf' bytes (\prev nextChar -> prev * 8 + parseOctalDigit nextChar) 0

tarBlockSize = 512

untarrer :: Machine (Stack ByteString) VirtualFile
untarrer = repeatedly $ do
  name <- decodeString posix_ghc704 . toListOf (takingWhile (/= '\0') chars) <$> readFromStack 100
  when (null name) stop -- EOF
  readFromStack 24
  nBytes <- parseOctal <$> readFromStack 11
  readFromStack $ tarBlockSize - (100 + 35) -- remainder of header block
  c <- readFromStack nBytes
  let padding = if r == 0 then 0 else tarBlockSize - r where r = nBytes `mod` tarBlockSize
  readFromStack padding
  yield VirtualFile { name = name, contents = c }
