{-# OPTIONS_GHC -fno-warn-orphans #-}

module Model.Types.Csv
  ( Quoting(..)
  , CsvOptions(..), _csvFormat, _csvTimestamp
  , CsvFormatOptions(..), _csvDelimiter, _csvUseCrLf, _csvQuoting, _csvEncoding
  , CsvPreset(..)
  , csvPreset
  , _CsvEncodeOptions
  , CsvFormat(..), _FormatCsv, _FormatXlsx
  , _CsvFormat, _CsvFormatPreset
  ) where

import ClassyPrelude

import Data.Csv (Quoting(..))
import qualified Data.Csv as Csv

import Model.Types.TH.JSON
import Utils.PathPiece
import Data.Universe.TH
import Data.Aeson.TH

import Data.Aeson (FromJSON, ToJSON)
import qualified Data.Aeson as JSON

import Data.Encoding (DynEncoding)

import Data.Encoding.Instances ()

import Control.Lens

import Utils.Lens.TH

import Data.Default
import Data.Universe


deriving stock instance Generic Quoting
deriving stock instance Ord Quoting
deriving stock instance Read Quoting
deriving anyclass instance Hashable Quoting
deriving anyclass instance NFData Quoting
deriveJSON defaultOptions
  { constructorTagModifier = camelToPathPiece' 1
  } ''Quoting
deriveFinite ''Quoting
nullaryPathPiece ''Quoting $ \q -> if
  | q == "QuoteNone" -> "never"
  | otherwise -> camelToPathPiece' 1 q

data CsvOptions
  = CsvOptions
    { csvFormat    :: CsvFormatOptions
    , csvTimestamp :: Bool
    }
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
  deriving anyclass (Hashable, NFData)

data CsvFormatOptions
  = CsvFormatOptions
    { csvDelimiter :: Char
    , csvUseCrLf   :: Bool
    , csvQuoting   :: Csv.Quoting
    , csvEncoding  :: DynEncoding
    }
  | CsvXlsxFormatOptions
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
  deriving anyclass (Hashable, NFData)

makeLenses_ ''CsvOptions
makeLenses_ ''CsvFormatOptions

instance Default CsvOptions where
  def = CsvOptions
    { csvFormat    = def
    , csvTimestamp = False
    }

instance Default CsvFormatOptions where
  def = csvPreset # CsvPresetRFC

data CsvPreset = CsvPresetRFC
               | CsvPresetXlsx
               | CsvPresetExcel
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
instance Universe CsvPreset
instance Finite CsvPreset

csvPreset :: Prism' CsvFormatOptions CsvPreset
csvPreset = prism' fromPreset toPreset
  where
    fromPreset :: CsvPreset -> CsvFormatOptions
    fromPreset CsvPresetRFC   = CsvFormatOptions
      { csvDelimiter = ','
      , csvUseCrLf   = True
      , csvQuoting   = QuoteMinimal
      , csvEncoding  = "UTF8"
      }
    fromPreset CsvPresetExcel = CsvFormatOptions
      { csvDelimiter = ';'
      , csvUseCrLf   = True
      , csvQuoting   = QuoteAll
      , csvEncoding  = "CP1252"
      }
    fromPreset CsvPresetXlsx = CsvXlsxFormatOptions

    toPreset :: CsvFormatOptions -> Maybe CsvPreset
    toPreset opts = case filter (\p -> fromPreset p == opts) universeF of
      [p]    -> Just p
      _other -> Nothing

_CsvEncodeOptions :: Prism' CsvFormatOptions Csv.EncodeOptions
_CsvEncodeOptions = prism' fromEncode toEncode
  where
    toEncode CsvFormatOptions{..} = Just $ Csv.defaultEncodeOptions
      { Csv.encDelimiter     = fromIntegral $ fromEnum csvDelimiter
      , Csv.encUseCrLf       = csvUseCrLf
      , Csv.encQuoting       = csvQuoting
      , Csv.encIncludeHeader = True
      }
    toEncode CsvXlsxFormatOptions{} = Nothing
    fromEncode encOpts = def
      { csvDelimiter = toEnum . fromIntegral $ Csv.encDelimiter encOpts
      , csvUseCrLf   = Csv.encUseCrLf encOpts
      , csvQuoting   = Csv.encQuoting encOpts
      }

instance ToJSON CsvOptions where
  toJSON CsvOptions{..} = JSON.object
    [ "format"    JSON..= csvFormat
    , "timestamp" JSON..= csvTimestamp
    ]

instance FromJSON CsvOptions where
  parseJSON = JSON.withObject "CsvOptions" $ \o -> do
    csvFormat    <- o JSON..:? "format" JSON..!= csvFormat def
    csvTimestamp <- o JSON..:? "timestamp" JSON..!= csvTimestamp def
    return CsvOptions{..}

data CsvFormat = FormatCsv | FormatXlsx
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
  deriving anyclass (Universe, Finite)

nullaryPathPiece ''CsvFormat $ camelToPathPiece' 1
pathPieceJSON ''CsvFormat
makePrisms ''CsvFormat

_CsvFormat :: forall r. Getting r CsvFormatOptions CsvFormat
_CsvFormat = to $ \case
  CsvFormatOptions{}     -> FormatCsv
  CsvXlsxFormatOptions{} -> FormatXlsx

_CsvFormatPreset :: Prism' CsvPreset CsvFormat
_CsvFormatPreset = prism' toPreset fromPreset
  where
    toPreset = \case
      FormatCsv -> CsvPresetRFC
      FormatXlsx -> CsvPresetXlsx
    fromPreset = \case
      CsvPresetRFC -> Just FormatCsv
      CsvPresetXlsx -> Just FormatXlsx
      _other -> Nothing

instance ToJSON CsvFormatOptions where
  toJSON CsvFormatOptions{..} = JSON.object
    [ "format"    JSON..= FormatCsv
    , "delimiter" JSON..= fromEnum csvDelimiter
    , "use-cr-lf" JSON..= csvUseCrLf
    , "quoting"   JSON..= csvQuoting
    , "encoding"  JSON..= csvEncoding
    ]
  toJSON CsvXlsxFormatOptions = JSON.object
    [ "format"   JSON..= FormatXlsx
    ]
instance FromJSON CsvFormatOptions where
  parseJSON = JSON.withObject "CsvFormatOptions" $ \o -> do
    formatTag <- o JSON..:? "format" JSON..!= FormatCsv
    
    case formatTag of
      FormatCsv -> do
        csvDelimiter <- fmap (fmap toEnum) (o JSON..:? "delimiter") JSON..!= csvDelimiter def
        csvUseCrLf   <- o JSON..:? "use-cr-lf" JSON..!= csvUseCrLf  def
        csvQuoting   <- o JSON..:? "quoting"   JSON..!= csvQuoting  def
        csvEncoding  <- o JSON..:? "encoding"  JSON..!= csvEncoding def
        return CsvFormatOptions{..}
      FormatXlsx -> return CsvXlsxFormatOptions

derivePersistFieldJSON ''CsvOptions

nullaryPathPiece ''CsvPreset $ camelToPathPiece' 2
