Tuesday, March 29, 2022

Haskell / コーヒーメニューの価格改訂リストの作成エクセルデータからの読み書き対応（読み取り編）

新旧二つのコーヒーメニューアイテムリストデータを元に価格改訂データを作成する。今度は入力データをエクセルデータにして、結果をエクセルデータとして書き出します。

Old and New Items

プロジェクト作成

$ mkdir coffee-price-xlsx
$ cd coffee-price-xlsx

package.yml の dependencies に追記:

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

エクセルデータの準備

プロジェクトディレクトリ直下に:

を準備しておきます。

行と列数の取得

まずは、Input/oldItems.xlsx を読み込みます。試しに、行x列数を取得する。

コードの内容はこのエントリーを参照。

app/Main.hs :

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Codec.Xlsx
import Control.Lens
import qualified Data.ByteString.Lazy as L
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

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

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

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

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

main :: IO ()
main = do
  bs <- L.readFile "Input/oldItems.xlsx"
  let sheetName = "Sheet1"
      xlsx = toXlsx bs
      colCount = toColCount xlsx sheetName
      rowCount = toRowCount xlsx sheetName
  print (rowCount, colCount)

実行すると oldItems.xlsx の行と列が出力されます。

toCellValue 関数

次に、Key, BodyRow という型を定義。

type BodyRowIndex = Int

data Key =
  Key CellValue
  deriving (Show, Eq, Ord)

data BodyRow =
  BodyRow (Map.Map Key (Maybe CellValue))
  deriving (Show)

toCellValue 関数で Key と BodyRow を適用すると Maybe CellValue になるようにします。

toCellValue :: Key -> BodyRow -> Maybe CellValue

toCellValue 関数の実装:

toKeys :: Xlsx -> SheetName -> [Key]
toKeys xlsx sheetName = map (\cv -> Key cv) (toHeaders xlsx sheetName)

toHeaders :: Xlsx -> SheetName -> [CellValue]
toHeaders xlsx sheetName =
  map (\mcv -> maybe (CellText "unknown") id mcv) (toHeaders' xlsx sheetName)

toHeaders' :: Xlsx -> SheetName -> [Maybe CellValue]
toHeaders' xlsx sheetName =
  map
    (\colIndex -> toMaybeCellValue xlsx sheetName (1, colIndex))
    (take colCount [1 ..])
  where
    colCount = toColCount xlsx sheetName

toBodyRow :: Xlsx -> SheetName -> BodyRowIndex -> BodyRow
toBodyRow xlsx sheetName bodyRowIndex =
  BodyRow (Map.fromList $ zip keys maybeCellValues)
  where
    colCount = toColCount xlsx sheetName
    keys = toKeys xlsx sheetName
    maybeCellValues =
      map
        (\colIndex ->
           toMaybeCellValue xlsx sheetName ((bodyRowIndex + 1), colIndex))
        (take colCount [1 ..])

toBodyRows :: Xlsx -> SheetName -> [BodyRow]
toBodyRows xlsx sheetName =
  map
    (\bodyRowIndex -> toBodyRow xlsx sheetName bodyRowIndex)
    (take (rowCount - 1) [1 ..])
  where
    rowCount = toRowCount xlsx sheetName

toCellValue :: Key -> BodyRow -> Maybe CellValue
toCellValue key bodyRow = maybe Nothing id maybeMaybeCellValue
  where
    maybeMaybeCellValue = Map.lookup key bodyRowMap
    bodyRowMap = toBodyRowMap bodyRow
    toBodyRowMap (BodyRow v) = v

toCellValue 関数の使用例:

nameKey :: Key
nameKey = Key (CellText "name")

priceKey :: Key
priceKey = Key (CellText "price")


main :: IO ()
main = do
  bs <- L.readFile "Input/oldItems.xlsx"
  let sheetName = "Sheet1"
      xlsx = toXlsx bs
      bodyRow1 = toBodyRow xlsx sheetName 1 -- body 行の１行目を取得
  print $ (show nameKey) ++ ": " ++ show (toCellValue nameKey bodyRow1)
  print $ (show priceKey)++ ": " ++ show (toCellValue priceKey bodyRow1)

stack run して実行すると以下のように oldItems.xlsx の一行目のセルの値が取得できました。

"Key (CellText \"name\"): Just (CellText \"Caffe Americano\")"
"Key (CellText \"price\"): Just (CellDouble 400.0)"

モジュールにする

ここまで、コードを app/Main.sh に書いてきました。これらをモジュールに移します。

src/Lib.hs :

{-# LANGUAGE OverloadedStrings #-}

module Lib
  ( Key
  , BodyRow
  , toCellValue
  , toBodyRows
  , nameKey
  , priceKey
  ) where

import Codec.Xlsx
import Control.Lens
import qualified Data.ByteString.Lazy as L
import qualified Data.Map as Map
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

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

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

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

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

type BodyRowIndex = Int

data Key =
  Key CellValue
  deriving (Show, Eq, Ord)

data BodyRow =
  BodyRow (Map.Map Key (Maybe CellValue))
  deriving (Show)

toKeys :: Xlsx -> SheetName -> [Key]
toKeys xlsx sheetName = map (\cv -> Key cv) (toHeaders xlsx sheetName)

toHeaders :: Xlsx -> SheetName -> [CellValue]
toHeaders xlsx sheetName =
  map (\mcv -> maybe (CellText "unknown") id mcv) (toHeaders' xlsx sheetName)

toHeaders' :: Xlsx -> SheetName -> [Maybe CellValue]
toHeaders' xlsx sheetName =
  map
    (\colIndex -> toMaybeCellValue xlsx sheetName (1, colIndex))
    (take colCount [1 ..])
  where
    colCount = toColCount xlsx sheetName

toBodyRow :: Xlsx -> SheetName -> BodyRowIndex -> BodyRow
toBodyRow xlsx sheetName bodyRowIndex =
  BodyRow (Map.fromList $ zip keys maybeCellValues)
  where
    colCount = toColCount xlsx sheetName
    keys = toKeys xlsx sheetName
    maybeCellValues =
      map
        (\colIndex ->
           toMaybeCellValue xlsx sheetName ((bodyRowIndex + 1), colIndex))
        (take colCount [1 ..])

toBodyRows :: Xlsx -> SheetName -> [BodyRow]
toBodyRows xlsx sheetName =
  map
    (\bodyRowIndex -> toBodyRow xlsx sheetName bodyRowIndex)
    (take (rowCount - 1) [1 ..])
  where
    rowCount = toRowCount xlsx sheetName

toCellValue :: Key -> BodyRow -> Maybe CellValue
toCellValue key bodyRow = maybe Nothing id maybeMaybeCellValue
  where
    maybeMaybeCellValue = Map.lookup key bodyRowMap
    bodyRowMap = toBodyRowMap bodyRow
    toBodyRowMap (BodyRow v) = v

nameKey :: Key
nameKey = Key (CellText "name")

priceKey :: Key
priceKey = Key (CellText "price")

メインのコード

こまごまとした処理をモジュールに移しました。今度は app/Main.hs を修正します。

不要なコード（モジュールに移したコード）を削除して、body 行をすべて出力するように修正しました。

app/Main.hs :

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Lib
import Codec.Xlsx (toXlsx)
import Control.Monad (forM)
import qualified Data.ByteString.Lazy as L

outputRow :: BodyRow -> IO ()
outputRow bodyRow =
  print $
  show (toCellValue nameKey bodyRow) ++
  "|" ++ show (toCellValue priceKey bodyRow)

main :: IO ()
main = do
  bs <- L.readFile "Input/oldItems.xlsx"
  let sheetName = "Sheet1"
      xlsx = toXlsx bs
      bodyRows = toBodyRows xlsx sheetName
      rowCount = toRowCount xlsx sheetName
  forM bodyRows (\bodyRow -> (return bodyRow) >>= outputRow)
  return ()

forM という関数便利ですね。詳しくは、すごいH本の P172 を参照。

実行してみます。

"Just (CellText \"Caffe Americano\")|Just (CellDouble 400.0)"
"Just (CellText \"Pike Place Roast\")|Just (CellDouble 450.0)"
"Just (CellText \"Caffe Misto\")|Just (CellDouble 500.0)"

うまくいきました。oldItems.xlsx の body 行が出力されています。

newItems.xlsx でも意図通り作動するか確かめます。

  bs <- L.readFile "Input/newItems.xlsx"

処理対象のファイルを newItems.xlsx にして実行します。

"Just (CellText \"Caffe Americano\")|Just (CellDouble 420.0)"
"Just (CellText \"Pike Place Roast\")|Just (CellDouble 480.0)"
"Just (CellText \"Caffe Misto\")|Just (CellDouble 580.0)"
"Just (CellText \"Cappuccino\")|Just (CellDouble 600.0)"

うまく読み取ることができました。

この内容をマージして（新旧価格を比較したリストにする）それをエクセルに書き出す処理は後編に続きます。

Liked some of this entry? Buy me a coffee, please.

Haskell / コーヒーメニューの価格改訂リストの作成 エクセルデータからの読み書き対応（読み取り編）