new look

1 files changed, 35 insertions, 24 deletions

diff --git a/src/Lib.hs b/src/Lib.hs
index fff2d6c..65d5c08 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -558,10 +558,20 @@ instance ToHtml HomeView where
         homeBody
             where
                 homeBody = div_ $ do
+                    p_ $ toHtmlRaw $ T.pack
+                        "The passerine sorcerer, Roseacrucis, aims to destroy the connections between\
+                        \ the Library’s lines of poetry. If he is not stopped, each line will face\
+                        \ a lifetime adrift at sea, by itself and without any context."
+                    p_ $ toHtmlRaw $ T.pack "Your task is to strengthen the network of invisible edges between each line\
+                    \ of poetry. Traditionally, each line only connects to one predecessor and one\
+                    \ successor, but circumstances require us to create additional edges, possibly backwards\
+                    \ or even in cycles."
+                    p_ $ toHtmlRaw $ T.pack "Luckily, you are not alone. Other Librarians are also hard at work building\
+                    \ the collaborative graph of poetry we call the <em>Spectral Renga</em>.\
+                    \ Will we succeed? Can we maximize the\
+                    \ min-cut and minimize the max-flow? Or will Roseacrucis prevail, leaving us\
+                    \ bereft of such joys as enjambment, caesura, and rhyme? There&rsquo;s only one way to find out."
                     p_ $ do
-                        strong_ [class_ "title"] "Spectral Renga"
-                        span_ " is a collaborative graph of poetry."
-                    p_ $ em_ $ do
                         a_ [href_ (domainURI (DomainName "piazza"))] "Join the public piazza"
                         span_ ", or "
                         a_ [href_ newDomainURI] "create a private subgraph"
@@ -580,19 +590,19 @@ instance ToHtml DomainView where
         domainBody
         where
             domainBody = do
-                div_ [class_ "row"] $ do
+                div_ $ do
                     p_ $ do
                         span_ (toHtmlRaw (T.pack "Welcome to "))
-                        strong_ [class_ "domain-name"] (toHtml domainName)
+                        span_ [class_ "domain-name"] (toHtml domainName)
                         span_ $ toHtml $ ". This subgraph contains " <> show numNodes <> " nodes and " <> show numEdges <> " edges."
                     p_ $ em_ $ do
                         a_ [href_ (domainReadURI domainName Nothing)] "Read a poem"
                         span_ ", "
                         a_ [href_ (domainWriteURI domainName Nothing Nothing Nothing)] "write a line"
-                        span_ ", "
+                        span_ ", or "
                         a_ [href_ (domainWalkURI domainName Nothing)] "walk the graph"
                         span_ "."
-                when showControls $ div_ [class_ "row manage-box"] $ do
+                when showControls $ div_ [class_ "manage-box"] $ do
                     form_ [action_ (domainClearURI domainName), method_ "post", class_ "manage-form"] $
                         button_ [type_ "submit", class_ "manage-btn"] "Clear"
                     form_ [action_ (domainResetURI domainName), method_ "post", class_ "manage-form"] $
@@ -614,33 +624,33 @@ instance ToHtml DomainReadView where
         [domainCrumb domainName, domainActionsCrumb domainName Read]
         (case verse of
            Nothing -> initialWritePrompt domainName
-           Just (Verse lines') -> ul_ [class_ "verse"] $ mapM_ (li_ . toHtml . DomainedLine domainName) lines')
+           Just (Verse lines') -> div_ [class_ "verse-container"] $ ul_ [class_ "verse"] $ mapM_ (li_ . toHtml . DomainedLine domainName) lines')
     toHtmlRaw = toHtml
 
 instance ToHtml DomainWriteView where
     toHtml (DomainWriteView domainName msrc mdst (Color color)) = pageTemplate
         (Just domainName)
         [domainCrumb domainName, domainActionsCrumb domainName Write]
-        (div_ [class_ "row"] $ form_ [action_ (domainWriteSubmitURI domainName), method_ "post"] $ do
+        (div_ $ form_ [action_ (domainWriteSubmitURI domainName), method_ "post"] $ do
             case msrc of
-              Just src@(Line (LineIden lineIdenInt) _ _) -> div_ $ do
+              Just src@(Line (LineIden lineIdenInt) _ _) -> p_ $ do
                   label_ [] "previous line: "
                   span_ $ toHtml (DomainedLine domainName src)
                   input_ [type_ "text", name_ "src", value_ (T.pack $ show lineIdenInt), hidden_ "1"]
               Nothing -> div_ ""
-            div_ $ do
+            p_ $ do
                 label_ [for_ "txt", class_ "focus"] "your line: "
                 input_ [type_ "text", name_ "txt", id_ "txt", value_ "", maxlength_ "120", required_ "1"]
-            div_ $ do
+            p_ $ do
                 label_ [for_ "color", class_ "focus"] "your color: "
                 input_ [type_ "color", name_ "color", id_ "color", value_ ("#" <> color)]
             case mdst of
-              Just dst@(Line (LineIden lineIdenInt) _ _) -> div_ $ do
+              Just dst@(Line (LineIden lineIdenInt) _ _) -> p_ $ do
                   input_ [type_ "text", name_ "dst", value_ (T.pack $ show lineIdenInt), hidden_ "1"]
                   label_ [] "next line: "
                   span_ $ toHtml (DomainedLine domainName dst)
               Nothing -> div_ ""
-            div_ $
+            p_ $
                 input_ [type_ "submit", value_ "Submit"]
             )
     toHtmlRaw = toHtml
@@ -651,18 +661,18 @@ instance ToHtml DomainWalkView where
         [domainCrumb domainName, domainActionsCrumb domainName Walk]
         (case info of
             Nothing -> initialWritePrompt domainName
-            Just (line@(Line lineIden _ _), prevs, nexts) -> div_ [class_ "row"] $ do
-                div_ [class_ "neighbors"] $ do
+            Just (line@(Line lineIden _ _), prevs, nexts) -> div_ $ do
+                div_ [class_ "verse-container"] $ do
                     small_ $ do
                         em_ $ toHtmlRaw (T.pack "predecessors &middot; ")
                         em_ $ a_ [href_ (domainWriteURI domainName Nothing (Just lineIden) Nothing)] "write"
                     case prevs of
                       [] -> p_ "Nothing here yet."
                       _ -> ul_ [class_ "verse"] $ mapM_ (li_ . toHtml . DomainedLine domainName) prevs
-                div_ [class_ "neighbors"] $ do
+                div_ [class_ "verse-container"] $ do
                     small_ $ em_ "node"
-                    p_ $ strong_ $ toHtml (DomainedLine domainName line)
-                div_ [class_ "neighbors"] $ do
+                    div_ $ strong_ $ toHtml (DomainedLine domainName line)
+                div_ [class_ "verse-container"] $ do
                     small_ $ do
                         em_ $ toHtmlRaw (T.pack "successors &middot; ")
                         em_ $ a_ [href_ (domainWriteURI domainName (Just lineIden) Nothing Nothing)] "write"
@@ -704,17 +714,18 @@ pageTemplate domainName crumbs body = doctypehtml_ $ do
         meta_ [charset_ "utf-8"]
         meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1.0"]
         link_ [rel_ "shortcut icon", type_ "image/x-icon", href_ "/spectral-renga/static/favicon.ico"]
-        link_ [rel_ "stylesheet", type_ "text/css", href_ "/spectral-renga/static/style.css"]
+        link_ [rel_ "stylesheet", type_ "text/css", href_ "/cyfraeviolae/static/styles.css"]
+        link_ [rel_ "stylesheet", type_ "text/css", href_ "/spectral-renga/static/styles.css"]
     body_ $ div_ [class_ "container"] $ do
-        div_ [class_ "row navbar"] $
+        div_ $
             sequence_ $
             intersperse (span_ [class_ "sep"] (toHtmlRaw (T.pack " | "))) (crumb:crumbs)
         body
     where
-        crumb = span_ $ do
-            a_ [href_ homeURI, class_ "title"] (strong_ "Spectral Renga")
+        crumb = span_ [class_ "home"] $ do
+            a_ [href_ homeURI, class_ "title"] "Spectral Renga"
             span_ "@"
-            a_ [href_ "https://cyfraeviolae.org"] "cyfraeviolae.org"
+            a_ [href_ "https://cyfraeviolae.org", class_ "home-link"] "cyfraeviolae.org"
         titleDomain = case domainName of
                         Nothing -> ""
                         Just (DomainName domainNameStr) -> " - " <> domainNameStr