diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 12 |
1 files changed, 7 insertions, 5 deletions
diff --git a/src/Main.hs b/src/Main.hs index bb5bdf7..c516c5f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -18,7 +18,7 @@ import Data.Map.Strict qualified as Map import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding qualified as TE -import Data.Text.IO qualified as T +import Data.Text.IO.Utf8 qualified as T import Data.Time (Day, fromGregorianValid) import Network.Wai import Network.HTTP.Types @@ -34,6 +34,7 @@ import Text.Read (readMaybe) -- import Debug.Trace +import AtomicPrint import Calendar import Config import Index @@ -74,7 +75,8 @@ pageLog conf pages index req alias = case econfAlias2Chan conf Map.!? alias of Nothing -> page404 "Channel not found" Just chan -> do - let npages = (indexNumEvents index chan + numPerPage - 1) `div` numPerPage + numEvents <- indexNumEvents index chan + let npages = (numEvents + numPerPage - 1) `div` numPerPage curpage | Just (readMaybe . BS8.unpack -> Just pg) <- query "page" = min npages (max 1 pg) | otherwise = npages ntoleft = min 5 (curpage - 1) @@ -85,7 +87,7 @@ pageLog conf pages index req alias = ["network" ~> chanNetwork chan ,"channel" ~> chanChannel chan ,"alias" ~> alias - ,"totalevents" ~> renderLargeNumber (indexNumEvents index chan) + ,"totalevents" ~> renderLargeNumber numEvents ,"picker" ~> M.object ["prevpage" ~> if curpage > 1 then Just (curpage - 1) else Nothing ,"nextpage" ~> if curpage < npages then Just (curpage + 1) else Nothing @@ -181,7 +183,7 @@ pageCalendar conf pages index alias = case econfAlias2Chan conf Map.!? alias of Nothing -> page404 "Channel not found" Just chan -> do - let ((startDay, endDay), counts) = indexCalendar index chan + ((startDay, endDay), counts) <- indexCalendar index chan return $ sendPage200 pages "calendar" $ M.object ["network" ~> chanNetwork chan ,"channel" ~> chanChannel chan @@ -254,7 +256,7 @@ mainServe confpath = do settings = defaultSettings & setFork checkedFork & setPort (confPort config) - putStrLn $ "Listening on port " ++ show (confPort config) + atomicPrintS $ "Listening on port " ++ show (confPort config) runSettings settings $ \req respond -> case pathInfo req of [] -> respond =<< pageIndex config pages |