Happy new year everyone!
In today’s Programming Praxis exercise we have to implement the Unix utility cal, which prints calendars. Let’s get started.
First we need a bunch of imports:
import Data.List import Data.List.Split import qualified Data.Text as T import Data.Time import System.Environment import System.Locale
Let’s start by determining which days are in a given month.
days :: Integer -> Int -> [Day] days y m = map (fromGregorian y m) [1..gregorianMonthLength y m]
We’re going to need to do a bunch of date formatting, and since the required locale is fairly long we make a quick helper function.
fmt :: FormatTime t => String -> t -> String fmt = formatTime defaultTimeLocale
On to the real meat of the application: the function that creates the calendar for the given year and month. Basically, just build the header, start printing the day numbers at the correct weekday by prepending some spaces, and also put some blank spaces at the end so that each month is 6 rows high. This is needed so that when we start printing months next to each other everything stays in the correct place.
monthCal :: Integer -> Int -> String monthCal y m = unlines $ (T.unpack . (T.center 20 ' ') . T.pack . fmt "%B %Y" $ fromGregorian y m 1) : "Su Mo Tu We Th Fr Sa" : (map unwords . take 6 . chunk 7 $ replicate (read . fmt "%w" . head $ days y m) " " ++ map (fmt "%e") (days y m) ++ repeat " ")
Showing multiple months next to each other requires some string manipulation.
showCal :: [String] -> IO () showCal = putStrLn . unlines . map (unlines . map (intercalate " ") . transpose . map lines) . chunk 3
Finally, we need a function to determine which months to show when the -3 argument is used.
surround :: UTCTime -> [String] surround d = map ((\(y, m, _) -> monthCal y m) . toGregorian . (`addGregorianMonthsRollOver` utctDay d)) [-1..1]
All that’s left to do is to check the arguments and show the appropriate calendar.
main :: IO () main = do args <- getArgs now <- getCurrentTime let (curYear, curMonth) = read $ fmt "(%Y,%m)" now case args of [y,m] -> showCal [monthCal (read y) (read m)] ["-3"] -> showCal $ surround now [y] -> showCal $ map (monthCal $ read y) [1..12]  -> showCal [monthCal curYear curMonth] _ -> error "Invalid parameters"