diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2012, Galois, Inc + +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 Jason Dagit 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/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/SpreadsheetML.cabal b/SpreadsheetML.cabal new file mode 100644 --- /dev/null +++ b/SpreadsheetML.cabal @@ -0,0 +1,40 @@ +Name: SpreadsheetML +Version: 0.1 +Synopsis: Write support for Excel's SpreadsheetML format +Description: Output XML in the SpreadsheetML namespace. This allows you + to generate XLS file for excel. Binary compressed Office Open Document format + not yet supported, but you can take this xml output and name it ".xls" and + Excel will be able to open the document as a spreadsheet. +License: BSD3 +License-file: LICENSE +Author: Jason Dagit +Maintainer: dagitj@gmail.com +Copyright: Galois, Inc. + +Category: Text + +Build-type: Simple + +Cabal-version: >=1.8 + + +Library + -- Modules exported by the library. + hs-source-dirs: src + Exposed-modules: Text.XML.SpreadsheetML.Types + Text.XML.SpreadsheetML.Writer + Text.XML.SpreadsheetML.Builder + + -- Packages needed in order to build this package. + Build-depends: base > 3 && < 5, + xml >= 1.3 && < 1.4 + + -- Modules not exported by this package. + -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. + -- Build-tools: + +source-repository head + type: git + location: https://github.com/dagit/SpreadsheetML diff --git a/src/Text/XML/SpreadsheetML/Builder.hs b/src/Text/XML/SpreadsheetML/Builder.hs new file mode 100644 --- /dev/null +++ b/src/Text/XML/SpreadsheetML/Builder.hs @@ -0,0 +1,59 @@ +module Text.XML.SpreadsheetML.Builder where + +import Text.XML.SpreadsheetML.Types + +-- | Construct empty values +emptyWorkbook :: Workbook +emptyWorkbook = Workbook Nothing [] + +emptyDocumentProperties :: DocumentProperties +emptyDocumentProperties = + DocumentProperties Nothing Nothing Nothing Nothing Nothing Nothing Nothing + +emptyWorksheet :: Name -> Worksheet +emptyWorksheet name = Worksheet Nothing name + +emptyTable :: Table +emptyTable = + Table [] [] Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing + +emptyColumn :: Column +emptyColumn = + Column Nothing Nothing Nothing Nothing Nothing Nothing + +emptyRow :: Row +emptyRow = Row [] Nothing Nothing Nothing Nothing Nothing Nothing + +emptyCell :: Cell +emptyCell = Cell Nothing Nothing Nothing Nothing Nothing + +-- | Convenience constructors +number :: Double -> Cell +number d = emptyCell { cellData = Just (Number d) } + +string :: String -> Cell +string s = emptyCell { cellData = Just (StringType s) } + +bool :: Bool -> Cell +bool b = emptyCell { cellData = Just (Boolean b) } + +-- | This function may change in future versions, if a real formula type is +-- created. +formula :: String -> Cell +formula f = emptyCell { cellFormula = Just (Formula f) } + +mkWorkbook :: [Worksheet] -> Workbook +mkWorkbook ws = Workbook Nothing ws + +mkWorksheet :: Name -> Table -> Worksheet +mkWorksheet name table = Worksheet (Just table) name + +mkTable :: [Row] -> Table +mkTable rs = emptyTable { tableRows = rs } + +mkRow :: [Cell] -> Row +mkRow cs = emptyRow { rowCells = cs } + +-- | Most of the time this is the easiest way to make a table +tableFromCells :: [[Cell]] -> Table +tableFromCells cs = mkTable (map mkRow cs) diff --git a/src/Text/XML/SpreadsheetML/Types.hs b/src/Text/XML/SpreadsheetML/Types.hs new file mode 100644 --- /dev/null +++ b/src/Text/XML/SpreadsheetML/Types.hs @@ -0,0 +1,102 @@ +module Text.XML.SpreadsheetML.Types where + +{- See http://msdn.microsoft.com/en-us/library/aa140066%28office.10%29.aspx -} + +import Data.Word ( Word64 ) + +-- | Only implement what we need + +data Workbook = Workbook + { workbookDocumentProperties :: Maybe DocumentProperties + , workbookWorksheets :: [Worksheet] + } + deriving (Read, Show) + +data DocumentProperties = DocumentProperties + { documentPropertiesTitle :: Maybe String + , documentPropertiesSubject :: Maybe String + , documentPropertiesKeywords :: Maybe String + , documentPropertiesDescription :: Maybe String + , documentPropertiesRevision :: Maybe Word64 + , documentPropertiesAppName :: Maybe String + , documentPropertiesCreated :: Maybe String -- ^ Actually, this should be a date time + } + deriving (Read, Show) + +data Worksheet = Worksheet + { worksheetTable :: Maybe Table + , worksheetName :: Name + } + deriving (Read, Show) + +data Table = Table + { tableColumns :: [Column] + , tableRows :: [Row] + , tableDefaultColumnWidth :: Maybe Double -- ^ Default is 48 + , tableDefaultRowHeight :: Maybe Double -- ^ Default is 12.75 + , tableExpandedColumnCount :: Maybe Word64 + , tableExpandedRowCount :: Maybe Word64 + , tableLeftCell :: Maybe Word64 -- ^ Default is 1 + , tableTopCell :: Maybe Word64 -- ^ Default is 1 + , tableFullColumns :: Maybe Bool + , tableFullRows :: Maybe Bool + } + deriving (Read, Show) + +data Column = Column + { columnCaption :: Maybe Caption + , columnAutoFitWidth :: Maybe AutoFitWidth + , columnHidden :: Maybe Hidden + , columnIndex :: Maybe Word64 + , columnSpan :: Maybe Word64 + , columnWidth :: Maybe Double + } + deriving (Read, Show) + +data Row = Row + { rowCells :: [Cell] + , rowCaption :: Maybe Caption + , rowAutoFitHeight :: Maybe AutoFitHeight + , rowHeight :: Maybe Double + , rowHidden :: Maybe Hidden + , rowIndex :: Maybe Word64 + , rowSpan :: Maybe Word64 + } + deriving (Read, Show) + +data Cell = Cell + -- elements + { cellData :: Maybe ExcelValue + -- Attributes + , cellFormula :: Maybe Formula + , cellIndex :: Maybe Word64 + , cellMergeAcross :: Maybe Word64 + , cellMergeDown :: Maybe Word64 + } + deriving (Read, Show) + +data ExcelValue = Number Double | Boolean Bool | StringType String + deriving (Read, Show) + +-- | TODO: Currently just a string, but we could model excel formulas and +-- use that type here instead. +newtype Formula = Formula String + deriving (Read, Show) + +data AutoFitWidth = AutoFitWidth | DoNotAutoFitWidth + deriving (Read, Show) + +data AutoFitHeight = AutoFitHeight | DoNotAutoFitHeight + deriving (Read, Show) + +-- | Attribute for hidden things +data Hidden = Shown | Hidden + deriving (Read, Show) + +-- | For now this is just a string, but we could model excel's names +newtype Name = Name String + deriving (Read, Show) + +newtype Caption = Caption String + deriving (Read, Show) + diff --git a/src/Text/XML/SpreadsheetML/Writer.hs b/src/Text/XML/SpreadsheetML/Writer.hs new file mode 100644 --- /dev/null +++ b/src/Text/XML/SpreadsheetML/Writer.hs @@ -0,0 +1,221 @@ +module Text.XML.SpreadsheetML.Writer where + +import qualified Text.XML.SpreadsheetML.Types as T +import qualified Text.XML.Light as L +import qualified Text.XML.Light.Types as LT +import qualified Text.XML.Light.Output as O + +import Control.Applicative ( (<$>) ) +import Data.Maybe ( catMaybes, maybeToList ) + +-------------------------------------------------------------------------- +-- | Convert a workbook to a string. Write this string to a ".xls" file +-- and Excel will know how to open it. +showSpreadsheet :: T.Workbook -> String +showSpreadsheet wb = "\n" ++ + "\n" ++ + O.showElement (toElement wb) + +--------------------------------------------------------------------------- +-- | Namespaces +namespace = L.blank_name { L.qURI = Just "urn:schemas-microsoft-com:office:spreadsheet" } +oNamespace = L.blank_name { L.qURI = Just "urn:schemas-microsoft-com:office:office" + , L.qPrefix = Just "o" } +xNamespace = L.blank_name { L.qURI = Just "urn:schemas-microsoft-com:office:excel" + , L.qPrefix = Just "x" } +ssNamespace = L.blank_name { L.qURI = Just "urn:schemas-microsoft-com:office:spreadsheet" + , L.qPrefix = Just "ss" } +htmlNamespace = L.blank_name { L.qURI = Just "http://www.w3.org/TR/REC-html40" } + +-------------------------------------------------------------------------- +-- | Empty Elements +emptyWorkbook :: LT.Element +emptyWorkbook = L.blank_element + { L.elName = workbookName + , L.elAttribs = [xmlns, xmlns_o, xmlns_x, xmlns_ss, xmlns_html] } + where + workbookName = namespace { L.qName = "Workbook" } + xmlns = mkAttr "xmlns" "urn:schemas-microsoft-com:office:spreadsheet" + xmlns_o = mkAttr "xmlns:o" "urn:schemas-microsoft-com:office:office" + xmlns_x = mkAttr "xmlns:x" "urn:schemas-microsoft-com:office:excel" + xmlns_ss = mkAttr "xmlns:ss" "urn:schemas-microsoft-com:office:spreadsheet" + xmlns_html = mkAttr "xmlns:html" "http://www.w3.org/TR/REC-html40" + mkAttr k v = LT.Attr L.blank_name { L.qName = k } v + +emptyDocumentProperties :: LT.Element +emptyDocumentProperties = L.blank_element { L.elName = documentPropertiesName } + where + documentPropertiesName = oNamespace { L.qName = "DocumentProperties" } + +emptyWorksheet :: T.Name -> LT.Element +emptyWorksheet (T.Name n) = L.blank_element { L.elName = worksheetName + , L.elAttribs = [LT.Attr worksheetNameAttrName n] } + where + worksheetName = ssNamespace { L.qName = "Worksheet" } + worksheetNameAttrName = ssNamespace { L.qName = "Name" } + +emptyTable :: LT.Element +emptyTable = L.blank_element { L.elName = tableName } + where + tableName = ssNamespace { L.qName = "Table" } + +emptyRow :: LT.Element +emptyRow = L.blank_element { L.elName = rowName } + where + rowName = ssNamespace { L.qName = "Row" } + +emptyColumn :: LT.Element +emptyColumn = L.blank_element { L.elName = columnName } + where + columnName = ssNamespace { L.qName = "Column" } + +emptyCell :: LT.Element +emptyCell = L.blank_element { L.elName = cellName } + where + cellName = ssNamespace { L.qName = "Cell" } + +-- | Break from the 'emptyFoo' naming because you can't make +-- an empty data cell, except one holding "" +mkData :: T.ExcelValue -> LT.Element +mkData v = L.blank_element { L.elName = dataName + , L.elContent = [ LT.Text (mkCData v) ] + , L.elAttribs = [ mkAttr v ] } + where + dataName = ssNamespace { L.qName = "Data" } + typeName s = ssNamespace { L.qName = s } + typeAttr = LT.Attr (typeName "Type") + mkAttr (T.Number _) = typeAttr "Number" + mkAttr (T.Boolean _) = typeAttr "Boolean" + mkAttr (T.StringType _) = typeAttr "String" + mkCData (T.Number d) = L.blank_cdata { LT.cdData = show d } + mkCData (T.Boolean b) = L.blank_cdata { LT.cdData = showBoolean b } + mkCData (T.StringType s) = L.blank_cdata { LT.cdData = s } + showBoolean True = "1" + showBoolean False = "0" + +------------------------------------------------------------------------- +-- | XML Conversion Class +class ToElement a where + toElement :: a -> LT.Element + +------------------------------------------------------------------------- +-- | Instances +instance ToElement T.Workbook where + toElement wb = emptyWorkbook + { L.elContent = mbook ++ + map (LT.Elem . toElement) (T.workbookWorksheets wb) } + where + mbook = maybeToList (LT.Elem . toElement <$> T.workbookDocumentProperties wb) + +instance ToElement T.DocumentProperties where + toElement dp = emptyDocumentProperties + { L.elContent = map LT.Elem $ catMaybes + [ toE T.documentPropertiesTitle "Title" id + , toE T.documentPropertiesSubject "Subject" id + , toE T.documentPropertiesKeywords "Keywords" id + , toE T.documentPropertiesDescription "Description" id + , toE T.documentPropertiesRevision "Revision" show + , toE T.documentPropertiesAppName "AppName" id + , toE T.documentPropertiesCreated "Created" id + ] + } + where + toE :: (T.DocumentProperties -> Maybe a) -> String -> (a -> String) -> Maybe L.Element + toE fieldOf name toString = mkCData <$> fieldOf dp + where + mkCData cdata = L.blank_element + { L.elName = oNamespace { L.qName = name } + , L.elContent = [LT.Text (L.blank_cdata { L.cdData = toString cdata })] } + +instance ToElement T.Worksheet where + toElement ws = (emptyWorksheet (T.worksheetName ws)) + { L.elContent = maybeToList (LT.Elem . toElement <$> (T.worksheetTable ws)) } + +instance ToElement T.Table where + toElement t = emptyTable + { L.elContent = map LT.Elem $ + map toElement (T.tableColumns t) ++ + map toElement (T.tableRows t) + , L.elAttribs = catMaybes + [ toA T.tableDefaultColumnWidth "DefaultColumnWidth" show + , toA T.tableDefaultRowHeight "DefaultRowHeight" show + , toA T.tableExpandedColumnCount "ExpandedColumnCount" show + , toA T.tableExpandedRowCount "ExpandedRowCount" show + , toA T.tableLeftCell "LeftCell" show + , toA T.tableFullColumns "FullColumns" showBoolean + , toA T.tableFullRows "FullRows" showBoolean + ] } + where + toA :: (T.Table -> Maybe a) -> String -> (a -> String) -> Maybe L.Attr + toA fieldOf name toString = mkAttr <$> fieldOf t + where + mkAttr value = LT.Attr ssNamespace { L.qName = name } (toString value) + +instance ToElement T.Row where + toElement r = emptyRow + { L.elContent = map LT.Elem $ + map toElement (T.rowCells r) + , L.elAttribs = catMaybes + [ toA T.rowCaption "Caption" showCaption + , toA T.rowAutoFitHeight "AutoFitHeight" showAutoFitHeight + , toA T.rowHeight "Height" show + , toA T.rowHidden "Hidden" showHidden + , toA T.rowIndex "Index" show + , toA T.rowSpan "Span" show + ] } + + where + showAutoFitHeight T.AutoFitHeight = "1" + showAutoFitHeight T.DoNotAutoFitHeight = "0" + toA :: (T.Row -> Maybe a) -> String -> (a -> String) -> Maybe L.Attr + toA fieldOf name toString = mkAttr <$> fieldOf r + where + mkAttr value = LT.Attr ssNamespace { L.qName = name } (toString value) + +showBoolean True = "1" +showBoolean False = "0" + +showCaption :: T.Caption -> String +showCaption (T.Caption s) = s + +showHidden :: T.Hidden -> String +showHidden T.Hidden = "1" +showHidden T.Shown = "0" + +instance ToElement T.Column where + toElement c = emptyColumn + { L.elAttribs = catMaybes + [ toA T.columnCaption "Caption" showCaption + , toA T.columnAutoFitWidth "AutoFitWidth" showAutoFitWidth + , toA T.columnHidden "Hidden" showHidden + , toA T.columnIndex "Index" show + , toA T.columnSpan "Span" show + , toA T.columnWidth "Width" show + ] } + where + showAutoFitWidth T.AutoFitWidth = "1" + showAutoFitWidth T.DoNotAutoFitWidth = "0" + toA :: (T.Column -> Maybe a) -> String -> (a -> String) -> Maybe L.Attr + toA fieldOf name toString = mkAttr <$> fieldOf c + where + mkAttr value = LT.Attr ssNamespace { L.qName = name } (toString value) + +instance ToElement T.Cell where + toElement c = emptyCell + { L.elContent = map (LT.Elem . toElement) (maybeToList (T.cellData c)) + , L.elAttribs = catMaybes + [ toA T.cellFormula "Formula" showFormula + , toA T.cellIndex "Index" show + , toA T.cellMergeAcross "MergeAcross" show + , toA T.cellMergeDown "MergeDown" show + ] } + where + showFormula (T.Formula f) = f + toA :: (T.Cell -> Maybe a) -> String -> (a -> String) -> Maybe L.Attr + toA fieldOf name toString = mkAttr <$> fieldOf c + where + mkAttr value = LT.Attr ssNamespace { L.qName = name } (toString value) + +instance ToElement T.ExcelValue where + toElement ev = mkData ev +