From 0e90e4f442b2eb2ae9f57db49b829ab7b967890c Mon Sep 17 00:00:00 2001
From: cyfraeviolae <cyfraeviolae>
Date: Thu, 31 Dec 2020 21:25:14 -0500
Subject: small design fixes

---
 app/Main.hs |  4 ++--
 src/Lib.hs  | 30 +++++++++++++++++++-----------
 2 files changed, 21 insertions(+), 13 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 666dde6..4e6a438 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -7,5 +7,5 @@ main :: IO ()
 main = do
     manifest <- Lib.loadManifest
     case manifest of
-      Left errs      -> print $ prettyTomlDecodeErrors errs
-      Right manifest -> startApp manifest
+      Left errs -> print $ prettyTomlDecodeErrors errs
+      Right m   -> startApp m
diff --git a/src/Lib.hs b/src/Lib.hs
index e3593db..861f6f3 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -85,6 +85,9 @@ data PlayView = GameView [MediumTag] [T.Text] [Period] Level GameState (Work, Wo
               | FinalView [MediumTag] [T.Text] [Period] Level [Work] [Work] Integer
 newtype MediumTag = MediumTag T.Text deriving (Eq, Show, Ord, ToHttpApiData, FromHttpApiData, ToHtml)
 data Period = Ancient | Postclassical | EarlyModern | Modern deriving (Eq, Show, Read, Bounded, Enum)
+renderPeriod :: Period -> T.Text
+renderPeriod EarlyModern = "Early modern"
+renderPeriod x           = tshow x
 data Level = Short | Long deriving (Eq, Show, Read, Bounded, Enum)
 instance ToHttpApiData Period where
     toUrlPiece = tshow
@@ -296,8 +299,9 @@ playURI mediumTags periods level gameState = "/" <> toUrlPiece (safeLink api (Pr
 
 gameCrumbs :: Monad m => [MediumTag] -> [T.Text] -> [Period] -> Level -> [HtmlT m ()]
 gameCrumbs _ labels periods level = [
-    span_ $ toHtml $ T.intercalate ", " labels
-    , span_ $ toHtml $ T.intercalate ", " (fmap tshow periods)
+    span_ $ toHtmlRaw $ T.intercalate " &middot; " labels
+    -- TODO
+    , span_ $ toHtmlRaw $ T.intercalate " &middot; " (renderPeriod <$> periods)
     , span_ $ toHtml . tshow $ level ]
 
 instance ToHtml HomeView where
@@ -367,7 +371,7 @@ feedbackPoor misses = "The Library regrets to inform you that due to the " <> (i
 feedback :: Level -> Integer -> T.Text
 feedback _ 0 = feedbackPerfect 0
 feedback level misses =
-    if (level == Short && misses <= 4) || (level == Long && misses <= 8)
+    if (level == Short && misses <= 2) || (level == Long && misses <= 7)
        then feedbackMiddling misses
        else feedbackPoor misses
 
@@ -378,7 +382,7 @@ showCard Work{name,year,wiki} = do
 
 renderWork :: Monad m => Work -> HtmlT m () -> HtmlT m ()
 renderWork Work{figures} header = div_ [class_ "work"] $ do
-    div_ $ strong_ header
+    div_ header
     div_ [class_ "subwork"] $ mapM_ renderFigure figures
 renderFigure :: Monad m => Figure -> HtmlT m ()
 renderFigure Figure{file,byline} = figure_ $ do
@@ -392,8 +396,8 @@ instance ToHtml PlayView where
             body = do
                 div_ [class_ "row"] $ div_ [class_ "narrow"] $ do
                     p_ . toHtmlRaw $ feedback level misses
-                    p_ $ do
-                        a_ [href_ (playURI mediumTags periods level Nothing)] "Retry the current game"
+                    p_ $ em_ $ do
+                        a_ [href_ (playURI mediumTags periods level Nothing)] "Retry"
                         span_ ", or "
                         a_ [href_ homeURI] "choose different folios and periods"
                         span_ "."
@@ -403,7 +407,10 @@ instance ToHtml PlayView where
                                 td_ (showCard userWork) <> td_ (showCard sortedWork))
                               (zip userWorks sortedWorks)
                 div_ [class_ "row"] $ div_ [class_ ""] $ mapM_ (\work -> do
-                        renderWork work $ p_ $ showCard work <> p_ (toHtml $ location work)
+                        renderWork work $ p_ $ do
+                            strong_ $ showCard work
+                            span_ $ toHtmlRaw $ T.pack " &middot; "
+                            span_ $ em_ (toHtml $ location work)
                         br_ []) sortedWorks
     toHtml (GameView mediumTags labels periods level (GameState v s (Decisions comps)) (work1, work2)) =
         pageTemplate (gameCrumbs mediumTags labels periods level) body
@@ -411,11 +418,12 @@ instance ToHtml PlayView where
             body = do
                 div_ [class_ "row"] $ p_ $ do
                     strong_ . toHtml $ "Question " <> tshow (length comps + 1) <> ". "
-                    span_ "Select the work that was created first. Dates for ancient works are approximate and reflect when construction began."
+                    span_ "Select the work that was created first."
+                    small_ $ em_ " Dates for ancient works are approximate and reflect when construction began."
                 div_ [class_ "row"] $ do
-                    renderWork work1 (a_ [href_ (mkURI Less)] "Work A was created first.")
+                    renderWork work1 (strong_ $ a_ [href_ (mkURI Less)] "Work A was created first.")
                     hr_ []
-                    renderWork work2 (a_ [href_ (mkURI Greater)] "Work B was created first.")
+                    renderWork work2 (strong_ $ a_ [href_ (mkURI Greater)] "Work B was created first.")
             mkURI nxt = playURI mediumTags periods level (Just (GameState v s (Decisions (comps ++ [nxt]))))
     toHtmlRaw = toHtml
 
@@ -432,7 +440,7 @@ pageTemplate crumbs body = doctypehtml_ $ do
       div_ [class_ "row navbar"] $
         sequence_ $
           L.intersperse
-            (span_ [class_ "sep"] (toHtmlRaw (T.pack " &middot; ")))
+            (span_ [] (toHtmlRaw (T.pack " / ")))
             (crumb : crumbs)
       body
     where
-- 
cgit v1.2.3