diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Index.hs | 5 | ||||
| -rw-r--r-- | src/Main.hs | 60 | ||||
| -rw-r--r-- | src/Pages.hs | 12 |
3 files changed, 63 insertions, 14 deletions
diff --git a/src/Index.hs b/src/Index.hs index ee3cdaf..aaf0a81 100644 --- a/src/Index.hs +++ b/src/Index.hs @@ -18,6 +18,7 @@ module Index ( indexGetEventsDay, indexNumEvents, indexCalendar, + indexFileForDay, ) where import Control.Applicative (empty) @@ -487,6 +488,10 @@ indexGetEventsDay index@(Index _ mp _) chan kind day = do in (firstlast, events') Nothing -> (firstlast, []) -- if the file doesn't exist, there ain't no events +indexFileForDay :: Index -> Channel -> Day -> FilePath +indexFileForDay (Index basedir _ _) (Channel network channel) day = + basedir </> T.unpack network </> T.unpack channel </> toFileName (dayToYMD day) + -- utilities loadDay :: Index -> Channel -> YMD -> IO (Maybe RawEvents) diff --git a/src/Main.hs b/src/Main.hs index 2b1497e..e80391a 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -135,6 +135,33 @@ pageLog conf index req alias = | n < 1000 = T.show n | otherwise = renderLargeNumber (n `div` 1000) <> "," <> T.pack (pad '0' 3 (n `mod` 1000)) +pagePlainLog :: Config -> Index -> Text -> IO Response +pagePlainLog conf index alias = + case econfAlias2Chan conf Map.!? alias of + Nothing -> sendText404 "Channel not found" + Just chan -> do + ((startDay, endDay), counts) <- indexCalendar index chan + sendHtml200 $ + renderPagePlainlog PlainLogData + { network = chanNetwork chan + , channel = chanChannel chan + , alias = alias + , note = Map.lookup alias (confNotes conf) + , entries = + [PlainLogDayData + { exists = count > 0 + , date = T.pack (ymdToString (dayToYMD day)) } + | (day, count) <- zip [startDay .. endDay] counts] } + +pagePlainLogDay :: Config -> Index -> Text -> Text -> IO Response +pagePlainLogDay conf index alias datestr = + case (econfAlias2Chan conf Map.!? alias, parseDatestr datestr) of + (Nothing, _) -> sendText404 "Channel not found" + (_, Nothing) -> sendText404 "Invalid date" + (Just chan, Just day) -> do + let fname = indexFileForDay index chan day + return $ responseFile status200 [("Content-Type", "text/plain")] fname + pageCalendarDay :: Config -> Index -> Request -> Text -> Text -> IO Response pageCalendarDay conf index req alias datestr = case (econfAlias2Chan conf Map.!? alias, parseDatestr datestr) of @@ -188,20 +215,6 @@ pageCalendarDay conf index req alias datestr = , message = msg } | ((time, eid, ev), dayidx) <- zip events [0..] , let (classlist, (nickw1, nick, nickw2), msg) = renderEvent ev] } - where - parseDatestr :: Text -> Maybe Day - parseDatestr t = do -- YYYY-mm-dd - guard (T.length t == 4 + 1 + 2 + 1 + 2) - y <- parseInt (T.take 4 t) - guard (T.index t 4 == '-') - m <- parseInt (T.take 2 (T.drop 5 t)) - guard (T.index t 7 == '-') - d <- parseInt (T.take 2 (T.drop 8 t)) - fromGregorianValid (fromIntegral y) m d - - parseInt :: Text -> Maybe Int - parseInt t | T.all isDigit t = Just (T.foldl' (\n c -> 10 * n + (ord c - ord '0')) 0 t) - | otherwise = Nothing classListAdd :: Maybe Text -> Text -> Text classListAdd Nothing t = t @@ -230,6 +243,21 @@ renderEvent = \case Compressed text -> (j "ev-meta", (no, "", no), text) where no = Nothing; j = Just +parseDatestr :: Text -> Maybe Day +parseDatestr = \t -> do -- YYYY-mm-dd + guard (T.length t == 4 + 1 + 2 + 1 + 2) + y <- parseInt (T.take 4 t) + guard (T.index t 4 == '-') + m <- parseInt (T.take 2 (T.drop 5 t)) + guard (T.index t 7 == '-') + d <- parseInt (T.take 2 (T.drop 8 t)) + fromGregorianValid (fromIntegral y) m d + where + parseInt :: Text -> Maybe Int + parseInt t + | T.all isDigit t = Just (T.foldl' (\n c -> 10 * n + (ord c - ord '0')) 0 t) + | otherwise = Nothing + pageCalendar :: Config -> Index -> Text -> IO Response pageCalendar conf index alias = case econfAlias2Chan conf Map.!? alias of @@ -315,6 +343,10 @@ mainServe confpath = do pageIndex config ["log", TE.decodeUtf8' -> Right alias] -> pageLog config index req alias + ["plainlog", TE.decodeUtf8' -> Right alias] -> + pagePlainLog config index alias + ["plainlog", TE.decodeUtf8' -> Right alias, TE.decodeUtf8' -> Right date] -> + pagePlainLogDay config index alias date ["cal", TE.decodeUtf8' -> Right alias] -> pageCalendar config index alias ["cal", TE.decodeUtf8' -> Right alias, TE.decodeUtf8' -> Right date] -> diff --git a/src/Pages.hs b/src/Pages.hs index 9b65de2..dbbf440 100644 --- a/src/Pages.hs +++ b/src/Pages.hs @@ -69,6 +69,17 @@ data LogData = LogData , events :: [EventData () Text] } +data PlainLogData = PlainLogData + { network :: Text + , channel :: Text + , alias :: Text + , note :: Maybe Text + , entries :: [PlainLogDayData] } + +data PlainLogDayData = PlainLogDayData + { exists :: Bool + , date :: Text } + data CalendarDayData = CalendarDayData { network :: Text , channel :: Text @@ -144,6 +155,7 @@ $(do let dropSuffix suf str = makeRender tpl' dataname concat <$> mapM (uncurry makeDecs) [("log", ''LogData) + ,("plainlog", ''PlainLogData) ,("calendar-day", ''CalendarDayData) ,("index", ''IndexData) ,("calendar", ''CalendarData)]) |