{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main where
import Control.Arrow hiding (app)
import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Function
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Tagged
import Data.Text qualified as T
import Data.Time.Calendar
import Data.Time.Clock
import Data.Time.Format.ISO8601
import Data.Time.LocalTime
import Git qualified as G
import Git.Libgit2 qualified as GB
import Network.HTTP.Types
import Network.Wai.Conduit
import Network.Wai.Handler.Warp
import System.Environment
import System.FilePath
import System.IO.Unsafe
import Text.Blaze
import Text.Blaze.Html.Renderer.Utf8
import Text.Cassius
import Text.Hamlet
import Text.Printf
env_REPOSITORIES :: [String]
env_REPOSITORIES =
splitOn ":" (unsafePerformIO (getEnv "REPOSITORIES"))
env_PORT :: Int
env_PORT =
maybe 8080 read (unsafePerformIO (lookupEnv "PORT"))
main :: IO ()
main = do
runSettings
( defaultSettings
-- XXX contrary to documentation, this enables both IPv4 and IPv6
& setHost "!6"
& setPort env_PORT
& setBeforeMainLoop do
printf "listening on %d..\n" env_PORT
)
app
app :: Application
app _ resp = do
resp . responseStream status200 [] $ \write _ -> do
commits <-
reverse . sortOn (.createdAt)
<$> getCommitsConcurrently env_REPOSITORIES
let commitsPerDay =
(map (\xs -> (utctDay . (.createdAt) $ head xs, xs))) $
groupBy ((==) `on` (utctDay . (.createdAt))) commits
write $
renderHtmlBuilder
[shamlet|
feed.nomath.org