Skip to content

Instantly share code, notes, and snippets.

@jabaraster
Last active April 4, 2019 02:28
Show Gist options
  • Save jabaraster/5613069 to your computer and use it in GitHub Desktop.
Save jabaraster/5613069 to your computer and use it in GitHub Desktop.
カレンダー整形問題Haskellの回答に、日本語による解説をコメントとしてではなく動作する関数として加えてみた。個人的に気に入っているのは「を」関数。
module Main where
import Data.List.Split
import Data.Time.Calendar
import Data.Time.Calendar.WeekDate
import Data.Time.Clock
import Data.Time.Format
import Data.Time.LocalTime
import Data.Text (pack, unpack, center)
import System.Locale
主処理 = main
main = 現在日付を取得 >>= 指定日付を表示用に加工 >>= プリントアウト
現在日付を取得 = getZonedTime
プリントアウト = putStrLn
指定日付を表示用に加工 :: ZonedTime -> IO String
指定日付を表示用に加工 任意の日付 = do
日付 <- 任意の日付 `を` 扱いやすい型に変換 -- ZonedTime -> Day
日付リスト <- 日付 `を` 週毎の日付に分割して先頭週の開始曜日までは空文字を詰めたリストに変換 -- Day -> [[String]]
日付行リスト <- 日付リスト `を` 行毎の文字列に連結したリストに変換 -- [[String]] -> [String]
ヘッダ <- 日付 `を` カレンダのヘッダに変換 -- [String] -> [String]
ヘッダ付き行リスト <- ヘッダ `を` (日付行リスト `と連結`) -- [String] -> [String] -> [String]
ヘッダ付き行リスト `を` 改行を挟んで連結して返す -- [String] -> String
を :: a -> (a -> b) -> IO b
を a f = return $ f a
と連結 xs ys = ys ++ xs
改行を挟んで連結して返す = unlines
行毎の文字列に連結したリストに変換 = toLinesFromTokens
toLinesFromTokens :: [[String]] -> [String]
toLinesFromTokens = map (\ss -> drop 1 $ concat $ map padTok ss)
-- 上でdrop 1しているのは
-- 3桁左寄せしてから連結しているため、
-- 各行の先頭に空白文字が1つ入るのが気に入らないため
where
padTok s = case length s of
0 -> " "
1 -> " " ++ s
2 -> " " ++ s
_ -> error "unexpected token -> " ++ s
weekdayCount = 7
lineCharCountMax = weekdayCount * 3 - 1
カレンダのヘッダに変換 = toHeader
toHeader :: Day -> [String]
toHeader day = let s = formatTime defaultTimeLocale "%B %Y" day
fst = unpack $ center lineCharCountMax ' ' $ pack s in
[fst, "Su Mo Tu We Th Fr Sa"]
週毎の日付に分割して先頭週の開始曜日までは空文字を詰めたリストに変換 = toLeftPaddedMonthDayList
toLeftPaddedMonthDayList :: Day -> [[String]]
toLeftPaddedMonthDayList day = chunksOf 7 core
where
core = let fstDate = toMonthFirstDate day in
(toLeftPaddableListFromMonthFirstDate fstDate) ++ (map show $ toMonthDateList day)
扱いやすい型に変換 = toDayFromZonedTime
toDayFromZonedTime :: ZonedTime -> Day
toDayFromZonedTime = utctDay . zonedTimeToUTC
指定日付が所属する月の全ての日付のリスト = toMonthDateList
toMonthDateList :: Day -> [Int]
toMonthDateList day = let (y,m,_) = toGregorian day
c = gregorianMonthLength y m in
[1..c]
指定日付が所属する月の先頭の週の、開始曜日までを埋める空文字のリスト = toLeftPaddableListFromMonthFirstDate
toLeftPaddableListFromMonthFirstDate :: Day -> [String]
toLeftPaddableListFromMonthFirstDate day = take (toWeekdayIndex day) $ repeat ""
指定日付が所属する月の先頭日付 = toMonthFirstDate
toMonthFirstDate :: Day -> Day
toMonthFirstDate day = let (y,m,_) = toGregorian day in
fromGregorian y m 1
日曜日を0としたときの曜日のインデックス = toWeekdayIndex
toWeekdayIndex :: Day -> Int
toWeekdayIndex day = case toWeekDate day of
(_,_,7) -> 0
(_,_,d) -> d
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment