packages feed

SpreadsheetML (empty) → 0.1

raw patch · 6 files changed

+454/−0 lines, 6 filesdep +basedep +xmlsetup-changed

Dependencies added: base, xml

Files

+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ SpreadsheetML.cabal view
@@ -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
+ src/Text/XML/SpreadsheetML/Builder.hs view
@@ -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)
+ src/Text/XML/SpreadsheetML/Types.hs view
@@ -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)+
+ src/Text/XML/SpreadsheetML/Writer.hs view
@@ -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 = "<?xml version='1.0' ?>\n" +++                     "<?mso-application progid=\"Excel.Sheet\"?>\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+