Skip to content

Instantly share code, notes, and snippets.

@jabaraster
Created June 10, 2019 23:31
Show Gist options
  • Save jabaraster/893f7f3847aeecd10dff9fb9b0858e88 to your computer and use it in GitHub Desktop.
Save jabaraster/893f7f3847aeecd10dff9fb9b0858e88 to your computer and use it in GitHub Desktop.
カレンダ整形問題別解
import Data.Time.Calendar
import Data.Time.Format
import Data.Time.LocalTime
import Data.Time.Calendar.WeekDate
{- --------------------
この関数がエントリポイント.
--------------------- -}
main = putStrLn =<< pure . formatToMonthCalendar =<< currentMonth
{- --------------------
今回の本題.
指定月のカレンダを整形する.
--------------------- -}
formatToMonthCalendar :: Month -> String
formatToMonthCalendar month =
let fst = toMonthFirstDay month
pad = concat $ replicate (toWeekDayIndex fst) " "
cal = concatMap (\day -> case toWeekDayIndex day of
6 -> toS day ++ "\n"
otherwise -> toS day ++ " "
) [fst .. toMonthLastDay month]
in unlines [
centering $ formatTime defaultTimeLocale "%B %Y" $ fromGregorian (aYear month) (aMonth month) 1
, weekdayLabel
, pad ++ cal
]
{- "月"を表すデータ型 -}
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"
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 :: 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