Merge branch 'master'

into sectore/bridge-uid-more-type-safety

src/Guide/Api/Types.hs

@@ -32,7 +32,7 @@ import Guide.Types.Core (Category(..), CategoryStatus(..), Item(..), ItemKind
   , Trait, content, uid
   )
 import Guide.Utils (Uid(..), Url)
-import Guide.Markdown (MarkdownBlock, MarkdownInline, MarkdownTree, mdHtml, mdText)
+import Guide.Markdown (MarkdownBlock, MarkdownInline, MarkdownTree, mdHtml, mdSource)
 
 ----------------------------------------------------------------------------
 -- Routes
@@ -190,19 +190,19 @@ class ToCMardown md where toCMarkdown :: md -> CMarkdown
 
 instance ToCMardown MarkdownInline where
   toCMarkdown md = CMarkdown
-    { text = md^.mdText
+    { text = md^.mdSource
     , html = T.decodeUtf8 $ md^.mdHtml
     }
 
 instance ToCMardown MarkdownBlock where
   toCMarkdown md = CMarkdown
-    { text = md^.mdText
+    { text = md^.mdSource
     , html = T.decodeUtf8 $ md^.mdHtml
     }
 
 instance ToCMardown MarkdownTree where
   toCMarkdown md = CMarkdown
-    { text = md^.mdText
+    { text = md^.mdSource
     , html = T.toStrict . renderText $ toHtml md
     }
 

src/Guide/Handlers.hs

@@ -133,7 +133,7 @@ setMethods = do
   Spock.post (setRoute <//> categoryVar <//> "notes") $ \catId -> do
     original <- param' "original"
     content' <- param' "content"
-    modified <- view (notes.mdText) <$> dbQuery (GetCategory catId)
+    modified <- view (notes.mdSource) <$> dbQuery (GetCategory catId)
     if modified == original
       then do
         category <- uncache (CacheCategoryNotes catId) $ do
@@ -196,7 +196,7 @@ setMethods = do
   Spock.post (setRoute <//> itemVar <//> "description") $ \itemId -> do
     original <- param' "original"
     content' <- param' "content"
-    modified <- view (description.mdText) <$> dbQuery (GetItem itemId)
+    modified <- view (description.mdSource) <$> dbQuery (GetItem itemId)
     if modified == original
       then do
         item <- uncache (CacheItemDescription itemId) $ do
@@ -213,7 +213,7 @@ setMethods = do
   Spock.post (setRoute <//> itemVar <//> "ecosystem") $ \itemId -> do
     original <- param' "original"
     content' <- param' "content"
-    modified <- view (ecosystem.mdText) <$> dbQuery (GetItem itemId)
+    modified <- view (ecosystem.mdSource) <$> dbQuery (GetItem itemId)
     if modified == original
       then do
         item <- uncache (CacheItemEcosystem itemId) $ do
@@ -230,7 +230,7 @@ setMethods = do
   Spock.post (setRoute <//> itemVar <//> "notes") $ \itemId -> do
     original <- param' "original"
     content' <- param' "content"
-    modified <- view (notes.mdText) <$> dbQuery (GetItem itemId)
+    modified <- view (notes.mdSource) <$> dbQuery (GetItem itemId)
     if modified == original
       then do
         item <- uncache (CacheItemNotes itemId) $ do
@@ -248,7 +248,7 @@ setMethods = do
   Spock.post (setRoute <//> itemVar <//> traitVar) $ \itemId traitId -> do
     original <- param' "original"
     content' <- param' "content"
-    modified <- view (content.mdText) <$> dbQuery (GetTrait itemId traitId)
+    modified <- view (content.mdSource) <$> dbQuery (GetTrait itemId traitId)
     if modified == original
       then do
         trait <- uncache (CacheItemTraits itemId) $ do

src/Guide/Markdown.hs

@@ -19,7 +19,7 @@ module Guide.Markdown
 
   -- * Lenses
   mdHtml,
-  mdText,
+  mdSource,
   mdMarkdown,
   mdIdPrefix,
   mdTree,
@@ -70,19 +70,19 @@ import Guide.Utils
 
 
 data MarkdownInline = MarkdownInline {
-  markdownInlineMdText     :: Text,
+  markdownInlineMdSource   :: Text,
   markdownInlineMdHtml     :: ByteString,
   markdownInlineMdMarkdown :: ![MD.Node] }
   deriving (Generic, Data)
 
 data MarkdownBlock = MarkdownBlock {
-  markdownBlockMdText     :: Text,
+  markdownBlockMdSource   :: Text,
   markdownBlockMdHtml     :: ByteString,
   markdownBlockMdMarkdown :: ![MD.Node] }
   deriving (Generic, Data)
 
 data MarkdownTree = MarkdownTree {
-  markdownTreeMdText     :: Text,
+  markdownTreeMdSource   :: Text,
   markdownTreeMdTree     :: !(Document Text ByteString),
   markdownTreeMdIdPrefix :: Text,
   markdownTreeMdTOC      :: Forest ([MD.Node], Text) }
@@ -147,14 +147,14 @@ stringify = T.concat . map go
 
 -- | Extract everything before the first heading.
 --
--- Note that if you render 'mdText' of the produced Markdown block, it won't
+-- Note that if you render 'mdSource' of the produced Markdown block, it won't
 -- necessarily parse into 'mdHtml' from the same block. It's because rendered
 -- Markdown might depend on links that are defined further in the tree.
 extractPreface :: MarkdownTree -> MarkdownBlock
 extractPreface = mkBlock . preface . view mdTree
   where
     mkBlock x = MarkdownBlock {
-      markdownBlockMdText     = getSource x,
+      markdownBlockMdSource   = getSource x,
       markdownBlockMdHtml     = renderMD (stripSource x),
       markdownBlockMdMarkdown = stripSource x }
 
@@ -239,7 +239,7 @@ parseLink = either (Left . show) Right . parse p ""
 
 toMarkdownInline :: Text -> MarkdownInline
 toMarkdownInline s = MarkdownInline {
-  markdownInlineMdText     = s,
+  markdownInlineMdSource   = s,
   markdownInlineMdHtml     = html,
   markdownInlineMdMarkdown = inlines }
   where
@@ -248,7 +248,7 @@ toMarkdownInline s = MarkdownInline {
 
 toMarkdownBlock :: Text -> MarkdownBlock
 toMarkdownBlock s = MarkdownBlock {
-  markdownBlockMdText     = s,
+  markdownBlockMdSource   = s,
   markdownBlockMdHtml     = html,
   markdownBlockMdMarkdown = doc }
   where
@@ -257,7 +257,7 @@ toMarkdownBlock s = MarkdownBlock {
 
 toMarkdownTree :: Text -> Text -> MarkdownTree
 toMarkdownTree idPrefix s = MarkdownTree {
-  markdownTreeMdText     = s,
+  markdownTreeMdSource   = s,
   markdownTreeMdIdPrefix = idPrefix,
   markdownTreeMdTree     = tree,
   markdownTreeMdTOC      = toc }
@@ -297,23 +297,23 @@ slugifyDocument slugify doc = doc {
       return sec{headingAnn = slug}
 
 instance Show MarkdownInline where
-  show = show . view mdText
+  show = show . view mdSource
 instance Show MarkdownBlock where
-  show = show . view mdText
+  show = show . view mdSource
 instance Show MarkdownTree where
-  show = show . view mdText
+  show = show . view mdSource
 
 instance A.ToJSON MarkdownInline where
   toJSON md = A.object [
-    "text" A..= (md^.mdText),
+    "text" A..= (md^.mdSource),
     "html" A..= T.toStrict (md^.mdHtml) ]
 instance A.ToJSON MarkdownBlock where
   toJSON md = A.object [
-    "text" A..= (md^.mdText),
+    "text" A..= (md^.mdSource),
     "html" A..= T.toStrict (md^.mdHtml) ]
 instance A.ToJSON MarkdownTree where
   toJSON md = A.object [
-    "text" A..= (md^.mdText) ]
+    "text" A..= (md^.mdSource) ]
 
 instance ToHtml MarkdownInline where
   toHtmlRaw = toHtml
@@ -342,22 +342,22 @@ instance ToHtml MarkdownTree where
 instance SafeCopy MarkdownInline where
   version = 0
   kind = base
-  putCopy = contain . safePut . view mdText
+  putCopy = contain . safePut . view mdSource
   getCopy = contain $ toMarkdownInline <$> safeGet
 instance SafeCopy MarkdownBlock where
   version = 0
   kind = base
-  putCopy = contain . safePut . view mdText
+  putCopy = contain . safePut . view mdSource
   getCopy = contain $ toMarkdownBlock <$> safeGet
 instance SafeCopy MarkdownTree where
   version = 0
   kind = base
   putCopy md = contain $ do
     safePut (md ^. mdIdPrefix)
-    safePut (md ^. mdText)
+    safePut (md ^. mdSource)
   getCopy = contain $
     toMarkdownTree <$> safeGet <*> safeGet
 
 -- | Is a piece of Markdown empty?
-markdownNull :: HasMdText a Text => a -> Bool
+markdownNull :: HasMdSource a Text => a -> Bool
-markdownNull = T.null . view mdText
+markdownNull = T.null . view mdSource

src/Guide/Search.hs

@@ -53,7 +53,7 @@ search query gs =
     sortByRank [(SRItemEcosystem cat item, rank)
                  | cat  <- gs^.categories
                  , item <- cat^.items
-                 , let rank = match query (item^.ecosystem.mdText)
+                 , let rank = match query (item^.ecosystem.mdSource)
                  , rank > 0 ]
   where
     sortByRank :: [(a, Int)] -> [a]

src/Guide/ServerStuff.hs

@@ -182,7 +182,7 @@ undoEdit (Edit'ChangeCategoryEnabledSections catId toEnable toDisable) = do
     then return (Left "enabled-sections has been changed further")
     else Right () <$ dbUpdate (ChangeCategoryEnabledSections catId toDisable toEnable)
 undoEdit (Edit'SetCategoryNotes catId old new) = do
-  now <- view (notes.mdText) <$> dbQuery (GetCategory catId)
+  now <- view (notes.mdSource) <$> dbQuery (GetCategory catId)
   if now /= new
     then return (Left "notes have been changed further")
     else Right () <$ dbUpdate (SetCategoryNotes catId old)
@@ -207,22 +207,22 @@ undoEdit (Edit'SetItemKind itemId old new) = do
     then return (Left "kind has been changed further")
     else Right () <$ dbUpdate (SetItemKind itemId old)
 undoEdit (Edit'SetItemDescription itemId old new) = do
-  now <- view (description.mdText) <$> dbQuery (GetItem itemId)
+  now <- view (description.mdSource) <$> dbQuery (GetItem itemId)
   if now /= new
     then return (Left "description has been changed further")
     else Right () <$ dbUpdate (SetItemDescription itemId old)
 undoEdit (Edit'SetItemNotes itemId old new) = do
-  now <- view (notes.mdText) <$> dbQuery (GetItem itemId)
+  now <- view (notes.mdSource) <$> dbQuery (GetItem itemId)
   if now /= new
     then return (Left "notes have been changed further")
     else Right () <$ dbUpdate (SetItemNotes itemId old)
 undoEdit (Edit'SetItemEcosystem itemId old new) = do
-  now <- view (ecosystem.mdText) <$> dbQuery (GetItem itemId)
+  now <- view (ecosystem.mdSource) <$> dbQuery (GetItem itemId)
   if now /= new
     then return (Left "ecosystem has been changed further")
     else Right () <$ dbUpdate (SetItemEcosystem itemId old)
 undoEdit (Edit'SetTraitContent itemId traitId old new) = do
-  now <- view (content.mdText) <$> dbQuery (GetTrait itemId traitId)
+  now <- view (content.mdSource) <$> dbQuery (GetTrait itemId traitId)
   if now /= new
     then return (Left "trait has been changed further")
     else Right () <$ dbUpdate (SetTraitContent itemId traitId old)

src/Guide/State.hs

@@ -440,7 +440,7 @@ setCategoryGroup catId group' = do
 setCategoryNotes :: Uid Category -> Text -> Acid.Update GlobalState (Edit, Category)
 setCategoryNotes catId notes' = do
   oldNotes <- categoryById catId . notes <<.= toMarkdownBlock notes'
-  let edit = Edit'SetCategoryNotes catId (oldNotes ^. mdText) notes'
+  let edit = Edit'SetCategoryNotes catId (oldNotes ^. mdSource) notes'
   (edit,) <$> use (categoryById catId)
 
 setCategoryStatus :: Uid Category -> CategoryStatus -> Acid.Update GlobalState (Edit, Category)
@@ -516,7 +516,7 @@ setItemDescription itemId description' = do
   oldDescr <- itemById itemId . description <<.=
                 toMarkdownBlock description'
   let edit = Edit'SetItemDescription itemId
-               (oldDescr ^. mdText) description'
+               (oldDescr ^. mdSource) description'
   (edit,) <$> use (itemById itemId)
 
 setItemNotes :: Uid Item -> Text -> Acid.Update GlobalState (Edit, Item)
@@ -524,7 +524,7 @@ setItemNotes itemId notes' = do
   let pref = "item-notes-" <> uidToText itemId <> "-"
   oldNotes <- itemById itemId . notes <<.=
                 toMarkdownTree pref notes'
-  let edit = Edit'SetItemNotes itemId (oldNotes ^. mdText) notes'
+  let edit = Edit'SetItemNotes itemId (oldNotes ^. mdSource) notes'
   (edit,) <$> use (itemById itemId)
 
 setItemEcosystem :: Uid Item -> Text -> Acid.Update GlobalState (Edit, Item)
@@ -532,7 +532,7 @@ setItemEcosystem itemId ecosystem' = do
   oldEcosystem <- itemById itemId . ecosystem <<.=
                     toMarkdownBlock ecosystem'
   let edit = Edit'SetItemEcosystem itemId
-               (oldEcosystem ^. mdText) ecosystem'
+               (oldEcosystem ^. mdSource) ecosystem'
   (edit,) <$> use (itemById itemId)
 
 setTraitContent :: Uid Item -> Uid Trait -> Text -> Acid.Update GlobalState (Edit, Trait)
@@ -540,7 +540,7 @@ setTraitContent itemId traitId content' = do
   oldContent <- itemById itemId . traitById traitId . content <<.=
                   toMarkdownInline content'
   let edit = Edit'SetTraitContent itemId traitId
-               (oldContent ^. mdText) content'
+               (oldContent ^. mdSource) content'
   (edit,) <$> use (itemById itemId . traitById traitId)
 
 -- delete

src/Guide/Views.hs

@@ -752,7 +752,7 @@ renderSearchResult r = do
         a_ [class_ "category-link", href_ (categoryLink cat)] $
           toHtml (cat^.title)
         div_ [class_ "category-description notes-like"] $
-          toHtml (extractPreface $ toMarkdownTree "" $ cat^.notes.mdText)
+          toHtml (extractPreface $ toMarkdownTree "" $ cat^.notes.mdSource)
       SRItem cat item -> do
         a_ [class_ "category-link in-item-sr", href_ (categoryLink cat)] $
           toHtml (cat^.title)

src/Guide/Views/Category.hs

@@ -182,6 +182,6 @@ renderCategoryNotes category = cached (CacheCategoryNotes (category^.uid)) $ do
         [rows_ "10", class_ " editor "]
         contents
         (\val -> JS.submitCategoryNotes
-                   (this, category^.uid, category^.notes.mdText, val))
+                   (this, category^.uid, category^.notes.mdSource, val))
         (JS.switchSection (this, "normal" :: Text))
         "or press Ctrl+Enter to save"

src/Guide/Views/Item.hs

@@ -177,7 +177,7 @@ renderItemEcosystem item = cached (CacheItemEcosystem (item^.uid)) $ do
         [rows_ "3", class_ " editor "]
         (item^.ecosystem)
         (\val -> JS.submitItemEcosystem
-                   (this, item^.uid, item^.ecosystem.mdText, val))
+                   (this, item^.uid, item^.ecosystem.mdSource, val))
         (JS.switchSection (this, "normal" :: Text))
         "or press Ctrl+Enter to save"
 
@@ -294,7 +294,7 @@ renderItemNotes category item = cached (CacheItemNotes (item^.uid)) $ do
       textareaUid <- randomLongUid
       contents <- if markdownNull (item^.notes)
         then liftIO $ T.readFile "static/item-notes-template.md"
-        else return (item^.notes.mdText)
+        else return (item^.notes.mdSource)
       let buttons = do
             textButton "collapse notes" $
               JS.switchSection (this, "collapsed" :: Text)

src/Guide/Views/Utils.hs

@@ -187,7 +187,7 @@ markdownEditor
   -> JS             -- ^ “Cancel” handler
   -> Text           -- ^ Instruction (e.g. “press Ctrl+Enter to save”)
   -> HtmlT m ()
-markdownEditor attr (view mdText -> s) submit cancel instr = do
+markdownEditor attr (view mdSource -> s) submit cancel instr = do
   textareaUid <- randomLongUid
   let val = JS $ "document.getElementById(\""+|textareaUid|+"\").value"
   -- Autocomplete has to be turned off thanks to
@@ -219,7 +219,7 @@ smallMarkdownEditor
   -> Maybe JS       -- ^ “Cancel” handler (if “Cancel” is needed)
   -> Text           -- ^ Instruction (e.g. “press Enter to add”)
   -> HtmlT m ()
-smallMarkdownEditor attr (view mdText -> s) submit mbCancel instr = do
+smallMarkdownEditor attr (view mdSource -> s) submit mbCancel instr = do
   textareaId <- randomLongUid
   let val = JS $ "document.getElementById(\""+|textareaId|+"\").value"
   textarea_ ([class_ "fullwidth", uid_ textareaId, autocomplete_ "off"] ++

tests/MarkdownSpec.hs

@@ -28,7 +28,7 @@ import Guide.Markdown
 tests :: Spec
 tests = describe "Markdown" $ do
   allMarkdowns $ \convert -> do
-    it "has mdText filled accurately" $ do
+    it "has mdSource filled accurately" $ do
       for_ mdBlockExamples $ \s ->
         s `shouldBe` fst (convert s)
     it "only has allowed tags" $ do
@@ -149,15 +149,15 @@ htmlToText = T.toStrict . renderText . toHtml
 allMarkdowns :: ((Text -> (Text, Text)) -> Spec) -> Spec
 allMarkdowns f = do
   describe "inline MD" $
-    f ((view mdText &&& htmlToText) . toMarkdownInline)
+    f ((view mdSource &&& htmlToText) . toMarkdownInline)
   blockMarkdowns f
 
 blockMarkdowns :: ((Text -> (Text, Text)) -> Spec) -> Spec
 blockMarkdowns f = do
   describe "block MD" $
-    f ((view mdText &&& htmlToText) . toMarkdownBlock)
+    f ((view mdSource &&& htmlToText) . toMarkdownBlock)
   describe "block+toc MD" $
-    f ((view mdText &&& htmlToText) . toMarkdownTree "")
+    f ((view mdSource &&& htmlToText) . toMarkdownTree "")
 
 mdInlineExamples :: [Text]
 mdInlineExamples = [