diff --git a/.DS_Store b/.DS_Store new file mode 100644 Binary files /dev/null and b/.DS_Store differ diff --git a/._.DS_Store b/._.DS_Store new file mode 100644 Binary files /dev/null and b/._.DS_Store differ diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for HExcel + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/HExcel.cabal b/HExcel.cabal new file mode 100644 --- /dev/null +++ b/HExcel.cabal @@ -0,0 +1,40 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 62133125a83cd855af0e3dd872fb71b2de059d93bef1b7f5504ad003a4115eb7 + +name: HExcel +version: 0.1.0.0 +synopsis: Create Excel files with Haskell +description: Easily create Excel files with Haskell. See README at +category: Data, Text, SpreadSheet +author: Sasha Bogicevic +maintainer: sasa.bogicevic@pm.me +license: BSD3 +license-file: LICENSE +build-type: Simple + +library + exposed-modules: + HExcel + other-modules: + HExcel.Ffi + HExcel.HExcelInternal + HExcel.Types + Paths_HExcel + hs-source-dirs: + src + ghc-options: -Wall + extra-libraries: + z + xlsxwriter + build-depends: + base >=4.5 && <4.13 + , microlens + , microlens-th + , time + , transformers + default-language: Haskell2010 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2019, Sasa Bogicevic + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Sasa Bogicevic nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,53 @@ +# HExcel +Create Excel files with Haskell +------------------------------------------------------------------------------- +This is a fork of [libxlsxwriter](https://github.com/HalfWayMan/libxlsxwriter) +that tries the improve on the api and provide a library for +creation of Excel files. +Underneath the hood it uses C library called [libxlsxwriter](http://libxlsxwriter.github.io/) and provides +bindings to C code to produce Excel 2007+ xlsx files. + +## Example + +``` +{-# LANGUAGE TypeApplications #-} +module Main where + +import Control.Monad.Trans.State (execStateT) +import Control.Monad (forM_) +import Data.Time (getZonedTime) +import HExcel + +main :: IO () +main = do + wb <- workbookNew "test.xlsx" + let props = mkDocProperties + { docPropertiesTitle = "Test Workbook" + , docPropertiesCompany = "HExcel" + } + workbookSetProperties wb props + ws <- workbookAddWorksheet wb "First Sheet" + df <- workbookAddFormat wb + formatSetNumFormat df "mmm d yyyy hh:mm AM/PM" + now <- getZonedTime + -- You can create HExcelState which is convenient api for writing to cells + let initState = HExcelState Nothing ws 4 1 0 1 0 + _ <- flip execStateT initState $ do + writeCell "David" + writeCell "Dimitrije" + -- we can skip some rows + skipRows 1 + writeCell "Jovana" + -- or skip some columns + skipCols 1 + writeCell (zonedTimeToDateTime now) + writeCell @Double 42.5 + + -- or use functions that run in plain IO + forM_ [5 .. 8] $ \n -> do + writeString ws Nothing n 3 "xxx" + writeNumber ws Nothing n 4 1234.56 + writeDateTime ws (Just df) n 5 (zonedTimeToDateTime now) + workbookClose wb + +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/package.yaml b/package.yaml new file mode 100644 --- /dev/null +++ b/package.yaml @@ -0,0 +1,27 @@ +name: HExcel +version: 0.1.0.0 +synopsis: Create Excel files with Haskell +author: Sasha Bogicevic +maintainer: sasa.bogicevic@pm.me +license: BSD3 +build-type: Simple +description: Easily create Excel files with Haskell. See README at +category: Data, Text, SpreadSheet + +dependencies: + - base >= 4.5 && < 4.13 + - transformers + - time + - microlens + - microlens-th + +ghc-options: -Wall + +library: + exposed-modules: + - HExcel + source-dirs: + - src + extra-libraries: + - z + - xlsxwriter diff --git a/src/HExcel.hs b/src/HExcel.hs new file mode 100644 --- /dev/null +++ b/src/HExcel.hs @@ -0,0 +1,55 @@ +-- | +-- Module : HExcel +-- Maintainer : Sasha Bogicevic +-- Stability : experimental +-- +-- Module exports +-- +-- Example usage: +-- +-- > {-# LANGUAGE TypeApplications #-} +-- > module Main where +-- > +-- > import Control.Monad.Trans.State (execStateT) +-- > import Control.Monad (forM_) +-- > import Data.Time (getZonedTime) +-- > import HExcel +-- > +-- > main :: IO () +-- > main = do +-- > wb <- workbookNew "test.xlsx" +-- > let props = mkDocProperties +-- > { docPropertiesTitle = "Test Workbook" +-- > , docPropertiesCompany = "HExcel" +-- > } +-- > workbookSetProperties wb props +-- > ws <- workbookAddWorksheet wb "First Sheet" +-- > df <- workbookAddFormat wb +-- > formatSetNumFormat df "mmm d yyyy hh:mm AM/PM" +-- > now <- getZonedTime +-- > -- You can create HExcelState which is convenient api for writing to cells +-- > let initState = HExcelState Nothing ws 4 1 0 1 0 +-- > _ <- flip execStateT initState $ do +-- > writeCell "David" +-- > writeCell "Dimitrije" +-- > -- we can skip some rows +-- > skipRows 1 +-- > writeCell "Jovana" +-- > -- skip some columns +-- > skipCols 1 +-- > writeCell (zonedTimeToDateTime now) +-- > writeCell @Double 42.5 +-- > +-- > -- or use functions that run in plain IO +-- > forM_ [5 .. 8] $ \n -> do +-- > writeString ws Nothing n 3 "xxx" +-- > writeNumber ws Nothing n 4 1234.56 +-- > writeDateTime ws (Just df) n 5 (zonedTimeToDateTime now) +-- > workbookClose wb + +module HExcel + ( module HExcel.HExcelInternal + ) + where + +import HExcel.HExcelInternal diff --git a/src/HExcel/Ffi.hs b/src/HExcel/Ffi.hs new file mode 100644 --- /dev/null +++ b/src/HExcel/Ffi.hs @@ -0,0 +1,209 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +-- | +-- Module : HExcel.Ffi +-- Maintainer : Sasha Bogicevic +-- Stability : experimental +-- +-- FFI code + +module HExcel.Ffi where + +import Foreign +import Foreign.C.String +import HExcel.Types + +foreign import ccall "workbook_new" + workbook_new :: CString -> IO (Ptr LxwWorkbook_) + +foreign import ccall "workbook_new_opt" + workbook_new_opt :: CString -> Ptr WorkbookOptions -> IO (Ptr LxwWorkbook_) + +foreign import ccall "workbook_close" + workbook_close :: Ptr LxwWorkbook_ -> IO () + +foreign import ccall "workbook_add_worksheet" + workbook_add_worksheet :: Ptr LxwWorkbook_ -> CString -> + IO (Ptr LxwWorksheet_) + +foreign import ccall "workbook_add_format" + workbook_add_format :: Ptr LxwWorkbook_ -> IO (Ptr LxwFormat_) + +foreign import ccall "workbook_set_properties" + workbook_set_properties :: Ptr LxwWorkbook_ -> + Ptr DocProperties' -> IO () + +foreign import ccall "workbook_define_name" + workbook_define_name :: Ptr LxwWorkbook_ -> CString -> CString -> IO () + +foreign import ccall "worksheet_write_number" + worksheet_write_number :: Ptr LxwWorksheet_ -> + Word32 -> Word16 -> + Double -> Ptr LxwFormat_ -> IO () + +foreign import ccall "worksheet_write_string" + worksheet_write_string :: Ptr LxwWorksheet_ -> + Word32 -> Word16 -> + CString -> Ptr LxwFormat_ -> IO () + +foreign import ccall "worksheet_write_formula" + worksheet_write_formula :: Ptr LxwWorksheet_ -> + Word32 -> Word16 -> + CString -> Ptr LxwFormat_ -> IO () + +foreign import ccall "worksheet_write_array_formula" + worksheet_write_array_formula :: Ptr LxwWorksheet_ -> + Word32 -> Word16 -> + Word32 -> Word16 -> + CString -> Ptr LxwFormat_ -> IO () + +foreign import ccall "worksheet_write_datetime" + worksheet_write_datetime :: Ptr LxwWorksheet_ -> + Word32 -> Word16 -> + Ptr DateTime -> Ptr LxwFormat_ -> IO () + +foreign import ccall "worksheet_write_url" + worksheet_write_url :: Ptr LxwWorksheet_ -> + Word32 -> Word16 -> + CString -> Ptr LxwFormat_ -> IO () + +foreign import ccall "worksheet_set_row" + worksheet_set_row :: Ptr LxwWorksheet_ -> + Word32 -> Double -> Ptr LxwFormat_ -> IO () + +foreign import ccall "worksheet_set_column" + worksheet_set_column :: Ptr LxwWorksheet_ -> + Word16 -> Word16 -> Double -> Ptr LxwFormat_ -> IO () + +foreign import ccall "worksheet_insert_image" + worksheet_insert_image :: Ptr LxwWorksheet_ -> + Word32 -> Word16 -> CString -> IO () + +foreign import ccall "worksheet_insert_image_opt" + worksheet_insert_image_opt :: Ptr LxwWorksheet_ -> + Word32 -> Word16 -> + CString -> Ptr ImageOptions -> IO () + +foreign import ccall "worksheet_merge_range" + worksheet_merge_range :: Ptr LxwWorksheet_ -> + Word32 -> Word16 -> + Word32 -> Word16 -> + CString -> Ptr LxwFormat_ -> IO () + +foreign import ccall "worksheet_freeze_panes" + worksheet_freeze_panes :: Ptr LxwWorksheet_ -> + Word32 -> Word16 -> IO () + +foreign import ccall "worksheet_split_panes" + worksheet_split_panes :: Ptr LxwWorksheet_ -> + Double -> Double -> IO () + +foreign import ccall "worksheet_set_landscape" + worksheet_set_landscape :: Ptr LxwWorksheet_ -> IO () + +foreign import ccall "worksheet_set_portrait" + worksheet_set_portrait :: Ptr LxwWorksheet_ -> IO () + +foreign import ccall "worksheet_set_page_view" + worksheet_set_page_view :: Ptr LxwWorksheet_ -> IO () + +foreign import ccall "worksheet_set_paper" + worksheet_set_paper :: Ptr LxwWorksheet_ -> Word8 -> IO () + +foreign import ccall "worksheet_set_margins" + worksheet_set_margins :: Ptr LxwWorksheet_ -> + Double -> Double -> + Double -> Double -> IO () + +foreign import ccall "worksheet_set_header" + worksheet_set_header :: Ptr LxwWorksheet_ -> CString -> IO () + +foreign import ccall "worksheet_set_footer" + worksheet_set_footer :: Ptr LxwWorksheet_ -> CString -> IO () + +foreign import ccall "worksheet_set_zoom" + worksheet_set_zoom :: Ptr LxwWorksheet_ -> Word16 -> IO () + +foreign import ccall "worksheet_set_print_scale" + worksheet_set_print_scale:: Ptr LxwWorksheet_ -> Word16 -> IO () + +foreign import ccall "format_set_font_name" + format_set_font_name :: Ptr LxwFormat_ -> CString -> IO () + +foreign import ccall "format_set_font_size" + format_set_font_size :: Ptr LxwFormat_ -> Word16 -> IO () + +foreign import ccall "format_set_font_color" + format_set_font_color :: Ptr LxwFormat_ -> Int32 -> IO () + +foreign import ccall "format_set_num_format" + format_set_num_format :: Ptr LxwFormat_ -> CString -> IO () + +foreign import ccall "format_set_bold" + format_set_bold :: Ptr LxwFormat_ -> IO () + +foreign import ccall "format_set_italic" + format_set_italic :: Ptr LxwFormat_ -> IO () + +foreign import ccall "format_set_underline" + format_set_underline :: Ptr LxwFormat_ -> Word8 -> IO () + +foreign import ccall "format_set_font_strikeout" + format_set_font_strikeout :: Ptr LxwFormat_ -> IO () + +foreign import ccall "format_set_font_script" + format_set_font_script :: Ptr LxwFormat_ -> Word8 -> IO () + +foreign import ccall "format_set_num_format_index" + format_set_num_format_index :: Ptr LxwFormat_ -> Word8 -> IO () + +foreign import ccall "format_set_align" + format_set_align :: Ptr LxwFormat_ -> Word8 -> IO () + +foreign import ccall "format_set_text_wrap" + format_set_text_wrap :: Ptr LxwFormat_ -> IO () + +foreign import ccall "format_set_rotation" + format_set_rotation :: Ptr LxwFormat_ -> Int16 -> IO () + +foreign import ccall "format_set_shrink" + format_set_shrink :: Ptr LxwFormat_ -> IO () + +foreign import ccall "format_set_pattern" + format_set_pattern :: Ptr LxwFormat_ -> Word8 -> IO () + +foreign import ccall "format_set_bg_color" + format_set_bg_color :: Ptr LxwFormat_ -> Int32 -> IO () + +foreign import ccall "format_set_fg_color" + format_set_fg_color :: Ptr LxwFormat_ -> Int32 -> IO () + +foreign import ccall "format_set_border" + format_set_border :: Ptr LxwFormat_ -> Word8 -> IO () + +foreign import ccall "format_set_bottom" + format_set_bottom :: Ptr LxwFormat_ -> Word8 -> IO () + +foreign import ccall "format_set_top" + format_set_top :: Ptr LxwFormat_ -> Word8 -> IO () + +foreign import ccall "format_set_left" + format_set_left :: Ptr LxwFormat_ -> Word8 -> IO () + +foreign import ccall "format_set_right" + format_set_right :: Ptr LxwFormat_ -> Word8 -> IO () + +foreign import ccall "format_set_border_color" + format_set_border_color :: Ptr LxwFormat_ -> Int32 -> IO () + +foreign import ccall "format_set_bottom_color" + format_set_bottom_color :: Ptr LxwFormat_ -> Int32 -> IO () + +foreign import ccall "format_set_top_color" + format_set_top_color :: Ptr LxwFormat_ -> Int32 -> IO () + +foreign import ccall "format_set_left_color" + format_set_left_color :: Ptr LxwFormat_ -> Int32 -> IO () + +foreign import ccall "format_set_right_color" + format_set_right_color :: Ptr LxwFormat_ -> Int32 -> IO () diff --git a/src/HExcel/HExcelInternal.hs b/src/HExcel/HExcelInternal.hs new file mode 100644 --- /dev/null +++ b/src/HExcel/HExcelInternal.hs @@ -0,0 +1,604 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE RecordWildCards #-} + +-- | +-- Module : HExcel.HExcelInternal +-- Maintainer : Sasha Bogicevic +-- 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" + } diff --git a/src/HExcel/Types.hs b/src/HExcel/Types.hs new file mode 100644 --- /dev/null +++ b/src/HExcel/Types.hs @@ -0,0 +1,292 @@ +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- Module : HExcel.Types +-- Maintainer : Sasha Bogicevic +-- Stability : experimental +-- +-- HExcel types are defined here +module HExcel.Types where + +import Data.Time +import Data.Word +import Foreign +import Foreign.C.String +import Foreign.C.Types +import Lens.Micro.TH + +-- | Excel Row +type Row = Word32 +-- | Excel Column +type Col = Word16 + +-- | Pointer to Excel Workbook +data LxwWorkbook_ +-- | Excel Workbook +newtype Workbook = Workbook (Ptr LxwWorkbook_) + +data LxwWorksheet_ +-- | Excel WorkSheet +newtype Worksheet = Worksheet (Ptr LxwWorksheet_) + +-- | Pointer to Excel Format +data LxwFormat_ +-- | Excel Format +newtype Format = Format { unFormat :: Ptr LxwFormat_ } + +-- | 'HExcelState' is the state we thread trough for the writeCell function of the +-- HExcel typeclass. We are trying to create a convenient api for writing cell values +-- without too much hassle. +data HExcelState = + HExcelState + { _hexcelStateFormat :: Maybe Format + -- ^ define a formatting to be used on all cells + , _hexcelStateSheet :: Worksheet + -- ^ define a worksheet to write to + , _hexcelStateRowCeiling :: Word32 + -- ^ max row size + , _hexcelStateInitRow :: Row + -- ^ first row to write to + , _hexcelStateInitCol :: Col + -- ^ first column to write to + , _hexcelStateRow :: Row + -- ^ current row + , _hexcelStateCol :: Col + -- ^ current column + } + +makeLenses ''HExcelState + +-- | Excel WorkBook Options +newtype WorkbookOptions = + WorkbookOptions { workbookOptionsConstantMem :: Bool } + +instance Storable WorkbookOptions where + sizeOf _ = sizeOf (undefined :: Word8) + alignment _ = alignment (undefined :: Int) + peek ptr = do + cm <- peekByteOff ptr 0 :: IO Word8 + return (WorkbookOptions (cm /= 1)) + poke ptr opts = do + let cm | workbookOptionsConstantMem opts = 1 + | otherwise = 0 + pokeByteOff ptr 0 (cm :: Word8) + +-- | Colors +data Color + = ColorBlack + | ColorBlue + | ColorBrown + | ColorCyan + | ColorGray + | ColorGreen + | ColorLime + | ColorMagenta + | ColorNavy + | ColorOrange + | ColorPink + | ColorPurple + | ColorRed + | ColorSilver + | ColorWhite + | ColorYellow + | Color Word8 Word8 Word8 + +-- | Underline styles +data UnderlineStyle + = UnderlineNone + | UnderlineSingle + | UnderlineDouble + | UnderlineSingleAccounting + | UnderlineDoubleAccounting + deriving (Eq, Enum, Read, Show) + +-- | Script styles +data ScriptStyle + = SuperScript + | SubScript + deriving (Eq, Enum, Read, Show) + +-- | Alignment styles +data Align + = AlignNone + | AlignLeft + | AlignCenter + | AlignRight + | AlignFill + | AlignJustify + | AlignCenterAcross + | AlignDistributed + deriving (Eq, Enum, Read, Show) + +-- | Vertical align styles +data VerticalAlign + = VerticalAlignNone + | VerticalAlignTop + | VerticalAlignBottom + | VerticalAlignCenter + | VerticalAlignJustify + | VerticalAlignDistributed + deriving (Eq, Enum, Read, Show) + +-- | Pattern styles +data Pattern + = PatternNone + | PatternSolid + | PatternMediumGray + | PatternDarkGray + | PatternLightGray + | PatternDarkHorizontal + | PatternDarkVertical + | PatternDarkDown + | PatternDarkUp + | PatternDarkGrid + | PatternDarkTrellis + | PatternLightHorizontal + | PatternLightVertical + | PatternLightDown + | PatternLightUp + | PatternLightGrid + | PatternLightTrellis + | PatternGray125 + | PatternGray0625 + deriving (Eq, Enum, Read, Show) + +-- | Border options +data Border + = BorderAll + | BorderBottom + | BorderTop + | BorderLeft + | BorderRight + deriving (Eq, Read, Show) + +-- | Border styles +data BorderStyle + = BorderNone + | BorderThin + | BorderMedium + | BorderDashed + | BorderDotted + | BorderThick + | BorderDouble + | BorderHair + | BorderMediumDashed + | BorderDashDot + | BorderMediumDashDot + | BorderDashDotDot + | BorderMediumDashDotDot + | BorderSlantDashDot + deriving (Eq, Enum, Read, Show) + +-- | Excel document properties +data DocProperties = + DocProperties { docPropertiesTitle :: String + , docPropertiesSubject :: String + , docPropertiesAuthor :: String + , docPropertiesManager :: String + , docPropertiesCompany :: String + , docPropertiesCategory :: String + , docPropertiesKeywords :: String + , docPropertiesComments :: String + , docPropertiesStatus :: String + , docPropertiesHyperlinkBase :: String + , docPropertiesCreated :: UTCTime {-CTime-} + } + +data DocProperties' = + DocProperties' { docPropsTitle :: CString + , docPropsSubject :: CString + , docPropsAuthor :: CString + , docPropsManager :: CString + , docPropsCompany :: CString + , docPropsCategory :: CString + , docPropsKeywords :: CString + , docPropsComments :: CString + , docPropsStatus :: CString + , docPropsHyperlinkBase :: CString + , docPropsCreated :: CTime + } + +instance Storable DocProperties' where + sizeOf _ = 10 * sizeOf (undefined :: CString) + + sizeOf (undefined :: CTime) + alignment _ = alignment (undefined :: CString) + peek = error "No implementation of 'peek' for 'DocProperties'" + poke ptr props = do + let n = sizeOf (undefined :: CString) + pokeByteOff ptr (0 * n) (docPropsTitle props) + pokeByteOff ptr (1 * n) (docPropsSubject props) + pokeByteOff ptr (2 * n) (docPropsAuthor props) + pokeByteOff ptr (3 * n) (docPropsManager props) + pokeByteOff ptr (4 * n) (docPropsCompany props) + pokeByteOff ptr (5 * n) (docPropsCategory props) + pokeByteOff ptr (6 * n) (docPropsKeywords props) + pokeByteOff ptr (7 * n) (docPropsComments props) + pokeByteOff ptr (8 * n) (docPropsStatus props) + pokeByteOff ptr (9 * n) (docPropsHyperlinkBase props) + pokeByteOff ptr (10 * n) (docPropsCreated props) + +-- | Type to hold datetime values +data DateTime = + DateTime { dtYear :: CInt + , dtMonth :: CInt + , dtDay :: CInt + , dtHour :: CInt + , dtMinute :: CInt + , dtSecond :: CDouble + } + deriving (Show) + +instance Storable DateTime where + sizeOf _ = 5 * sizeOf (undefined :: Int) + + sizeOf (undefined :: Double) + alignment _ = alignment (undefined :: Int) + peek ptr = do + let ptr' = castPtr ptr + DateTime <$> peekElemOff ptr' 0 + <*> peekElemOff ptr' 1 + <*> peekElemOff ptr' 2 + <*> peekElemOff ptr' 3 + <*> peekElemOff ptr' 4 + <*> peekElemOff ptr' 5 + poke ptr (DateTime y m d h mi s) = do + pokeByteOff ptr 0 y + pokeByteOff ptr 4 m + pokeByteOff ptr 8 d + pokeByteOff ptr 12 h + pokeByteOff ptr 16 mi + pokeByteOff ptr 20 s + +-- | Type to hold image options +data ImageOptions = + ImageOptions { imageOffsetX :: Int32 + , imageOffsetY :: Int32 + , imageScaleX :: Double + , imageScaleY :: Double + } + +instance Storable ImageOptions where + sizeOf _ = 2 * sizeOf (undefined :: Int32) + + 2 * sizeOf (undefined :: Double) + alignment _ = alignment (undefined :: Int32) + peek ptr = + ImageOptions <$> peekByteOff ptr 0 + <*> peekByteOff ptr 4 + <*> peekByteOff ptr 8 + <*> peekByteOff ptr 16 + poke ptr (ImageOptions ox oy sx sy) = do + pokeByteOff ptr 0 ox + pokeByteOff ptr 4 oy + pokeByteOff ptr 8 sx + pokeByteOff ptr 16 sy + +-- | Paper size +data PaperSize + = DefaultPaper + | LetterPaper + | A3Paper + | A4Paper + | A5Paper + | OtherPaper Word8 + deriving (Eq) diff --git a/stack.yaml b/stack.yaml new file mode 100644 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,4 @@ +resolver: lts-13.26 + +packages: +- .