[#150] Add pop-up blocks

src/Snippets/Parser.hs

@@ -55,6 +55,8 @@ data SnippetNode
   | HltEnd
   -- | Whole line highlighting
   | HltLine
+  -- | Pop-up block with additional info
+  | PopUp Text
   deriving (Show, Eq)
 
 -- As I haven't found still better option for parsing except symb by symb parsing
@@ -76,7 +78,8 @@ parseSimpleLinePiece =  MP.try parseHltLine
                     <|> MP.try parseChoice
                     <|> MP.try parseHackage
                     <|> MP.try parseHltBegin
-                    <|> parseHltEnd
+                    <|> MP.try parseHltEnd
+                    <|> parsePopUp
                     <|> (anyChar >>= \x -> pure $ CodeText $ T.pack [x]) -- TODO: how to optimize? manyTill doesn't work :(
 
 -----------------------------------------------
@@ -182,6 +185,19 @@ factorial :: Int -> Integer
 parseHltLine :: Parser SnippetNode
 parseHltLine = keyword "HltLine" >> pure HltLine
 
+{-|
+Puts any additional text for clarifying code which appears as popUp-block when moused over.
+@
+addFive :: Int -> Int
+{{PopUp}}["Eta reducing]addFive = (+5)
+@
+-}
+parsePopUp :: Parser SnippetNode
+parsePopUp = do
+  keyword "PopUp"
+  popUpText <- betweenBrackets txtP
+  pure $ PopUp popUpText
+
 -- maybe better data structure for parse result
 -- data ParsedSnippet = MultipleBlocks [(Int,Text)] [[SnippetNode]]
 --                    | SingleBlock                 [[SnippetNode]]

src/Snippets/Renderer.hs

@@ -8,7 +8,6 @@ where
 
 import           Imports
 
-import           Data.List                       (dropWhileEnd)
 import qualified Data.Map                        as M (lookup)
 import qualified Data.Text                       as T
 -- Web
@@ -135,6 +134,8 @@ renderNode lbls intLbl@(curInt, curLbl) (Choice x:xs) = do
 renderNode lbls lbl (Hackage x:xs) = do
   a_ [href_ "#"] (toHtml x)
   renderNode lbls lbl xs
+renderNode lbls lbl (PopUp x:xs) =
+  span_ [title_ x] $ renderNode lbls lbl xs
 renderNode lbls lbl (_:xs) = renderNode lbls lbl xs
 
 highlightKateCode :: Text -> String

tests/SnippetsExample.md

@@ -15,4 +15,4 @@
         app = do
 {{HltLine}}         -- When “/” is requested, show “Hello world!”
 {{HltLine}}         get root $
-{{HltLine}}            text "Hello world!"
+           {{PopUp}}["Hey there"]text "Hello world!"