{-# OPTIONS_GHC -fno-warn-missing-fields #-} -- This concerns zipEntrySize in produceZip
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Handler.Utils.Zip
  ( ZipError(..)
  , ZipInfo(..)
  , produceZip
  , consumeZip
  , modifyFileTitle
  , sourceFiles, acceptFile
  ) where

import Import

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

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

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

import System.FilePath
import Data.Time.LocalTime (localTimeToUTC, utcToLocalTime)

import Data.List (dropWhileEnd)

import Network.Mime


instance Default ZipInfo where
  def = ZipInfo
    { zipComment = mempty
    }


consumeZip :: ( MonadBase b m
              , PrimMonad b
              , MonadThrow m
              ) => ConduitM ByteString File m ZipInfo
consumeZip = unZipStream `fuseUpstream` consumeZip'
  where
    consumeZip' :: ( MonadThrow m
                   ) => Conduit (Either ZipEntry ByteString) m File
    consumeZip' = do
      input <- await
      case input of
        Nothing -> return ()
        Just (Right _) -> throw $ userError "Data chunk in unexpected place when parsing ZIP"
        Just (Left ZipEntry{..}) -> do
          contentChunks <- toConsumer accContents
          let
            fileTitle = dropWhile isPathSeparator . dropTrailingPathSeparator . normalise $ makeValid zipEntryName
            fileModified = localTimeToUTC utc zipEntryTime
            fileContent
              | hasTrailingPathSeparator zipEntryName = Nothing
              | otherwise = Just $ mconcat contentChunks
          yield File{..}
          consumeZip'
    accContents :: Monad m => Sink (Either a b) m [b]
    accContents = do
      input <- await
      case input of
        Just (Right x) -> (x :) <$> accContents
        Just (Left x)  -> []    <$ leftover (Left x)
        _ -> return []

produceZip :: ( MonadBase b m
              , PrimMonad b
              , MonadThrow m
              ) => ZipInfo
              -> Conduit File m ByteString
produceZip info = mapC toZipData =$= void (zipStream zipOptions)
  where
    zipOptions = 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 => File -> (ZipEntry, ZipData m)
    toZipData f@File{..} = ((toZipEntry f){ zipEntrySize = fromIntegral . ByteString.length <$> fileContent }, maybe mempty (ZipDataByteString . Lazy.ByteString.fromStrict) fileContent)

    toZipEntry :: File -> ZipEntry
    toZipEntry File{..} = ZipEntry
      { zipEntryName = bool (dropWhileEnd isPathSeparator) addTrailingPathSeparator isDir . normalise . makeValid $ fileTitle
      , zipEntryTime = utcToLocalTime utc fileModified
      }
      where
        isDir = isNothing fileContent

modifyFileTitle :: Monad m => (FilePath -> FilePath) -> Conduit File m File
modifyFileTitle f = mapC $ \x@File{..} -> x{ fileTitle = f fileTitle }

-- Takes FileInfo and if it is a ZIP-Archive, extract files, otherwiese yield fileinfo
sourceFiles :: (MonadResource m, MonadThrow m, MonadIO m) => FileInfo -> Source m File
sourceFiles fInfo
    | mimeType == "application/zip" = fileSource fInfo =$= void consumeZip
    | otherwise = yieldM $ acceptFile fInfo
  where
    mimeType = defaultMimeLookup (fileName fInfo)

acceptFile :: (MonadResource m, MonadThrow m, MonadIO m) => FileInfo -> m File
acceptFile fInfo = do
  let fileTitle = dropWhile isPathSeparator . dropTrailingPathSeparator . normalise . unpack $ fileName fInfo
  fileModified <- liftIO getCurrentTime
  fileContent <- Just <$> runConduit (fileSource fInfo =$= foldC)
  return File{..}