{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs      #-}
{-# LANGUAGE RecordWildCards   #-}

-- |
-- Module      :  HExcel.HExcelInternal
-- Maintainer  :  Sasha Bogicevic <sasa.bogicevic@pm.me>
-- Stability   :  experimental
--
-- This module contains almost all of the library functionality.

module HExcel.HExcelInternal
  ( Workbook
  , workbookNew
  , workbookNewConstantMem
  , workbookClose
  , workbookAddWorksheet
  , workbookAddFormat
  , workbookDefineName
  , DocProperties (..)
  , workbookSetProperties
  , Worksheet
  , Row
  , Col
  , writeNumber
  , writeString
  , writeUTCTime
  , writeFormula
  , writeArrayFormula
  , DateTime (..)
  , utcTimeToDateTime
  , zonedTimeToDateTime
  , writeDateTime
  , writeUrl
  , worksheetSetRow
  , worksheetSetColumn
  , ImageOptions (..)
  , worksheetInsertImage
  , worksheetInsertImageOpt
  , worksheetMergeRange
  , worksheetFreezePanes
  , worksheetSplitPanes
  , worksheetSetLandscape
  , worksheetSetPortrait
  , worksheetSetPageView
  , PaperSize (..)
  , skipCols
  , skipRows
  , worksheetSetPaperSize
  , worksheetSetMargins
  , worksheetSetHeaderCtl
  , worksheetSetFooterCtl
  , worksheetSetZoom
  , worksheetSetPrintScale
  , Format
  , formatSetFontName
  , formatSetFontSize
  , Color (..)
  , formatSetFontColor
  , formatSetNumFormat
  , formatSetBold
  , formatSetItalic
  , UnderlineStyle (..)
  , formatSetUnderline
  , formatSetStrikeout
  , ScriptStyle (..)
  , formatSetScript
  , formatSetBuiltInFormat
  , Align (..)
  , VerticalAlign (..)
  , formatSetAlign
  , formatSetVerticalAlign
  , formatSetTextWrap
  , formatSetRotation
  , formatSetShrink
  , Pattern (..)
  , formatSetPattern
  , formatSetBackgroundColor
  , formatSetForegroundColor
  , Border (..)
  , BorderStyle (..)
  , formatSetBorder
  , formatSetBorderColor
  , HExcelState (..)
  , HExcel (..)
  , mkDocProperties
  ) where

import Control.Monad.IO.Class
import Control.Monad.Trans.State
import Data.Time
import Data.Time.Clock.POSIX
import Foreign
import Foreign.C.String
import Foreign.C.Types
import HExcel.Ffi
import HExcel.Types
import Lens.Micro

-- | HExcel class that provides a single function `writeCell` as a convenient method
-- of writing excel cell values
class HExcel a where
  writeCell :: MonadIO m => a -> StateT HExcelState m ()

instance HExcel String where
  writeCell :: MonadIO m => String -> StateT HExcelState m ()
  writeCell val = do
    s@HExcelState {..} <- get
    liftIO $
      writeString
        _hexcelStateSheet
        _hexcelStateFormat
        _hexcelStateRow
        _hexcelStateCol
        val
    put $ modifyRowColState s

instance HExcel UTCTime where
  writeCell :: MonadIO m => UTCTime -> StateT HExcelState m ()
  writeCell val = do
    s@HExcelState {..} <- get
    liftIO $
      writeUTCTime
        _hexcelStateSheet
        _hexcelStateFormat
        _hexcelStateRow
        _hexcelStateCol
        val
    put $ modifyRowColState s

instance HExcel DateTime where
  writeCell :: MonadIO m => DateTime -> StateT HExcelState m ()
  writeCell val = do
    s@HExcelState {..} <- get
    liftIO $
      writeDateTime
        _hexcelStateSheet
        _hexcelStateFormat
        _hexcelStateRow
        _hexcelStateCol
        val
    put $ modifyRowColState s

instance HExcel Double where
  writeCell :: MonadIO m => Double -> StateT HExcelState m ()
  writeCell val = do
    s@HExcelState {..} <- get
    liftIO $
      writeNumber
        _hexcelStateSheet
        _hexcelStateFormat
        _hexcelStateRow
        _hexcelStateCol
        val
    put $ modifyRowColState s

instance HExcel Int where
  writeCell :: MonadIO m => Int -> StateT HExcelState m ()
  writeCell val = do
    s@HExcelState {..} <- get
    liftIO $
      writeNumber
        _hexcelStateSheet
        _hexcelStateFormat
        _hexcelStateRow
        _hexcelStateCol
        (fromIntegral val :: Double)
    put $ modifyRowColState s

instance HExcel Float where
  writeCell :: MonadIO m => Float -> StateT HExcelState m ()
  writeCell val = do
    s@HExcelState {..} <- get
    liftIO $
      writeNumber
        _hexcelStateSheet
        _hexcelStateFormat
        _hexcelStateRow
        _hexcelStateCol
        (realToFrac val :: Double)
    put $ modifyRowColState s

instance HExcel Integer where
  writeCell :: MonadIO m => Integer -> StateT HExcelState m ()
  writeCell val = do
    s@HExcelState {..} <- get
    liftIO $
      writeNumber
        _hexcelStateSheet
        _hexcelStateFormat
        _hexcelStateRow
        _hexcelStateCol
        (realToFrac val :: Double)
    put $ modifyRowColState s

instance HExcel Word where
  writeCell :: MonadIO m => Word -> StateT HExcelState m ()
  writeCell val = do
    s@HExcelState {..} <- get
    liftIO $
      writeNumber
        _hexcelStateSheet
        _hexcelStateFormat
        _hexcelStateRow
        _hexcelStateCol
        (realToFrac val :: Double)
    put $ modifyRowColState s

-- | Internal Helper function to change the state of row and column
modifyRowColState :: HExcelState -> HExcelState
modifyRowColState s@HExcelState {..} =
  if _hexcelStateRowCeiling == _hexcelStateRow
     then
       s & hexcelStateRow .~ _hexcelStateInitRow
         & hexcelStateCol +~ 1
     else
       s & hexcelStateRow +~ 1

-- | Skip a number of rows
skipRows :: MonadIO m => Word32 -> StateT HExcelState m ()
skipRows numberOfRows = do
  s@HExcelState {..} <- get
  put $ s & hexcelStateRow .~ _hexcelStateRow + numberOfRows

-- | Skip a number of columns
skipCols :: MonadIO m => Word16 -> StateT HExcelState m ()
skipCols numberOfCols = do
  s@HExcelState {..} <- get
  put $ s & hexcelStateCol .~ _hexcelStateCol + numberOfCols

-- | Create new workbook
workbookNew :: FilePath -> IO Workbook
workbookNew path = withCString path $ fmap Workbook . workbook_new

-- | Create new workbook but force constant memory.
-- It reduces the amount of data stored in memory so that large files
-- can be written efficiently.
workbookNewConstantMem :: FilePath -> IO Workbook
workbookNewConstantMem path =
  with (WorkbookOptions True) $ \copts ->
    withCString path $ \cpath ->
      Workbook <$> workbook_new_opt cpath copts

-- | Close the workbook
workbookClose :: Workbook -> IO ()
workbookClose (Workbook wb) =
  workbook_close wb

-- | Add the worksheet
workbookAddWorksheet :: Workbook -> String -> IO Worksheet
workbookAddWorksheet (Workbook wb) name =
  withCString name $ fmap Worksheet . workbook_add_worksheet wb

-- | Add workbook format
workbookAddFormat :: Workbook -> IO Format
workbookAddFormat (Workbook wb) =
  Format <$> workbook_add_format wb

withDocProperties :: DocProperties -> (Ptr DocProperties' -> IO a) -> IO a
withDocProperties props action =
  withCString (docPropertiesTitle props) $ \ctitle ->
  withCString (docPropertiesSubject props) $ \csubject ->
  withCString (docPropertiesAuthor props) $ \cauthor ->
  withCString (docPropertiesManager props) $ \cmanager ->
  withCString (docPropertiesCompany props) $ \ccompany ->
  withCString (docPropertiesCategory props) $ \ccat ->
  withCString (docPropertiesKeywords props) $ \ckws ->
  withCString (docPropertiesComments props) $ \ccmts ->
  withCString (docPropertiesStatus props) $ \cstat ->
  withCString (docPropertiesHyperlinkBase props) $ \clb ->
    let time   = CTime (round (utcTimeToPOSIXSeconds (docPropertiesCreated props)))
        props' = DocProperties' ctitle csubject cauthor cmanager
                                ccompany ccat ckws ccmts cstat clb time
    in with props' action

-- | Set workbook properties
workbookSetProperties :: Workbook -> DocProperties -> IO ()
workbookSetProperties (Workbook wb) props =
  withDocProperties props $ \cprops ->
    workbook_set_properties wb cprops

-- | Set workbook name
workbookDefineName :: Workbook -> String -> String -> IO ()
workbookDefineName (Workbook wb) name formula =
  withCString name $ \cname -> withCString formula $ \cformula ->
    workbook_define_name wb cname cformula

-- | Write a 'Double' value to Excel cell
writeNumber :: Worksheet -> Maybe Format -> Row -> Col -> Double -> IO ()
writeNumber (Worksheet ws) mfmt row col number =
  worksheet_write_number ws row col number (maybe nullPtr unFormat mfmt)

-- | Write a 'String' value to Excel cell
writeString :: Worksheet -> Maybe Format -> Row -> Col -> String -> IO ()
writeString (Worksheet ws) mfmt row col str =
  withCString str $ \cstr ->
    worksheet_write_string ws row col cstr (maybe nullPtr unFormat mfmt)

-- | Write a 'UTCTime' value to Excel cell
writeUTCTime :: Worksheet -> Maybe Format -> Row -> Col -> UTCTime -> IO ()
writeUTCTime (Worksheet ws) mfmt row col t = do
    let tz = localTimeToUTC utc . utcToLocalTime (TimeZone 60 True "BST")
        ts = utcTimeToPOSIXSeconds (read "1900-01-01 00:00:00") - (2 * 24 * 60 * 60)
        ft = fromRational . toRational . (/ (24 * 60 * 60)) . (+ negate ts) . utcTimeToPOSIXSeconds . tz
    worksheet_write_number ws row col (ft t) (maybe nullPtr unFormat mfmt)

-- | Write a formula to Excel cell
writeFormula :: Worksheet -> Maybe Format -> Row -> Col -> String -> IO ()
writeFormula (Worksheet ws) mfmt row col str =
  withCString str $ \cstr ->
    worksheet_write_formula ws row col cstr (maybe nullPtr unFormat mfmt)

writeArrayFormula
  :: Worksheet
  -> Maybe Format
  -> Row
  -> Col
  -> Row
  -> Col
  -> String
  -> IO ()
writeArrayFormula (Worksheet ws) mfmt frow fcol erow ecol str =
  withCString str $ \cstr ->
    worksheet_write_array_formula
      ws
      frow
      fcol
      erow
      ecol
      cstr
      (maybe nullPtr unFormat mfmt)

-- | Helper function to convert  'UTCTime' to 'DateTime'
utcTimeToDateTime :: UTCTime -> DateTime
utcTimeToDateTime (UTCTime day time) =
  let (y, m, d)        = toGregorian day
      TimeOfDay h mi s = timeToTimeOfDay time
  in DateTime (fromIntegral y) (fromIntegral m) (fromIntegral d)
       (fromIntegral h) (fromIntegral mi) (fromRational (toRational s))

-- | Helper function to convert  'ZonedTime' to 'DateTime'
zonedTimeToDateTime :: ZonedTime -> DateTime
zonedTimeToDateTime = utcTimeToDateTime . zonedTimeToUTC

-- | Write a 'DateTime' to Excel cell
writeDateTime :: Worksheet -> Maybe Format -> Row -> Col -> DateTime -> IO ()
writeDateTime (Worksheet ws) mfmt row col dt =
  with dt $ \pdt ->
    worksheet_write_datetime ws row col pdt (maybe nullPtr unFormat mfmt)

-- | Write a url to Excel cell
writeUrl :: Worksheet -> Maybe Format -> Row -> Col -> String -> IO ()
writeUrl (Worksheet ws) mfmt row col str =
  withCString str $ \cstr ->
    worksheet_write_url ws row col cstr (maybe nullPtr unFormat mfmt)

-- | Set worksheet row
worksheetSetRow :: Worksheet -> Maybe Format -> Row -> Double -> IO ()
worksheetSetRow (Worksheet ws) mfmt row height =
  worksheet_set_row ws row height (maybe nullPtr unFormat mfmt)

-- | Set worksheet column
worksheetSetColumn :: Worksheet -> Maybe Format -> Col -> Col -> Double -> IO ()
worksheetSetColumn (Worksheet ws) mfmt fcol lcol width =
  worksheet_set_column ws fcol lcol width (maybe nullPtr unFormat mfmt)

-- | Insert image to worksheet
worksheetInsertImage :: Worksheet -> Word32 -> Word16 -> String -> IO ()
worksheetInsertImage (Worksheet ws) row col path =
  withCString path $ \cpath ->
    worksheet_insert_image ws row col cpath

worksheetInsertImageOpt
  :: Worksheet
  -> Row
  -> Col
  -> FilePath
  -> ImageOptions
  -> IO ()
worksheetInsertImageOpt (Worksheet ws) row col path opt =
  withCString path $ \cpath ->
    with opt $ \optr -> worksheet_insert_image_opt ws row col cpath optr

-- | Merge columns
worksheetMergeRange
  :: Worksheet
  -> Maybe Format
  -> Row
  -> Col
  -> Row
  -> Col
  -> String
  -> IO ()
worksheetMergeRange (Worksheet ws) mfmt frow fcol lrow lcol str =
  withCString str $ \cstr ->
    worksheet_merge_range
      ws
      frow
      fcol
      lrow
      lcol
      cstr
      (maybe nullPtr unFormat mfmt)

worksheetFreezePanes :: Worksheet -> Row -> Col -> IO ()
worksheetFreezePanes (Worksheet ws) = worksheet_freeze_panes ws

worksheetSplitPanes :: Worksheet -> Double -> Double -> IO ()
worksheetSplitPanes (Worksheet ws) = worksheet_split_panes ws

-- | Set worksheet to Landscape
worksheetSetLandscape :: Worksheet -> IO ()
worksheetSetLandscape (Worksheet ws) =
  worksheet_set_landscape ws

-- | Set worksheet to Portrait
worksheetSetPortrait :: Worksheet -> IO ()
worksheetSetPortrait (Worksheet ws) =
  worksheet_set_portrait ws

worksheetSetPageView :: Worksheet -> IO ()
worksheetSetPageView (Worksheet ws) =
  worksheet_set_page_view ws

-- | Set worksheet 'PaperSize'
worksheetSetPaperSize :: Worksheet -> PaperSize -> IO ()
worksheetSetPaperSize (Worksheet ws) paper =
  worksheet_set_paper ws (toPaper paper)
  where
    toPaper :: PaperSize -> Word8
    toPaper DefaultPaper   = 0
    toPaper LetterPaper    = 1
    toPaper A3Paper        = 8
    toPaper A4Paper        = 9
    toPaper A5Paper        = 11
    toPaper (OtherPaper n) = n

-- | Set worksheet margins
worksheetSetMargins :: Worksheet -> Double -> Double -> Double -> Double -> IO ()
worksheetSetMargins (Worksheet ws) = worksheet_set_margins ws

worksheetSetHeaderCtl :: Worksheet -> String -> IO ()
worksheetSetHeaderCtl (Worksheet ws) str =
  withCString str $ \cstr -> worksheet_set_header ws cstr

worksheetSetFooterCtl :: Worksheet -> String -> IO ()
worksheetSetFooterCtl (Worksheet ws) str =
  withCString str $ \cstr -> worksheet_set_footer ws cstr

worksheetSetZoom :: Worksheet -> Double -> IO ()
worksheetSetZoom (Worksheet ws) zoom =
  worksheet_set_zoom ws (round (100.0 * zoom'))
  where
    zoom' = min 0.1 (max 4.0 zoom)

worksheetSetPrintScale :: Worksheet -> Double -> IO ()
worksheetSetPrintScale (Worksheet ws) scale =
  worksheet_set_print_scale ws (round (100.0 * scale'))
  where
    scale' = min 0.1 (max 4.0 scale)

-- | Set font name
formatSetFontName :: Format -> String -> IO ()
formatSetFontName (Format fp) name =
  withCString name $ \cname ->
    format_set_font_name fp cname

-- | Set font size
formatSetFontSize :: Format -> Word16 -> IO ()
formatSetFontSize (Format fp) = format_set_font_size fp

colorIndex :: Color -> Int32
colorIndex ColorBlack    = 0x00000000
colorIndex ColorBlue     = 0x000000ff
colorIndex ColorBrown    = 0x00800000
colorIndex ColorCyan     = 0x0000ffff
colorIndex ColorGray     = 0x00808080
colorIndex ColorGreen    = 0x00008000
colorIndex ColorLime     = 0x0000ff00
colorIndex ColorMagenta  = 0x00ff00ff
colorIndex ColorNavy     = 0x00000080
colorIndex ColorOrange   = 0x00ff6600
colorIndex ColorPink     = 0x00ff00ff
colorIndex ColorPurple   = 0x00800080
colorIndex ColorRed      = 0x00ff0000
colorIndex ColorSilver   = 0x00c0c0c0
colorIndex ColorWhite    = 0x00ffffff
colorIndex ColorYellow   = 0x00ffff00
colorIndex (Color r g b) =
  fromIntegral r `shiftL` 16 .|.
  fromIntegral g `shiftL`  8 .|.
  fromIntegral b

-- | Set font color
formatSetFontColor :: Format -> Color -> IO ()
formatSetFontColor (Format fp) color =
  format_set_font_color fp (colorIndex color)

-- | Set number format
formatSetNumFormat :: Format -> String -> IO ()
formatSetNumFormat (Format fp) fmt =
  withCString fmt $ \cfmt ->
    format_set_num_format fp cfmt

-- | Set bold style
formatSetBold :: Format -> IO ()
formatSetBold (Format fp) =
  format_set_bold fp

-- | Set italic style
formatSetItalic :: Format -> IO ()
formatSetItalic (Format fp) =
  format_set_italic fp

-- | Set underline style
formatSetUnderline :: Format -> UnderlineStyle -> IO ()
formatSetUnderline (Format fp) us =
  format_set_underline fp (fromIntegral (fromEnum us))

formatSetStrikeout :: Format -> IO ()
formatSetStrikeout (Format fp) =
  format_set_font_strikeout fp

formatSetScript :: Format -> ScriptStyle -> IO ()
formatSetScript (Format fp) s =
  format_set_font_script fp (1 + fromIntegral (fromEnum s))

formatSetBuiltInFormat :: Format -> Word8 -> IO ()
formatSetBuiltInFormat (Format fp) = format_set_num_format_index fp

formatSetAlign :: Format -> Align -> IO ()
formatSetAlign (Format fp) a = format_set_align fp (fromIntegral (fromEnum a))

formatSetVerticalAlign :: Format -> VerticalAlign -> IO ()
formatSetVerticalAlign (Format fp) a =
  format_set_align fp a'
  where
    a' = case fromEnum a of
      0 -> 0
      n -> 7 + fromIntegral n

formatSetTextWrap :: Format -> IO ()
formatSetTextWrap (Format fp) =
  format_set_text_wrap fp

formatSetRotation :: Format -> Int -> IO ()
formatSetRotation (Format fp) angle =
  format_set_rotation fp (fromIntegral angle)

formatSetShrink :: Format -> IO ()
formatSetShrink (Format fp) =
  format_set_shrink fp


formatSetPattern :: Format -> Pattern -> IO ()
formatSetPattern (Format fp) pat =
  format_set_pattern fp (fromIntegral (fromEnum pat))

formatSetBackgroundColor :: Format -> Color -> IO ()
formatSetBackgroundColor (Format fp) color =
  format_set_bg_color fp (colorIndex color)

formatSetForegroundColor :: Format -> Color -> IO ()
formatSetForegroundColor (Format fp) color =
  format_set_fg_color fp (colorIndex color)


formatSetBorder :: Format -> Border -> BorderStyle -> IO ()
formatSetBorder (Format fp) border style =
  function fp (fromIntegral (fromEnum style))
  where
    function = case border of
      BorderAll    -> format_set_border
      BorderBottom -> format_set_bottom
      BorderTop    -> format_set_top
      BorderLeft   -> format_set_left
      BorderRight  -> format_set_right

formatSetBorderColor :: Format -> Border -> Color -> IO ()
formatSetBorderColor (Format fp) border color =
  function fp (colorIndex color)
  where
    function = case border of
      BorderAll    -> format_set_border_color
      BorderBottom -> format_set_bottom_color
      BorderTop    -> format_set_top_color
      BorderLeft   -> format_set_left_color
      BorderRight  -> format_set_right_color

mkDocProperties :: DocProperties
mkDocProperties =
  DocProperties { docPropertiesTitle = ""
                , docPropertiesSubject       = ""
                , docPropertiesAuthor        = ""
                , docPropertiesManager       = ""
                , docPropertiesCompany       = ""
                , docPropertiesCategory      = ""
                , docPropertiesKeywords      = ""
                , docPropertiesComments      = ""
                , docPropertiesStatus        = ""
                , docPropertiesHyperlinkBase = ""
                , docPropertiesCreated       =
                    read "1984-07-06 18:00:00 UTC"
                }