Slides 0.1.0.6 → 0.1.0.7

raw patch · 7 files changed

+97/−24 lines, 7 filesdep +Slidesdep +regex-applicativedep −regexprdep −utf8-stringdep ~base

Dependencies added: Slides, regex-applicative

Dependencies removed: regexpr, utf8-string

Dependency ranges changed: base

Files

• Slides.cabal +14/−3
• src/Slides/Common.hs +15/−3
• src/Slides/Internal.hs +3/−2
• src/Slides/Presentation.hs +2/−15
• src/Slides/Sequencing.hs +1/−1
• test/Test.hs +44/−0
• test/index.html +18/−0

@@ -1,5 +1,5 @@ name:                Slides
-version:             0.1.0.6
+version:             0.1.0.7
 synopsis:            Generate slides from Haskell code
 description:         Make presentations in Haskell with diagrams
 license:             MIT
@@ -10,6 +10,7 @@ build-type:          Simple
 cabal-version:       >=1.10
 extra-source-files:  assets/default.css
+                   , test/index.html
 
 source-repository head
   type:              git
@@ -24,8 +25,18 @@                      , diagrams-svg == 1.3.*
                      , colour == 2.3.*
                      , file-embed == 0.0.*
-                     , regexpr == 0.5.*
-                     , utf8-string == 0.3.*
+                     , regex-applicative == 0.3.*
                      , diagrams-lib == 1.3.*
+  ghc-options:         -Wall
   hs-source-dirs:      src
+  default-language:    Haskell2010
+
+test-suite sample
+  hs-source-dirs:      test
+  main-is:             Test.hs
+  type:                exitcode-stdio-1.0
+  build-depends:       base >= 4 && < 5
+                     , file-embed == 0.0.*
+                     , Slides
+  ghc-options:         -Wall
   default-language:    Haskell2010

@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
 module Slides.Common
     ( Eagerness(..), Presentation(..), Slide(..), ContentNode(..), Style(..)
     , Selector(..), ElementStyle(..), emptyPresentation, emptyStyle, emptyElementStyle
@@ -6,10 +6,10 @@ 
 import Diagrams (Diagram)
 import Diagrams.Backend.SVG (SVG(..))
-import qualified Diagrams as Diag
-import qualified Diagrams.Backend.SVG as SVG
 import Data.Colour (Colour)
 import Data.FileEmbed
+import Data.String (IsString(..))
+import Text.Regex.Applicative (replace, few, anySym)
 
 -- | Describes the behavior of the presentation element.
 data Eagerness
@@ -89,3 +89,15 @@ -- | Completely empty element style.
 emptyElementStyle :: ElementStyle
 emptyElementStyle = ElementStyle Nothing Nothing Nothing
+
+wrapIn :: String -> String -> String
+wrapIn tag str = "<" ++ tag ++ ">" ++ str ++ "</" ++ tag ++ ">"
+
+inlineMarkdown :: String -> ContentNode
+inlineMarkdown = Text . replace (wrapIn "i" <$> ("*" *> few anySym <* "*"))
+                      . replace (wrapIn "i" <$> ("_" *> few anySym <* "_"))
+                      . replace (wrapIn "b" <$> ("**" *> few anySym <* "**"))
+                      . replace (wrapIn "b" <$> ("__" *> few anySym <* "__"))
+
+instance IsString ContentNode where
+    fromString = inlineMarkdown

@@ -18,7 +18,7 @@ 
 dropAllButSvg :: String -> String
 dropAllButSvg ('<' : 's' : 'v' : 'g' : rest) = "<svg" ++ rest
-dropAllButSvg (x : xs) = dropAllButSvg xs
+dropAllButSvg (_ : xs) = dropAllButSvg xs
 dropAllButSvg _        = error "No <svg> tag"
 
 svgFromDiagram :: Int -> Diagram SVG -> String
@@ -32,5 +32,6 @@ renderLeafContent (RawSVG width height str) = htmlCustom "svg" (w ++ " " ++ h) str
     where w = "width=\"" ++ show width ++ "px\""
           h = "height=\"" ++ show height ++ "px\""
-renderLeafContent Break        = "<br />"
+renderLeafContent Break         = "<br />"
 renderLeafContent (Diagram h d) = svgFromDiagram h d
+renderLeafContent _             = error "Non-leaf node given to renderLeafContent"

@@ -9,6 +9,7 @@ --   Here's an example
 --
 -- @
+-- {-# LANGUAGE OverloadedStrings #-}
 -- sample :: 'Presentation'
 -- sample =
 --     'emptyPresentation' {
@@ -59,16 +60,11 @@     ( renderPresentation, writeToFile, module Slides.Common
     ) where
 
-import Data.Colour (Colour)
 import qualified Data.Colour.SRGB as Colour
 import Data.Maybe (catMaybes)
-import qualified Text.RegexPR as Regex
-import Data.String (IsString(..))
-import Data.List (groupBy)
 import Slides.Common
 import Slides.Sequencing
 import Slides.Internal
-import qualified System.IO.UTF8 as UTF8
 
 class Renderable a where
     render :: a -> String
@@ -101,19 +97,10 @@         , fontFamily $> \ff -> "font-family: " ++ ff ++ ";\n"
         , fontSize $> \fs -> "font-size: " ++ show fs ++ ";" ]
 
-inlineMarkdown :: String -> ContentNode
-inlineMarkdown = Text . Regex.gsubRegexPR "\\*(.+?)\\*" "<i>\\1</i>"
-                      . Regex.gsubRegexPR "_(.+?)_" "<i>\\1</i>"
-                      . Regex.gsubRegexPR "\\*\\*(.+?)\\*\\*" "<b>\\1</b>"
-                      . Regex.gsubRegexPR "__(.+?)__" "<b>\\1</b>"
-
-instance IsString ContentNode where
-    fromString = inlineMarkdown
-
 -- | Render the Presentation to an HTML string.
 renderPresentation :: Presentation -> String
 renderPresentation = render
 
 -- | Render a Presentation to an HTML file with UTF8 encoding.
 writeToFile :: FilePath -> Presentation -> IO ()
-writeToFile path = UTF8.writeFile path . render
+writeToFile path = writeFile path . render

@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveFunctor #-}
 module Slides.Sequencing where
 
-import Slides.Common
+import Slides.Common hiding (nodes)
 import Slides.Internal
 
 data StepF a = Step Eagerness a deriving (Functor, Show)

@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
+module Main where
+
+import Slides.Presentation
+import Data.FileEmbed
+
+index :: String
+index = $(embedStringFile "test/index.html")
+
+sample :: Presentation
+sample =
+    emptyPresentation {
+        slides = [
+            Slide [
+                Header 2 "Title",
+                Sequence Immediate [
+                    -- this delay does nothing because the parent Immediate overrides it
+                    UnfoldConcatList Delay [
+                        Header 3 "Example",
+                        UnfoldList Immediate [
+                            "These lines will unfold one by one.",
+                            "You can use some markdown in these strings like _this_ or *this* \
+                            \or __this__ or **this**."
+                        ]
+                    ],
+                    List [
+                        "This list will be shown in place of the previous title-list-diagram.",
+                        "This item will be shown immediately with the last one."
+                    ]
+                ] -- note that the above title "Title" will remain there during the sequence.
+            ],
+            Slide [
+                Header 2 "Another slide",
+                List [
+                    "Some text describing stuff.",
+                    "More text."
+                ]
+            ]
+        ]
+    }
+
+main :: IO ()
+main = if renderPresentation sample == index then putStrLn "Test passed."
+                                             else putStrLn "Test failed."

@@ -0,0 +1,18 @@+<head><meta charset="utf-8" /><style>body {
+    margin: 2cm;
+    font-family: 'Segoe UI', Arial, freesans, sans-serif;
+    font-size: 300%;
+    color: #333;
+}
+h1 {
+    border-bottom: solid 1px lightgray;
+}
+svg {
+    margin: auto;
+    display: block;
+}
+.slide {
+    page-break-after: always;
+}
+
+</style></head><body><div class="slide"><h2>Title</h2><h3>Example</h3></div><div class="slide"><h2>Title</h2><h3>Example</h3><ul><li>These lines will unfold one by one.</li></ul></div><div class="slide"><h2>Title</h2><h3>Example</h3><ul><li>These lines will unfold one by one.</li><li>You can use some markdown in these strings like <i>this</i> or <i>this</i> or <b>this</b> or <b>this</b>.</li></ul></div><div class="slide"><h2>Title</h2><ul><li>This list will be shown in place of the previous title-list-diagram.</li><li>This item will be shown immediately with the last one.</li></ul></div><div class="slide"><h2>Another slide</h2><ul><li>Some text describing stuff.</li><li>More text.</li></ul></div></body>