From acd9c66c663ea6b0b2fb9dd0a563897c2fae45eb Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Fri, 3 Apr 2026 22:10:56 +0200 Subject: Calendar view --- src/Util.hs | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) (limited to 'src/Util.hs') diff --git a/src/Util.hs b/src/Util.hs index 1e10eec..95cc4ce 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -2,6 +2,8 @@ module Util (module Util, toList) where import Data.Foldable (toList) +import Data.Maybe (fromMaybe) +import Data.Time (Day, toGregorian) import Data.Word (Word8) @@ -32,3 +34,21 @@ pad c w val = uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d uncurry3 f (x, y, z) = f x y z + +dropWhileEnd :: (a -> Bool) -> [a] -> [a] +dropWhileEnd p = fromMaybe [] . go + where + go [] = Nothing + go (x:xs) = + case go xs of + Nothing | p x -> Nothing + | otherwise -> Just [x] + Just xs' -> Just (x : xs') + +ymdToString :: YMD -> String +ymdToString (YMD y m d) = pad '0' 4 y ++ '-' : pad '0' 2 m ++ '-' : pad '0' 2 d + +dayToYMD :: Day -> YMD +dayToYMD day = + let (y, m, d) = toGregorian day + in YMD (fromIntegral y) (fromIntegral m) (fromIntegral d) -- cgit v1.3