Sunday, March 20, 2022

Haskell xlsx を使ってエクセルデータの読み書きパート3

今回は xlsx モジュールを使って、エクセルデータを書き出します。前回までにエクセルデータの読み取りと Computer 型への変換まで行ったので、今回はその結果をエクセルデータとして書き出します。

Computers

エクセルデータとして書き出すサンプルコードがここにあります。

書き出しのための準備

app/Main.hs にいくつか関数を追加します。

書き出し用の Xlsx の値をつくる関数:

createXlsx :: Worksheet -> SheetName -> Xlsx
createXlsx sheet sheetName =  def & atSheet sheetName ?~ sheet

指定のセルに CellValue をセットする関数:

addCellValue :: Worksheet -> CellValue -> RowAndCol -> Worksheet
addCellValue sheet cellValue rowAndCol = ((cellValueAt rowAndCol) ?~ cellValue) sheet

行番号を指定して複数の CellValue を指定の行をつくる関数:

addCellValues :: Worksheet -> [CellValue] -> RowIndex -> Worksheet
addCellValues sheet cellValues rowIndex = addCellValues' sheet pairs
  where
    pairs :: [(CellValue, RowAndCol)]
    pairs = (zip cellValues (map (\colIndex -> (rowIndex,colIndex)) $ take (length cellValues) [1..]))
    addCellValues' :: Worksheet -> [(CellValue, RowAndCol)] -> Worksheet
    addCellValues' sheet' xs 
      | (length xs)==0 = sheet'
      | otherwise      = addCellValues' newSheet (tail xs)
        where newSheet = addCellValue sheet' (fst $ head xs) (snd $ head xs)

CellValue リストの代わりに Computer を適用して行をつくる関数:

addComputer :: Worksheet -> Computer -> RowIndex -> Worksheet
addComputer sheet c rowIndex = addCellValues sheet cellValues rowIndex
  where
    cellValues = [(toName c),(toOS c),(toPrice c)]
    toName  (Computer v _ _) = maybe (CellText "") id v
    toOS    (Computer _ v _) = maybe (CellText "") id v
    toPrice (Computer _ _ v) = maybe (CellDouble 0) id v

addComputer 関数を使って複数の Computer から複数の行をつくる関数:

addComputers :: Worksheet -> [Computer] -> RowIndex -> Worksheet
addComputers sheet cs rowIndex
  | (length cs)==0 = sheet
  | otherwise      = addComputers sheet' (tail cs) (rowIndex+1)
    where
      sheet' = addComputer sheet (head cs) rowIndex

そして、これらのコードを作動させるためにインポート記述を修正:

import Control.Lens
import Codec.Xlsx hiding (toRows)
--import Codec.Xlsx (toXlsx, CellValue, CellValue(CellText,CellDouble))

また、 SheetName, RowAndCol, RowIndex は src/Lib.hs に記述している型シノニムです。まだモジュールからこれらをエクスポートしていないので、エクスポートします。

module Lib (toRows, toRowCount, Row, SheetName, RowAndCol, RowIndex) where

あとは main 関数でこれらの関数を駆使してエクセルデータを作成しエクスポートします。

main = do
  bs <- L.readFile "computers.xlsx"
  ct <- getPOSIXTime
  let
    xlsx      = toXlsx bs
    sheetName = "Sheet1"
    rowCount   = toRowCount xlsx sheetName
    bodyRowIndexes = take (rowCount-1) [2..]
    bodyRows       = toRows xlsx sheetName bodyRowIndexes
    computers      = map (\row -> toComputer row) $ toRows xlsx sheetName bodyRowIndexes
    macOSComputers = findMacOSComputers computers
    newSheetM = (Just def)
      >>= (\sheet -> Just $ addCellValues sheet [(CellText "name"),(CellText "os"),(CellText "price")] 1)
      >>= (\sheet -> Just $ addComputers sheet macOSComputers 2)
  L.writeFile "result.xlsx" $ fromXlsx ct (createXlsx (maybe def id newSheetM) "Computers")

最後に getPOSIXTime に対処します。

app/Main.hs に import Data.Time.Clock.POSIX をインポートすることと、 package.yml の dependencies に time を追記します。

以上で全部です。

実行してみましょう。

$ stack run

うまく実行されれば、プロジェクトディレクトリに result.xlsx が生成されています。

まとめ

まとめとして、完成したコードを掲載します。

app/Main.hs:

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Lib
import Control.Lens
import Codec.Xlsx hiding (toRows)
import Data.Time.Clock.POSIX
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T

type Name  = Maybe CellValue
type OS    = Maybe CellValue
type Price = Maybe CellValue

data Computer = Computer Name OS Price

instance Show Computer where
  show c = foldl1 (\a b -> a ++ "/" ++ b) [(toName c), (toOS c), (toPrice c)]
    where
      toValue :: CellValue -> String
      toValue (CellText v)   = T.unpack v
      toValue (CellDouble v) = show v
      toName  (Computer v _ _) = toValue $ maybe (CellText "") id v
      toOS    (Computer _ v _) = toValue $ maybe (CellText "") id v
      toPrice (Computer _ _ v) = toValue $ maybe (CellDouble 0) id v

toComputer :: Row -> Computer
toComputer row = Computer (row !! 0) (row !! 1) (row !! 2)

findComputersByOS :: OS -> [Computer] -> [Computer]
findComputersByOS os computers = filter (\c -> (toOS c)==os) computers
  where toOS (Computer _ v _) = v

findMacOSComputers :: [Computer] -> [Computer]
findMacOSComputers = findComputersByOS (Just $ CellText "macOS")


createXlsx :: Worksheet -> SheetName -> Xlsx
createXlsx sheet sheetName =  def & atSheet sheetName ?~ sheet

addCellValue :: Worksheet -> CellValue -> RowAndCol -> Worksheet
addCellValue sheet cellValue rowAndCol = ((cellValueAt rowAndCol) ?~ cellValue) sheet

addCellValues :: Worksheet -> [CellValue] -> RowIndex -> Worksheet
addCellValues sheet cellValues rowIndex = addCellValues' sheet pairs
  where
    pairs :: [(CellValue, RowAndCol)]
    pairs = (zip cellValues (map (\colIndex -> (rowIndex,colIndex)) $ take (length cellValues) [1..]))
    addCellValues' :: Worksheet -> [(CellValue, RowAndCol)] -> Worksheet
    addCellValues' sheet' xs 
      | (length xs)==0 = sheet'
      | otherwise      = addCellValues' newSheet (tail xs)
        where newSheet = addCellValue sheet' (fst $ head xs) (snd $ head xs)

addComputer :: Worksheet -> Computer -> RowIndex -> Worksheet
addComputer sheet c rowIndex = addCellValues sheet cellValues rowIndex
  where
    cellValues = [(toName c),(toOS c),(toPrice c)]
    toName  (Computer v _ _) = maybe (CellText "") id v
    toOS    (Computer _ v _) = maybe (CellText "") id v
    toPrice (Computer _ _ v) = maybe (CellDouble 0) id v

addComputers :: Worksheet -> [Computer] -> RowIndex -> Worksheet
addComputers sheet cs rowIndex
  | (length cs)==0 = sheet
  | otherwise      = addComputers sheet' (tail cs) (rowIndex+1)
    where
      sheet' = addComputer sheet (head cs) rowIndex


main :: IO ()
main = do
  bs <- L.readFile "computers.xlsx"
  ct <- getPOSIXTime
  let
    xlsx      = toXlsx bs
    sheetName = "Sheet1"
    rowCount   = toRowCount xlsx sheetName
    bodyRowIndexes = take (rowCount-1) [2..]
    bodyRows       = toRows xlsx sheetName bodyRowIndexes
    computers      = map (\row -> toComputer row) $ toRows xlsx sheetName bodyRowIndexes
    macOSComputers = findMacOSComputers computers
    newSheetM = (Just def)
      >>= (\sheet -> Just $ addCellValues sheet [(CellText "name"),(CellText "os"),(CellText "price")] 1)
      >>= (\sheet -> Just $ addComputers sheet macOSComputers 2)
  L.writeFile "result.xlsx" $ fromXlsx ct (createXlsx (maybe def id newSheetM) "Computers")

src/Lib.hs:

{-# LANGUAGE OverloadedStrings #-}
module Lib (toRows, toRowCount, Row, SheetName, RowAndCol, RowIndex) where

import Codec.Xlsx (toXlsx, Xlsx, CellValue, ixSheet, ixCell, cellValue)
import Control.Lens
import qualified Data.Text as T

type SheetName = T.Text
type RowAndCol = (Int,Int)

toMaybeCellValue :: Xlsx -> SheetName -> RowAndCol -> Maybe CellValue
toMaybeCellValue xlsx sheetName rowAndCol = xlsx ^? ixSheet sheetName . ixCell rowAndCol . cellValue . _Just

type Row = [Maybe CellValue]
type RowIndex = Int
type ColCount = Int

toRow :: Xlsx -> SheetName -> RowIndex -> ColCount -> Row
toRow xlsx sheetName rowIndex colCount = map (\rowAndCol -> toMaybeCellValue xlsx sheetName rowAndCol) rowAndCols
 where rowAndCols = map (\colIndex -> (rowIndex,colIndex)) $ take colCount [1..]

toRows :: Xlsx -> SheetName -> [RowIndex] -> [Row]
toRows xlsx sheetName rowIndexs = map (\rowIndex -> toRowXlsxSheetName rowIndex (toColCount xlsx sheetName)) rowIndexs
  where toRowXlsxSheetName = toRow xlsx sheetName

toRowCount' :: Xlsx -> SheetName -> Int -> Int
toRowCount' xlsx sheetName rowIndex
  | isNothing = rowIndex-1
  | otherwise = toRowCount' xlsx sheetName (rowIndex+1)
  where isNothing = (toMaybeCellValue xlsx sheetName (rowIndex, 1)) == Nothing

toRowCount :: Xlsx -> SheetName -> Int
toRowCount xlsx sheetName = toRowCount' xlsx sheetName 1

toColCount' :: Xlsx -> SheetName -> Int -> Int
toColCount' xlsx sheetName colIndex
  | isNothing = colIndex-1
  | otherwise = toColCount' xlsx sheetName (colIndex+1)
  where isNothing = (toMaybeCellValue xlsx sheetName (1, colIndex)) == Nothing

toColCount :: Xlsx -> SheetName -> Int
toColCount xlsx sheetName = toColCount' xlsx sheetName 1

package.yml の dependencies は最終的に次のようになりました。

dependencies:
- base >= 4.7 && < 5
- xlsx
- bytestring
- lens
- containers
- text
- time

以上です。

一応、エクセルデータの読み書きはできたのですが、なかなか大変。もちろん、もっと簡潔に記述する方法があるのでしょうけれども。これだけの処理をするのであれば、当然エクセル上でやった方がかなり話がはやい。

Haskell xlsx を使ってエクセルデータの読み書き パート3

書き出しのための準備

まとめ

Haskell xlsx を使ってエクセルデータの読み書きパート3