91 lines
2.6 KiB
Haskell
91 lines
2.6 KiB
Haskell
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'
|