Slides (empty) → 0.1.0.0

raw patch · 5 files changed

+202/−0 lines, 5 filesdep +basedep +colourdep +diagrams-libsetup-changed

Dependencies added: base, colour, diagrams-lib, diagrams-svg, file-embed, regexpr, utf8-string

Files

LICENSE +20/−0
Setup.hs +2/−0
Slides.cabal +28/−0
src/Slides/Common.hs +89/−0
src/Slides/Presentation.hs +63/−0

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2015 Luka Horvat
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

+ Slides.cabal view

@@ -0,0 +1,28 @@+name:                Slides
+version:             0.1.0.0
+synopsis:            Generate slides from Haskell code
+description:         Make presentations in Haskell with diagrams
+license:             MIT
+license-file:        LICENSE
+author:              Luka Horvat
+maintainer:          lukahorvat9@gmail.com
+category:            Graphics
+build-type:          Simple
+cabal-version:       >=1.10
+
+source-repository head
+  type:              git
+  location:          https://github.com/LukaHorvat/Slides.git
+
+library
+  exposed-modules:     Slides.Presentation
+                     , Slides.Common
+  build-depends:       base >=4.8 && <4.9
+                     , diagrams-svg == 1.3.*
+                     , colour == 2.3.*
+                     , file-embed == 0.0.*
+                     , regexpr == 0.5.*
+                     , utf8-string == 0.3.*
+                     , diagrams-lib == 1.3.*
+  hs-source-dirs:      src
+  default-language:    Haskell2010

+ src/Slides/Common.hs view

@@ -0,0 +1,89 @@+{-# LANGUAGE TemplateHaskell #-}
+module Slides.Common
+    ( Eagerness(..), Presentation(..), Slide(..), ContentNode(..), Style(..)
+    , Selector(..), ElementStyle(..), emptyPresentation, emptyStyle, emptyElementStyle
+    ) where
+
+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
+
+-- | Describes the behavior of the presentation element.
+data Eagerness
+    -- | The element won't be displayed until there's an explicit signal from the user (pressing the arrow key, etc.)
+    = Delay
+    -- | The element will be displayed as soon as it's encountered.
+    | Immediate
+    deriving (Eq, Show)
+
+-- | The outmost type. Holds slides and styling.
+data Presentation = Presentation { slides   :: [Slide]
+                                 , style    :: Style
+                                 -- | A plain string that will be put into the <head> before everything else.
+                                 , baseHead :: String }
+
+-- | The outmost type of a single slide. Holds content nodes.
+newtype Slide  = Slide { nodes :: [ContentNode] }
+
+-- | The main type in the presentaion. Describes all the possible kinds of content.
+data ContentNode
+    -- | Generates a <hN> tag where the N is the first argument.
+    = Header Int String
+    -- | Generates an unordered list that's immediately displayed.
+    | List [ContentNode]
+    -- | A plain text node.
+    | Text String
+    -- | Generates a <br /> tag. A new line.
+    | Break
+    -- | Generates a SVG tag with the specified width and height and string contents.
+    | RawSVG Int Int String
+    -- | Generates a SVG element from a given height and a Diagram
+    | Diagram Int (Diagram SVG)
+    -- | Generates a list of elements where each element is delayed. The Eagerness parameter
+    -- | determines whether the list will immediately display the first element.
+    | UnfoldList Eagerness [ContentNode]
+    -- | Generates elements in sequence with the next one REPLACING the previous one. The Eagerness
+    -- | parameter determines whether the first element in sequence will be immediately displayed.
+    | Sequence Eagerness [ContentNode]
+    -- | Generates a 'list' of elements. The elements themselves are not wrapped in anything,
+    -- | unlike in a normal list where they're wrapped in <li> tags, just concatinated together.
+    | ConcatList [ContentNode]
+    -- | The same as ConcatList with the display behavior of UnfoldList
+    | UnfoldConcatList Eagerness [ContentNode]
+
+-- | Rudamentary support for styling
+data Style = Style
+    -- | Pairs of selectors that determine what kind of elements to apply the style to and the
+    -- | styles themselves.
+    { selectors :: [(Selector, ElementStyle)]
+    , baseCss   :: String }
+    deriving (Eq, Show, Read)
+
+-- | Describes which elements to apply the style to.
+data Selector
+    = HeaderSelector Int
+    -- | Applies to everything.
+    | UniversalSelector
+    | TextSelector
+    | SlideSelector
+    deriving (Eq, Ord, Show, Read)
+
+data ElementStyle = ElementStyle { backgroundColor :: Maybe (Colour Float)
+                                 , fontFamily      :: Maybe String
+                                 , fontSize        :: Maybe Int }
+                                 deriving (Eq, Show, Read)
+
+-- | An empty presentation set to the default style with UTF8 encoding.
+emptyPresentation :: Presentation
+emptyPresentation = Presentation [] emptyStyle "<meta charset=\"utf-8\" />"
+
+-- | The default style.
+emptyStyle :: Style
+emptyStyle = Style [] $(embedStringFile "assets/default.css")
+
+-- | Completely empty element style.
+emptyElementStyle :: ElementStyle
+emptyElementStyle = ElementStyle Nothing Nothing Nothing

+ src/Slides/Presentation.hs view

@@ -0,0 +1,63 @@+{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
+module Slides.Presentation
+    ( 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
+
+instance Renderable Presentation where
+    render Presentation{..} = html "head" h ++ html "body" b
+        where h = baseHead ++ render style
+              b = concatMap render slides
+
+instance Renderable Slide where
+    render Slide{..} = concatMap (htmlClass "div" "slide") sequences
+        where sequences = stepsToStrings $ mergeSequences $ map (simplify . sequenceContent) nodes
+
+instance Renderable Style where
+    render Style{..} = html "style" (baseCss ++ "\n" ++ concatMap renderSelector selectors)
+        where renderSelector (k, v) =  render k ++ " { " ++ render v ++ " }\n"
+
+instance Renderable Selector where
+    render (HeaderSelector h) = "h" ++ show h
+    render UniversalSelector  = "*"
+    render TextSelector       = "p"
+    render SlideSelector      = ".slide"
+
+($>) :: Functor f => f a -> (a -> b) -> f b
+($>) = flip fmap
+
+instance Renderable ElementStyle where
+    render ElementStyle{..} = concat $ catMaybes
+        [ backgroundColor $> \col -> "background-color: " ++ Colour.sRGB24show col ++ ";\n"
+        , 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 a HTML string.
+renderPresentation :: Presentation -> String
+renderPresentation = render
+
+-- | Render a Presentation to a HTML file with UTF8 encoding.
+writeToFile :: FilePath -> Presentation -> IO ()
+writeToFile path = UTF8.writeFile path . render