Skip to content

Instantly share code, notes, and snippets.

@jabaraster
Last active June 10, 2019 07:20
Show Gist options
  • Save jabaraster/be81176ad208fb838f034b813c3f3371 to your computer and use it in GitHub Desktop.
Save jabaraster/be81176ad208fb838f034b813c3f3371 to your computer and use it in GitHub Desktop.
カレンダ整形問題:遊びのないHaskell版
import Data.List
import Data.List.Split
import Data.Time.Calendar
import Data.Time.Calendar.WeekDate
import Data.Time.Format
import Data.Time.LocalTime
{- --------------------
この関数がエントリポイント.
--------------------- -}
main = putStrLn =<< pure . formatToMonthCalendar =<< currentMonth
{- --------------------
今回の本題.
指定月のカレンダを整形する.
--------------------- -}
formatToMonthCalendar :: Month -> String
formatToMonthCalendar month =
unlines $ [
centering $ formatTime defaultTimeLocale "%B %Y" $ fromGregorian (aYear month) (aMonth month) 1
, weekdayLabel
] ++ (map (concat . intersperse " " . map toS) $ toWeekDaysArray month)
{- "月"を表すデータ型 -}
data Month =
Month {
aYear :: Integer
, aMonth :: Int
} deriving (Show, Eq, Read)
{- 現在月を取得 -}
currentMonth :: IO Month
currentMonth = pure . toM . localDay . zonedTimeToLocalTime =<< getZonedTime
where
toM :: Day -> Month
toM d = let (y,m,_) = toGregorian d
in Month y m
{- 以降は作業用 -}
weekdayLabel = "Su Mo Tu We Th Fr Sa"
type WeekDays = [Maybe Day]
toWeekDaysArray :: Month -> [WeekDays]
toWeekDaysArray month =
let offset = toWeekDayIndex $ toMonthFirstDay month
allDays = (replicate offset Nothing) ++ (map Just $ toAllMonthDays month)
in chunksOf 7 allDays
toAllMonthDays :: Month -> [Day]
toAllMonthDays month = [toMonthFirstDay month .. toMonthLastDay month]
toMonthFirstDay :: Month -> Day
toMonthFirstDay (Month y m)=
fromGregorian y m 1
toMonthLastDay :: Month -> Day
toMonthLastDay (Month y m) =
fromGregorian y m $ gregorianMonthLength y m
toWeekDayIndex :: Day -> Int
toWeekDayIndex day =
let (_, _, d) = toWeekDate day
in if d == 7
then 0
else d
centering :: String -> String
centering s =
let len = (length weekdayLabel) - length s
charCnt = floor (fromIntegral len / 2)
in replicate charCnt ' ' ++ s
toS :: Maybe Day -> String
toS Nothing = " "
toS (Just day) = toS' day
toS' :: Day -> String
toS' day =
let (_, _, d) = toGregorian day
in if d < 10
then " " ++ (show d)
else show d
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment