xlsx-tabular (empty) → 0.1.0.0
raw patch · 8 files changed
+415/−0 lines, 8 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, containers, data-default, lens, text, xlsx, xlsx-tabular
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- src/Codec/Xlsx/Util/Tabular.hs +184/−0
- src/Codec/Xlsx/Util/Tabular/Imports.hs +52/−0
- src/Codec/Xlsx/Util/Tabular/Json.hs +43/−0
- src/Codec/Xlsx/Util/Tabular/Types.hs +59/−0
- test/Spec.hs +2/−0
- xlsx-tabular.cabal +43/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Kazuo Koga (c) 2016++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 Kazuo Koga 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
+ src/Codec/Xlsx/Util/Tabular.hs view
@@ -0,0 +1,184 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+-- | Convinience utility to read Xlsx tabular cells.+module Codec.Xlsx.Util.Tabular+ (+ -- * Types+ Tabular+ , TabularHead+ , TabularRow+ -- * Lenses+ -- ** Tabular+ , tabularHeads+ , tabularRows+ -- ** TabularHead+ , tabularHeadIx+ , tabularHeadLabel+ -- ** TabularRow+ , tabularRowIx+ , tabularRowCells+ -- * Methods+ , def+ -- * Functions+ , toTableRowsFromFile+ , toTableRows+ , toTableRows'+ ) where++import Codec.Xlsx.Util.Tabular.Imports+import qualified Data.ByteString.Lazy as ByteString++type Rows =+ [(Int, Cols)]++type Cols =+ [(Int, Cell)]++type RowValues =+ [(Int, [(Int, Maybe CellValue)])]+++-- |Read from Xlsx file as tabular rows+toTableRowsFromFile :: Int -- ^ Starting row index (header row)+ -> String -- ^ File name+ -> IO (Maybe Tabular)+toTableRowsFromFile offset fname = do+ s <- ByteString.readFile fname+ let xlsx = toXlsx s+ rows = toTableRows' xlsx offset+ pure rows++-- |Decode cells as tabular rows.+toTableRows :: Xlsx -- ^ Xlsx Workbook+ -> Text -- ^ Worksheet name to decode+ -> Int -- ^ Starting row index (header row)+ -> Maybe Tabular+toTableRows xlsx sheetName offset =+ decodeRows <$> styles <*> Just offset <*> rows+ where+ styles = parseStyleSheet (xlsx ^. xlStyles) ^? _Right+ rows =+ xlsx+ ^? ixSheet sheetName+ . wsCells+ . to toRows++-- |Decode cells as tabular rows from first sheet.+toTableRows' :: Xlsx -- ^ Xlsx Workbook+ -> Int -- ^ Starting row index (header row)+ -> Maybe Tabular+toTableRows' xlsx offset =+ toTableRows xlsx firstSheetName offset+ where+ firstSheetName =+ xlsx ^. xlSheets+ & keys+ & head++decodeRows ss offset rs =+ def+ & tabularHeads .~ header'+ & tabularRows .~ rows+ where+ rs' = getCells ss offset rs+ header = head rs' ^. _2+ header' =+ header+ & fmap toText+ & join+ toText (i, Just (CellText t)) = [def+ & tabularHeadIx .~ i+ & tabularHeadLabel .~ t]+ toText _ = []+ cix = fmap (view tabularHeadIx) header'+ & fromList+ rows =+ fmap rowValue (tail rs')+ rowValue rvs =+ def+ & tabularRowIx .~ (rvs ^. _1)+ & tabularRowCells .~ (rvs ^. _2 & fmap f & join)+ where+ f (i, cell) =+ [cell | cix ^. contains i]++-- |行から値のあるセルを取り出す+getCells :: StyleSheet -- ^スタイルシート+ -> Int -- ^開始行+ -> Rows -- ^セル行+ -> RowValues+getCells ss i rs =+ startAt ss i rs+ & takeContiguous i+ & takeUntil ss+ & fmap rvs+ & filter vs+ where+ rvs (i, cs) =+ (i, rowValues cs)+ filter =+ Prelude.filter+ vs (i, cs) =+ any (\(_, v) -> isJust v) cs++startAt :: StyleSheet -> Int -> Rows -> Rows+startAt ss i rs =+ dropWhile f rs+ where+ f (x, _) =+ x < i++-- |指定の行から連続している行を取り出す+takeContiguous :: Int -> Rows -> Rows+takeContiguous i rs =+ [r | (x, r@(y, _)) <- zip [i..] rs, x == y]++-- |有効セルのすべてに枠線（Bottom側）が存在しなくなる+-- |すなわち枠囲みの欄外になるまでの行を取り出す+takeUntil :: StyleSheet -> Rows -> Rows+takeUntil ss rs =+ takeWhile f rs+ where+ f (i, cs) =+ or $ rowBordersHas borderBottom ss cs++rowBordersHas v ss cs =+ x+ where+ x =+ fmap f cs+ f (i, cell) =+ cellHasBorder ss cell v++rowValues cs =+ x+ where+ x =+ fmap f cs+ f (i, cell) =+ (i, cell ^. cellValue)++cellHasBorder ss cell v =+ fromMaybe False mb+ where+ b = cellBorder ss cell+ mb = borderStyleHasLine v <$> b++cellBorder :: StyleSheet -> Cell -> Maybe Border+cellBorder ss cell =+ view cellStyle cell+ >>= pure . xf+ >>= view cellXfBorderId+ >>= pure . bd+ where+ xf n = (ss ^. styleSheetCellXfs) !! n+ bd n = (ss ^. styleSheetBorders) !! n++borderStyleHasLine v b =+ fromMaybe False value+ where+ value =+ view v b+ >>= view borderStyleLine+ >>= pure . (/= LineStyleNone)
+ src/Codec/Xlsx/Util/Tabular/Imports.hs view
@@ -0,0 +1,52 @@+-- |Internal imports.+module Codec.Xlsx.Util.Tabular.Imports+ ( module X+ , join+ , find+ , fromMaybe+ , isJust+ , keys+ , (<$>), (<*>)+ , view+ , to+ , contains+ , (^.), (^?), (.~), (?~), (&), _1, _2, _Right+ , Text+ , IntSet+ , IntSet.fromList+ , FromJSON, parseJSON+ , ToJSON, toJSON+ , Value(Object), object+ , (.=), (.:)+ , deriveJSON+ , defaultOptions+ , fieldLabelModifier+ , constructorTagModifier+ )+ where++import Codec.Xlsx as X+import Codec.Xlsx.Formatted as X+import Codec.Xlsx.Util.Tabular.Types as X+import Control.Applicative ((<$>), (<*>))+import Control.Lens ( (^.), (^?), (.~), (?~), (&)+ , _1, _2, _Right+ , view, to, contains+ )+import Control.Monad (join)+import Data.List (find)+import Data.Map (keys)+import Data.Maybe (fromMaybe, isJust)+import Data.Text (Text)+import Data.IntSet (IntSet)+import qualified Data.IntSet as IntSet+import Data.Aeson ( FromJSON, parseJSON+ , ToJSON, toJSON+ , Value(Object), object+ , (.=), (.:)+ )+import Data.Aeson.TH ( deriveJSON+ , defaultOptions+ , fieldLabelModifier+ , constructorTagModifier+ )
+ src/Codec/Xlsx/Util/Tabular/Json.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+-- | JSON supports of Tabular.+module Codec.Xlsx.Util.Tabular.Json+ ( parseJSON+ , toJSON+ ) where++import Codec.Xlsx.Util.Tabular.Imports+import Data.Char (toLower)+++instance ToJSON RichTextRun where+ toJSON r =+ object [ "text" .= view richTextRunText r ]++instance FromJSON RichTextRun where+ parseJSON (Object v) =+ RichTextRun <$> pure Nothing <*> (v .: "text")+++deriveJSON defaultOptions+ { fieldLabelModifier = drop 5+ , constructorTagModifier = map toLower . drop 4+ } ''CellValue+++deriveJSON defaultOptions+ { fieldLabelModifier = map toLower . drop 11+ , constructorTagModifier = map toLower+ } ''TabularRow+++deriveJSON defaultOptions+ { fieldLabelModifier = map toLower . drop 12+ , constructorTagModifier = map toLower+ } ''TabularHead+++deriveJSON defaultOptions+ { fieldLabelModifier = map toLower . drop 8+ , constructorTagModifier = map toLower+ } ''Tabular
+ src/Codec/Xlsx/Util/Tabular/Types.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Codec.Xlsx.Util.Tabular.Types+ ( Tabular+ , tabularHeads+ , tabularRows+ , TabularHead+ , tabularHeadIx+ , tabularHeadLabel+ , TabularRow+ , tabularRowIx+ , tabularRowCells+ , def+ ) where++import Codec.Xlsx (CellValue)+import Control.Lens (makeLenses)+import Data.Default (Default, def)+import Data.Text (Text)+++-- | Tabular cells+data Tabular = Tabular+ { _tabularHeads :: [TabularHead]+ , _tabularRows :: [TabularRow]+ }+ deriving (Show)++-- | Tabular header+data TabularHead = TabularHead+ { _tabularHeadIx :: Int -- ^ Column index+ , _tabularHeadLabel :: Text -- ^ Column label+ }+ deriving (Show)++-- | Tabular row+data TabularRow = TabularRow+ { _tabularRowIx :: Int -- ^ Row index+ , _tabularRowCells :: [Maybe CellValue] -- ^ Row values+ }+ deriving (Show)+++makeLenses ''Tabular+makeLenses ''TabularHead+makeLenses ''TabularRow+++instance Default Tabular where+ def = Tabular [] []+++instance Default TabularRow where+ def = TabularRow 0 []+++instance Default TabularHead where+ def = TabularHead 0 ""
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"
+ xlsx-tabular.cabal view
@@ -0,0 +1,43 @@+name: xlsx-tabular+version: 0.1.0.0+synopsis: Xlsx table decode utility+description: Please see README.md+homepage: http://github.com/kkazuo/xlsx-tabular#readme+license: BSD3+license-file: LICENSE+author: Kazuo Koga+maintainer: obiwanko@me.com+copyright: (c) 2016 Kazuo Koga+category: Codec+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Codec.Xlsx.Util.Tabular+ , Codec.Xlsx.Util.Tabular.Types+ , Codec.Xlsx.Util.Tabular.Imports+ , Codec.Xlsx.Util.Tabular.Json+ build-depends: base >= 4.7 && < 5+ , aeson+ , bytestring+ , containers+ , data-default+ , lens+ , text+ , xlsx+ default-language: Haskell2010++test-suite xlsx-tabular-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , xlsx-tabular+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/kkazuo/xlsx-tabular