{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-} -- This concerns Zip.zipEntrySize in produceZip

module Handler.Zip
  ( Zip.ZipError(..)
  , Zip.ZipInfo(..)
  , produceZip
  , consumeZip
  ) where

import Import

import qualified Codec.Archive.Zip.Conduit.Types as Zip
import qualified Codec.Archive.Zip.Conduit.UnZip as Zip
import qualified Codec.Archive.Zip.Conduit.Zip as Zip

import qualified Data.ByteString.Lazy as Lazy (ByteString)
import qualified Data.ByteString.Lazy as Lazy.ByteString

import Data.ByteString (ByteString)

import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

import System.FilePath
import Data.Time


data ZipEntry = ZipEntry
  { zipEntryName :: FilePath
  , zipEntryTime :: UTCTime
  , zipEntryContents :: Maybe Lazy.ByteString -- ^ 'Nothing' means this is a directory
  }


consumeZip :: (ZipEntry -> YesodDB UniWorX a) -- ^ Insert entries into database
          -> Sink ByteString (YesodDB UniWorX) (Zip.ZipInfo, [a])
consumeZip = error "consumeZip not implemented yet"


produceZip :: ( MonadBase b m
              , PrimMonad b
              , MonadThrow m
              ) => Zip.ZipInfo
              -> Conduit ZipEntry m ByteString
produceZip info = toZipData =$= void (Zip.zipStream zipOptions)
  where
    zipOptions = Zip.ZipOptions
      { zipOpt64 = True
      , zipOptCompressLevel = -1 -- This is passed through all the way to the C zlib, where it means "default level"
      , zipOptInfo = info
      }
    toZipData :: Monad m => Conduit ZipEntry m (Zip.ZipEntry, Zip.ZipData m)
    toZipData = do
      entry <- await
      case entry of
        Nothing
          -> return ()
        Just (e@ZipEntry{ zipEntryContents = Nothing })
          -> yield ((toZipEntry True e){ Zip.zipEntrySize = Nothing }, mempty)
        Just (e@ZipEntry{ zipEntryContents = Just b})
          -> yield ((toZipEntry False e){ Zip.zipEntrySize = Just . fromIntegral $ Lazy.ByteString.length b }, Zip.ZipDataByteString b)
    toZipEntry :: Bool -- ^ Is directory?
               -> ZipEntry -> Zip.ZipEntry
    toZipEntry isDir ZipEntry{..} = Zip.ZipEntry
      { zipEntryName = Text.encodeUtf8 . Text.pack . bool dropTrailingPathSeparator addTrailingPathSeparator isDir . normalise $ makeValid zipEntryName
      , zipEntryTime = utcToLocalTime utc zipEntryTime
      }