diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Slides.cabal b/Slides.cabal new file mode 100644 --- /dev/null +++ b/Slides.cabal @@ -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 diff --git a/src/Slides/Common.hs b/src/Slides/Common.hs new file mode 100644 --- /dev/null +++ b/src/Slides/Common.hs @@ -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 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 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
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
  • 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 "" + +-- | The default style. +emptyStyle :: Style +emptyStyle = Style [] $(embedStringFile "assets/default.css") + +-- | Completely empty element style. +emptyElementStyle :: ElementStyle +emptyElementStyle = ElementStyle Nothing Nothing Nothing diff --git a/src/Slides/Presentation.hs b/src/Slides/Presentation.hs new file mode 100644 --- /dev/null +++ b/src/Slides/Presentation.hs @@ -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 "\\*(.+?)\\*" "\\1" + . Regex.gsubRegexPR "_(.+?)_" "\\1" + . Regex.gsubRegexPR "\\*\\*(.+?)\\*\\*" "\\1" + . Regex.gsubRegexPR "__(.+?)__" "\\1" + +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