Initial data commit

Task/Calendar/Haskell/calendar.hs

@@ -0,0 +1,90 @@
+import qualified Data.Text as T
+import Data.Time
+import Data.Time.Calendar
+import Data.Time.Calendar.WeekDate
+import Data.List.Split (chunksOf)
+import Data.List
+
+data Day = Su | Mo | Tu | We | Th | Fr | Sa
+           deriving (Show, Eq, Ord, Enum)
+
+data Month = January | February | March
+           | April   | May      | June
+           | July    | August   | September
+           | October | November | December
+             deriving (Show, Eq, Ord, Enum)
+
+monthToInt :: Month -> Int
+monthToInt = (+ 1) . fromEnum
+
+dayFromDate :: Integer -> Month -> Int -> Int
+dayFromDate year month day = day' `mod` 7
+    where (_, _, day') = toWeekDate $ fromGregorian year (monthToInt month) day
+
+nSpaces :: Int -> T.Text
+nSpaces n = T.replicate n (T.pack " ")
+
+space :: T.Text
+space = nSpaces 1
+
+calMarginWidth = 3
+
+calMargin :: T.Text
+calMargin = nSpaces calMarginWidth
+
+calWidth = 20
+
+listMonth :: Integer -> Month -> [T.Text]
+listMonth year month = [monthHeader, weekHeader] ++ weeks'
+    where
+      monthHeader = (T.center calWidth ' ') . T.pack $ show month
+
+      weekHeader = (T.intercalate space) $ map (T.pack . show) [(Su)..]
+
+      monthLength = toInteger $
+                    gregorianMonthLength year $
+                    monthToInt month
+
+      firstDay = dayFromDate year month 1
+
+      days = replicate firstDay (nSpaces 2) ++
+             map ((T.justifyRight 2 ' ') . T.pack . show) [1..monthLength]
+
+      weeks = map (T.justifyLeft calWidth ' ') $
+              map (T.intercalate space) $
+              chunksOf 7 days
+
+      weeks' = weeks ++ replicate (6 - length weeks) (nSpaces calWidth)
+
+listCalendar :: Integer -> Int -> [[[T.Text]]]
+listCalendar year calColumns = (chunksOf calColumns) . (map (listMonth year)) $
+                               enumFrom January
+
+calColFromCol :: Int -> Int
+calColFromCol columns = c + if r >= calWidth then 1 else 0
+    where (c, r) = columns `divMod` (calWidth + calMarginWidth)
+
+colFromCalCol :: Int -> Int
+colFromCalCol calCol = calCol * calWidth + ((calCol - 1) * calMarginWidth)
+
+center :: Int -> String -> String
+center i a = T.unpack . (T.center i ' ') $ T.pack a
+
+printCal :: [[[T.Text]]] -> IO ()
+printCal = mapM_ f where
+  f c = mapM_ (putStrLn . T.unpack) rows
+    where rows = map (T.intercalate calMargin) $ transpose c
+
+printCalendar :: Integer -> Int -> IO ()
+printCalendar year columns =
+    if columns < 20
+    then putStrLn $ "Cannot print less than 20 columns"
+    else do
+      putStrLn $ center columns' "[Maybe Snoopy]"
+      putStrLn $ center columns' $ show year
+      putStrLn ""
+      printCal $ listCalendar year calcol'
+    where
+      calcol' = calColFromCol columns
+
+      columns' = colFromCalCol calcol'