{-# LANGUAGE TemplateHaskell,OverloadedStrings #-}

module Database.Alteryx.CLI.Yxdb2Csv where

import Database.Alteryx

import Control.Applicative
import Control.Lens hiding (set, setting)
import Control.Monad
import Control.Monad.State
import Control.Monad.Trans.Resource
import qualified Control.Newtype as NT
import Data.Array.Unboxed as A
import qualified Data.ByteString as BS
import Data.Conduit
import Data.Conduit.Binary
import qualified Data.Conduit.Combinators as CC
import Data.Int
import Data.Monoid
import Data.Text as T hiding (concat, foldl)
import Data.Text.IO
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Data.Time.Format
import Prelude hiding (putStrLn)
import System.Console.GetOpt
import System.Environment
import System.IO hiding (putStrLn)
import System.Locale

data Settings = Settings {
  _settingDecompress :: Bool,
  _settingMetadata   :: Bool,
  _settingNumBlocks  :: Maybe Int,
  _settingNumRecords :: Maybe Int,
  _settingVerbose    :: Bool,
  _settingFilename   :: FilePath
  }

makeLenses ''Settings

options :: [OptDescr (Settings -> Settings)]
options =
  let set setting = \o -> (& setting .~ Just (read o))
  in [
    Option ['b'] ["num-blocks"] (ReqArg (set settingNumBlocks) "Number of blocks") "Only output the given number of blocks",
    Option ['r'] ["num-records"] (ReqArg (set settingNumRecords) "Number of records") "Only output the given number of records, per block",
    Option ['m'] ["dump-metadata"] (NoArg (& settingMetadata .~ True)) "Dump the file's metadata",
    Option ['v'] ["verbose"] (NoArg (& settingVerbose .~ True)) "Print extra debugging information on stderr",
    Option ['d'] ["decompress-blocks"] (NoArg (& settingDecompress .~ True)) "Debug: Decompress blocks, but don't try to interpret them."
  ]

defaultSettings :: Settings
defaultSettings = Settings {
  _settingDecompress = False,
  _settingMetadata   = False,
  _settingNumBlocks  = Nothing,
  _settingNumRecords = Nothing,
  _settingVerbose    = False,
  _settingFilename   = error "defaultSettings: Filename empty"
  }

parseOptions :: [String] -> IO ([Settings -> Settings])
parseOptions args =
  case getOpt Permute options args of
    (opts, filename:[], []) -> return $ (\o -> o & settingFilename .~ filename):opts
    (_, [], [])             -> fail $ "Must provide a filename\n" ++ usageInfo header options
    (_, _, errors)          -> fail $ concat errors ++ usageInfo header options
  where
    header = "Usage: yxdb2csv [OPTIONS...] filename"

processOptions :: [Settings -> Settings] -> Settings
processOptions = foldl (flip ($)) defaultSettings

getSettings :: IO Settings
getSettings = do
  argv <- getArgs
  opts <- parseOptions argv
  return $ processOptions opts

printHeader :: YxdbMetadata -> StateT Settings IO ()
printHeader metadata = do
  settings <- get
  let header = metadata ^. metadataHeader
  liftIO $ do
    putStrLn "Header:"
    putStrLn $ ("  Description: " <>)            $ header ^. description
    putStrLn $ ("  FileId: " <>)                 $ T.pack $ show $ header ^. fileId
    putStrLn $ ("  CreationDate: " <>)           $ T.pack $ show $ header ^. creationDate
    putStrLn $ ("  Flags1: " <>)                 $ T.pack $ show $ header ^. flags1
    putStrLn $ ("  Flags2: " <>)                 $ T.pack $ show $ header ^. flags2
    putStrLn $ ("  MetaInfoLength: " <>)         $ T.pack $ show $ header ^. metaInfoLength
    putStrLn $ ("  Mystery: " <>)                $ T.pack $ show $ header ^. mystery
    putStrLn $ ("  Spatial Index Position: " <>) $ T.pack $ show $ header ^. spatialIndexPos
    putStrLn $ ("  Block Index Position: " <>)   $ T.pack $ show $ header ^. recordBlockIndexPos
    putStrLn $ ("  Number of Records: " <>)      $ T.pack $ show $ header ^. numRecords
    putStrLn $ ("  Compression Version: " <>)    $ T.pack $ show $ header ^. compressionVersion
    when (settings ^. settingVerbose) $
      putStrLn $ ("  Reserved Space: " <>)         $ T.pack $ show $ header ^. reservedSpace


printBlocks :: YxdbMetadata -> StateT Settings IO ()
printBlocks metadata =
  let printBlock :: Int64 -> StateT Settings IO ()
      printBlock x = liftIO $ putStrLn $ T.pack $ show x
  in do
  liftIO $ putStrLn "Blocks:"
  Prelude.mapM_ printBlock $ A.elems $ NT.unpack $ metadata ^. metadataBlockIndex



runMetadata :: StateT Settings IO ()
runMetadata = do
  settings <- get
  yxdbMetadata <- liftIO $ getMetadata $ settings ^. settingFilename
  printHeader yxdbMetadata
  liftIO $ printRecordInfo $ yxdbMetadata ^. metadataRecordInfo
  when (settings ^. settingVerbose) $
    printBlocks yxdbMetadata

getBlockLimiter :: (MonadThrow m) => StateT Settings IO (Conduit Block m Block)
getBlockLimiter = do
   settings <- get
   return $ case settings ^. settingNumBlocks of
              Just n  -> CC.take n
              Nothing -> CC.map id

getRecordLimiter :: (MonadThrow m) => StateT Settings IO (Conduit Record m Record)
getRecordLimiter = do
   settings <- get
   return $ case settings ^. settingNumRecords of
              Just n  -> CC.take n
              Nothing -> CC.map id

runDecompress :: StateT Settings IO ()
runDecompress = do
  settings <- get
  let filename = settings ^. settingFilename
  metadata <- liftIO $ getMetadata filename
  let recordInfo = metadata ^. metadataRecordInfo
  blockLimiter <- getBlockLimiter
  runResourceT $
    sourceFileBlocks filename metadata $=
    blockLimiter =$=
    blocksToDecompressedBytes $$
    sinkHandle stdout

runYxdb2Csv :: StateT Settings IO ()
runYxdb2Csv = do
  settings <- get
  let filename = settings ^. settingFilename
  metadata <- liftIO $ getMetadata filename
  let recordInfo = metadata ^. metadataRecordInfo
  blockLimiter <- getBlockLimiter
  recordLimiter <- getRecordLimiter

  runResourceT $
    sourceFileBlocks filename metadata $=
    blockLimiter =$=
    blocksToRecords recordInfo =$=
    recordLimiter =$=
    record2csv recordInfo =$=
    csv2bytes $$
    sinkHandle stdout

yxdb2csvMain :: IO ()
yxdb2csvMain = do
  settings <- getSettings
  flip evalStateT settings $
    case () of
      _ | settings ^. settingMetadata   -> runMetadata
        | settings ^. settingDecompress -> runDecompress
        | otherwise                     -> runYxdb2Csv