Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Publications from the PURE RSS, and news stored in a YAML file #21

Merged
merged 2 commits into from
Oct 24, 2023
Merged
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
[ new ] Generate recent publications from PURE, and news from a yaml …
…file
fredrikNordvallForsberg committed Oct 21, 2023
commit ab7c83babdeec48cf22c9bdd498d6fae6668f120
3 changes: 3 additions & 0 deletions .github/workflows/generate-website.yml
Original file line number Diff line number Diff line change
@@ -59,6 +59,9 @@ jobs:
- name: Generate 101
run: Generate101

- name: Generate News
run: GenerateNews

- name: Generate website
run: Generate

2 changes: 1 addition & 1 deletion Generate.hs
Original file line number Diff line number Diff line change
@@ -126,7 +126,7 @@ substitute template env = loop template []
let varNm = reverse varAcc in
case lookup varNm env of
Nothing -> loop cs acc
Just val -> loop cs (reverse val ++ acc)
Just val -> loop cs (reverse (substitute val env) ++ acc)
getVar (c:cs) varAcc acc = getVar cs (c:varAcc) acc

-- | Check the input string to determine if it starts with a header of
151 changes: 151 additions & 0 deletions GenerateNews.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,151 @@
{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
module Main where

import Prelude hiding (div)
import GHC.Generics
import Data.Yaml

import Data.List
import Data.Maybe
import Data.Function

-- import Data.ByteString.Lazy (ByteString)
-- import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString as BS
import Data.Text (Text)
import qualified Data.Text as T

import Control.Applicative

import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Network.HTTP.Types.Status

import Data.Time
import Data.Time.Format

import Text.Feed.Types
import Text.Feed.Import
import Text.Feed.Query

import Html

------------------------------------------------------------------------------
-- number of days to cut off old news
oldCutoff :: Integer
oldCutoff = 365 * 5
------------------------------------------------------------------------------


data NewsDate
= OneDate Day
| DateRange Day Day
deriving (Show, Eq)

startDate :: NewsDate -> Day
startDate (OneDate d) = d
startDate (DateRange s e) = s

newsDateToHTML :: NewsDate -> HTML
newsDateToHTML (OneDate day) = formatTime defaultTimeLocale "%e %B %Y" day
newsDateToHTML (DateRange start end) =
let (sy, sm, sd) = toGregorian start
(ey, em, ed) = toGregorian end
wholeMonths = sd == 1 && ed == gregorianMonthLength ey em
in case (sy == ey, sm == em, sd == ed, wholeMonths) of
(True, True, True, _) -> newsDateToHTML (OneDate start)
(True, True, False, True) -> fmt "%B %Y" end
(True, True, False, False) -> fmt "%e" start ++ dash ++ fmt "%e %B %Y" end
(True, False, False, True) -> fmt "%B" start ++ dash ++ fmt "%B %Y" end
(True, False, False, False) -> fmt "%e %B" start ++ dash ++ fmt "%e %B %Y" end
(_, _, _, True) -> fmt "%B %Y" start ++ dash ++ fmt "%B %Y" end
_ -> fmt "%e %B %Y" start ++ dash ++ fmt "%e %B %Y" end
where fmt = formatTime defaultTimeLocale
dash = " – "

instance Ord NewsDate where
compare = compare `on` startDate

data News = News
{ date :: NewsDate
, desc :: String
}
deriving (Show, Eq)

instance FromJSON News where
parseJSON = withObject "News" $ \ v -> do
desc <- v .: "description"
date <- single v <|> range v
pure (News date desc)
where
single v = do
date <- v .: "date" >>= parseTimeM True defaultTimeLocale "%e %B %Y"
pure (OneDate date)
range v = do
start <- v .: "start" >>= parseTimeM True defaultTimeLocale "%e %B %Y"
end <- v .: "end" >>= parseTimeM True defaultTimeLocale "%e %B %Y"
pure (DateRange start end)


newsToHTML :: News -> HTML
newsToHTML n = ddt (newsDateToHTML (date n), desc n)

generateNews :: FilePath -> IO (HTML -- current news
, [(Year, HTML)] -- old news, grouped by year
)
generateNews file = do
now <- getCurrentTime
f <- BS.readFile file
case decodeEither' f of
Left err ->
error (show err)
Right news -> do
let (old, new) = partition (\ x -> date x < OneDate (addDays (-oldCutoff) (utctDay now))) news
let oldGrouped = groupBy (\ a b -> startYear a == startYear b) old
pure (dlist new, map (\ x -> (startYear (head x), dlist x)) oldGrouped)
where
startYear x = let (y,_,_) = toGregorian (startDate (date x)) in y
dlist [] = ""
dlist x = tag "dl" (unlines (map newsToHTML x))

------------------------------------------------------------------------------
pubsRSS :: Request
pubsRSS = parseRequest_ "https://pureportal.strath.ac.uk/en/organisations/mathematically-structured-programming/publications/?format=rss"

getPureRSS :: Int -- number of entries
-> IO [Item]
getPureRSS n = do
manager <- newManager tlsManagerSettings
res <- httpLbs pubsRSS manager
case statusIsSuccessful (responseStatus res) of
False -> pure []
True -> do
case parseFeedSource (responseBody res) of
Nothing -> pure []
Just feed -> pure $ take n $ reverse $ sortOn (getItemPublishDate :: Item -> Maybe (Maybe UTCTime)) (feedItems feed)


itemToHTML :: Item -> Maybe HTML
itemToHTML i = do
-- title <- T.unpack <$> getItemTitle i
-- link <- T.unpack <$> getItemLink i
-- title and link are included in the description
desc <- T.unpack <$> getItemDescription i
pure desc

main :: IO ()
main = do

rss <- getPureRSS 5
let header = "### default.html(section.news=current,headtags=<link rel='stylesheet' href='{{rootPath}}css/pure.css' type='text/css'/>)\n<!-- DO NOT EDIT THIS FILE DIRECTLY — EDIT _news.yaml AND RUN GenerateNews.hs INSTEAD -->"
let items = catMaybes $ map itemToHTML rss
let pubs = if (null items) then "" else
div "recent-pubs" $
(h2 "Recent MSP publications") ++
(ulist items) ++
p ("See the " ++ (anchor "https://pureportal.strath.ac.uk/en/organisations/mathematically-structured-programming" "MSP PURE page") ++ " for a full list of recent papers, grants, etc.")
(newNews, oldNews) <- generateNews "_news.yaml"
let news = h2 "News" ++ newNews ++ if null oldNews then "" else h3 "Older News" ++ p ("See here for " ++ anchor "old-news.html" "older news" ++ ".")
let oldPage = h2 "Older news" ++ concatMap (\ (y, ds) -> h3 (show y) ++ ds) oldNews
writeFile "news.html" (header ++ pubs ++ news)
if null oldNews then pure () else writeFile "old-news.html" (header ++ oldPage)
20 changes: 18 additions & 2 deletions Html.hs
Original file line number Diff line number Diff line change
@@ -2,19 +2,35 @@ module Html where

type HTML = String

tag :: String -> HTML -> HTML
tag t content = "<" ++ t ++ ">" ++ content ++ "</" ++ t ++ ">"

div :: String -> HTML -> HTML
div klass content =
"<div class=\"" ++ klass ++ "\">" ++ content ++ "</div>"

hn :: Int -> HTML -> HTML
hn n = tag ("h" ++ show n)

h5 :: HTML -> HTML
h5 content = "<h5>" ++ content ++ "</h5>"
h5 = hn 5

h3 :: HTML -> HTML
h3 = hn 3

h2 :: HTML -> HTML
h2 = hn 2

p :: HTML -> HTML
p content = "<p>" ++ content ++ "</p>"
p = tag "p"

ulist :: [HTML] -> HTML
ulist items = "<ul>" ++ concatMap (\item -> "<li>" ++ item ++ "</li>") items ++ "</ul>"


ddt :: (HTML, HTML) -> HTML
ddt (term, desc) = "<dt>" ++ term ++ "</dt><dd>" ++ desc ++ "</dd>"

anchor :: String -> HTML -> HTML
anchor url content = "<a href=\"" ++ url ++ "\">" ++ content ++ "</a>"

14 changes: 14 additions & 0 deletions MSPweb.cabal
Original file line number Diff line number Diff line change
@@ -39,3 +39,17 @@ executable GeneratePeople
yaml,
bytestring
default-language: Haskell2010

executable GenerateNews
main-is: GenerateNews.hs
other-modules: Html
build-depends: base,
yaml,
bytestring,
http-client,
http-client-tls,
http-types,
time,
feed,
text
default-language: Haskell2010
2 changes: 2 additions & 0 deletions Makefile
Original file line number Diff line number Diff line change
@@ -32,13 +32,15 @@ default: local

local:
runghc Generate101.hs
runghc GenerateNews.hs
runghc Generate.hs

compile:
cabal build --builddir _dist

local-compiled:
`cabal list-bin --builddir _dist Generate101`
`cabal list-bin --builddir _dist GenerateNews`
`cabal list-bin --builddir _dist Generate`


735 changes: 735 additions & 0 deletions _news.yaml

Large diffs are not rendered by default.

2 changes: 1 addition & 1 deletion _templates/default.html
Original file line number Diff line number Diff line change
@@ -8,7 +8,7 @@
<link rel="icon" sizes="192x192" type="image/png" href="apple-touch-icon.png">
<meta name="viewport" content="width=device-width, initial-scale=1.0">

{{Headtags}}
{{headtags}}
</head>

<body>
34 changes: 34 additions & 0 deletions css/pure.css
Original file line number Diff line number Diff line change
@@ -0,0 +1,34 @@
:root {
--light-purple: #f1ebf9;
}


.recent-pubs h3.title {
border-bottom: none;
font-size: 100%;
margin-bottom: 1px;
}

.recent-pubs p {
margin-top: 1px;
}

.recent-pubs p.type {
font-size: 80%;
}

/* We get some empty links from the RSS for some reason; make them not look like links */
.recent-pubs a.link[href="#"] {
text-decoration: none;
cursor: default;
}


div.recent-pubs {
border-radius: 0.7em;
background: var(--light-purple);
padding: 1em;
padding-top: 0.1em;
margin-bottom: 1em;
min-width: 190px;
}
161 changes: 0 additions & 161 deletions news.html

This file was deleted.

762 changes: 0 additions & 762 deletions old-news.html

This file was deleted.