yeamer 0.1.1.0 → 0.1.2.0
raw patch · 5 files changed
+274/−49 lines, 5 filesdep ~base
Dependency ranges changed: base
Files
- Presentation/Yeamer.hs +201/−36
- Presentation/Yeamer/Internal/Grid.hs +13/−11
- Presentation/Yeamer/Maths/Unicode/MathLatin_RomanGreek.hs +49/−0
- test/Main.hs +8/−0
- yeamer.cabal +3/−2
Presentation/Yeamer.hs view
@@ -47,14 +47,19 @@ -- ** Haskell values , InteractiveShow(..) -- ** Interactive parameters- , inputBox, feedback_+ , inputBox, dropdownSelect, feedback_ -- * Structure / composition , addHeading, (======), discardResult , module Data.Monoid , module Data.Semigroup.Numbered- , (→│←) , (→│)+ , (↘──)+ , (│←)+ , (──↖)+ , (→│←)+ , (↘──↖) , (→│→)+ , (↘──↘) -- * CSS , divClass, divClasses, spanClass, (#%), styling, Css -- * Server configuration@@ -62,6 +67,8 @@ , YeamerServerConfig -- | Default port is 14910 , yeamerTcpPort+ -- * Internals+ , IPresentation ) where import Yesod hiding (get)@@ -88,7 +95,7 @@ import Presentation.Yeamer.Internal.Grid import Text.Cassius (cassius, Css)-import Text.Julius (rawJS, Javascript)+import Text.Julius (rawJS, Javascript, renderJavascript) import Yesod.Static (Static, static, base64md5) import Yesod.EmbeddedStatic@@ -135,7 +142,8 @@ import System.FilePath ( takeFileName, takeExtension, takeBaseName, dropExtension , (<.>), (</>) )-import System.Directory ( doesPathExist, makeAbsolute+import System.IO.Error (catchIOError, isAlreadyExistsError)+import System.Directory ( doesPathExist, canonicalizePath, removeFile , createDirectoryIfMissing, renameFile #if MIN_VERSION_directory(1,3,1) , createFileLink, pathIsSymbolicLink, getSymbolicLinkTarget@@ -184,10 +192,11 @@ data IPresentation m r where StaticContent :: Html -> IPresentation m ()+ DynamicContent :: m Html -> IPresentation m () TweakableInput :: (Sessionable x, JSON.FromJSON x) => Maybe x- -> ( PrPath -> ( Text -- ^ The “final leaf” of the DOM path- , Maybe x -> -- ^ An already stored value+ -> ( PrPath -> ( Text -- The “final leaf” of the DOM path+ , Maybe x -> -- An already stored value ( PresProgress -> JavascriptUrl (Route PresentationServer) , Html ) ))@@ -237,6 +246,7 @@ preprocPres :: IPresentation m r -> IPresentation m r preprocPres (StaticContent c) = StaticContent c+preprocPres (DynamicContent c) = DynamicContent c preprocPres (TweakableInput defV frm) = TweakableInput defV frm preprocPres (Resultless p) = Resultless $ preprocPres p preprocPres (Styling s p) = Styling s $ preprocPres p@@ -248,7 +258,7 @@ = Styling grids . fmap ff . divClass gridClass- . Encaps ManualCSSClasses (backonstruct . map (first (read . Txt.unpack . _hchunkCSSClass) . swap)+ . Encaps ManualCSSClasses (fst . backonstruct . map (first (read . Txt.unpack . _hchunkCSSClass) . swap) . runWriterT) $ preprocPres <$> layouted where (GridLayout w h prelayed, backonstruct) = layoutGridP p@@ -292,6 +302,7 @@ isInline :: IPresentation m a -> Bool isInline (StaticContent _) = True+isInline (DynamicContent _) = True isInline (TweakableInput _ _) = False isInline (Encaps ManualCSSClasses _ (WriterT qs)) = all (\(_,i) -> case i of HTMSpan _ -> True@@ -318,7 +329,7 @@ slideChoice <- (`runReaderT`pPosition) $ chooseSlide "" defaultChoiceName "" Nothing Nothing presentation (`here`slideChoice) $ \slide -> do- let contents = go 0 slide+ contents <- liftIO $ go 0 slide toWidget contents return () where chooseSlide :: PrPath -> (Text->PrPath) -> Text -> Maybe PrPath -> Maybe PrPath@@ -327,6 +338,8 @@ (WidgetT PresentationServer IO) (These Presentation r) chooseSlide _ _ "" Nothing Nothing (StaticContent conts) = pure $ These (StaticContent conts) ()+ chooseSlide _ _ "" Nothing Nothing (DynamicContent conts)+ = pure $ These (DynamicContent conts) () chooseSlide path choiceName pdiv Nothing Nothing (TweakableInput defV frm) = do let (leafNm, interactor) = frm path fullPath = path<>leafNm@@ -379,7 +392,7 @@ positionCh <- lookupProgress progPath case positionCh of Nothing -> do- liftIO . putStrLn $ "Not enter '"++Txt.unpack progPath++"'"+ -- liftIO . putStrLn $ "Not enter '"++Txt.unpack progPath++"'" purity <- chooseSlide path choiceName (pdiv<>"0") bwd (Just progPath) def case preferThis purity of Left pres -> pure . This $ discardResult pres@@ -440,8 +453,9 @@ chooseSlide _ _ _ _ _ (Pure x) = pure $ That x chooseSlide _ _ _ _ _ pres = error $ "Cannot display "++outerConstructorName pres- go :: Int -> IPresentation m r -> Html- go _ (StaticContent conts) = conts+ go :: Monad m => Int -> IPresentation m r -> m Html+ go _ (StaticContent conts) = pure conts+ go _ (DynamicContent conts) = conts go _ (Pure _) = error $ "Error: impossible to render a slide of an empty presentation." go _ (Dependent _ _) = error $ "Internal error: un-selected Dependent option while rendering to HTML." go lvl (Deterministic _ conts) = go lvl conts@@ -467,7 +481,8 @@ | Just _ <- Txt.stripPrefix "autogrid_" c = "autogrid "<>c | otherwise = c- go lvl (Encaps (CustomEncapsulation (EncapsulableWitness _) f) _ conts) = f $ go lvl <$> conts+ go lvl (Encaps (CustomEncapsulation (EncapsulableWitness _) f) _ conts)+ = fmap f . forM conts $ go lvl go _ p = error $ outerConstructorName p <> " cannot be rendered." @@ -480,8 +495,11 @@ hchunkFor t p | isInline p = HTMSpan t | otherwise = HTMDiv t -instance (Monoid r, Sessionable r) => SG.Semigroup (IPresentation m r) where+instance (Monad m, Monoid r, Sessionable r) => SG.Semigroup (IPresentation m r) where StaticContent c <> StaticContent d = StaticContent $ c<>d+ DynamicContent c <> DynamicContent d = DynamicContent $ liftA2 (<>) c d+ StaticContent c <> DynamicContent d = DynamicContent $ (c<>)<$>d+ DynamicContent c <> StaticContent d = DynamicContent $ (<>d)<$>c Encaps ManualCSSClasses ff₀ (WriterT elems₀) <> Encaps ManualCSSClasses ff₁ (WriterT elems₁) = Encaps ManualCSSClasses ff' . WriterT . disambiguate $ map (first $ fmap Left) elems₀ ++ map (first $ fmap Right) elems₁@@ -507,7 +525,7 @@ = Resultless (Encaps ManualCSSClasses id $ WriterT [(c,hchunkFor""c)]) <> Resultless p p <> q = Encaps ManualCSSClasses fold $ WriterT [(p, hchunkFor"anonymousCell-0"p), (q, hchunkFor"anonymousCell-1"q)]-instance ∀ m . Monoid (IPresentation m ()) where+instance ∀ m . Monad m => Monoid (IPresentation m ()) where mappend = (SG.<>) mempty = Resultless $ Encaps ManualCSSClasses id (WriterT [] :: WriterT HTMChunkK [] (IPresentation m ()))@@ -519,13 +537,41 @@ . Encaps GriddedBlocks id $ GridDivisions [GridRegion<$>[ Just<$>l, const Nothing<$>r ]] +infix 5 ↘──+(↘──) :: (Sessionable a)+ => IPresentation m a -> IPresentation m b -> IPresentation m a+l↘──r = fmap (\(GridDivisions [[GridRegion (Just a)], [GridRegion Nothing]]) -> a)+ . Encaps GriddedBlocks id+ $ GridDivisions [[GridRegion $ Just<$>l], [GridRegion $ const Nothing<$>r]]++infix 6 │←+(│←) :: (Sessionable b)+ => IPresentation m a -> IPresentation m b -> IPresentation m b+l│←r = fmap (\(GridDivisions [[GridRegion Nothing, GridRegion (Just b)]]) -> b)+ . Encaps GriddedBlocks id+ $ GridDivisions [GridRegion<$>[ const Nothing<$>l, Just<$>r ]]++infix 5 ──↖+(──↖) :: (Sessionable b)+ => IPresentation m a -> IPresentation m b -> IPresentation m b+l──↖r = fmap (\(GridDivisions [[GridRegion Nothing, GridRegion (Just b)]]) -> b)+ . Encaps GriddedBlocks id+ $ GridDivisions [[GridRegion $ const Nothing<$>l], [GridRegion $ Just<$>r]]+ infix 6 →│→-(→│→) :: (Sessionable a)+(→│→) :: (Sessionable a, Monad m) => IPresentation m a -> (a -> IPresentation m ()) -> IPresentation m a l→│→r = Feedback $ \aFbq -> l →│ case aFbq of Just a -> r a- othing -> mempty+ Nothing -> mempty +infix 5 ↘──↘+(↘──↘) :: (Sessionable a, Monad m)+ => IPresentation m a -> (a -> IPresentation m ()) -> IPresentation m a+l↘──↘r = Feedback $ \aFbq -> l ↘── case aFbq of+ Just a -> r a+ Nothing -> mempty+ infix 6 →│← (→│←) :: (Sessionable a, Sessionable b) => IPresentation m a -> IPresentation m b -> IPresentation m (a,b)@@ -534,6 +580,14 @@ . Encaps GriddedBlocks id $ GridDivisions [GridRegion<$>[Left<$>l, Right<$>r]] +infix 5 ↘──↖+(↘──↖) :: (Sessionable a, Sessionable b)+ => IPresentation m a -> IPresentation m b -> IPresentation m (a,b)+l↘──↖r = fmap (\(GridDivisions [[GridRegion (Left a)], [GridRegion (Right b)]])+ -> (a,b))+ . Encaps GriddedBlocks id+ $ GridDivisions [[GridRegion $ Left<$>l], [GridRegion $ Right<$>r]]+ instance ∀ m . SemigroupNo 0 (IPresentation m ()) where sappendN _ (Resultless (Encaps GriddedBlocks _ l)) (Resultless (Encaps GriddedBlocks _ r))@@ -555,6 +609,7 @@ outerConstructorName :: IPresentation m r -> String outerConstructorName (StaticContent _) = "StaticContent"+outerConstructorName (DynamicContent _) = "DynamicContent" outerConstructorName (TweakableInput _ _) = "TweakableInput" outerConstructorName (Resultless _) = "Resultless" outerConstructorName (Styling _ _) = "Styling"@@ -569,12 +624,16 @@ discardResult :: IPresentation m r -> IPresentation m () discardResult (StaticContent c) = StaticContent c+discardResult (DynamicContent c) = DynamicContent c discardResult (Resultless p) = Resultless p discardResult p = Resultless p feedback_ :: Sessionable a => (Maybe a -> IPresentation m a) -> IPresentation m () feedback_ = discardResult . Feedback +-- | Run a monadic action and use the result in the presentation.+-- Note that the action may not be re-run even if it depends to other+-- values chosen at another point in the presentation, so use with care. serverSide :: Sessionable a => m a -> IPresentation m a serverSide = Interactive (pure ()) @@ -591,11 +650,13 @@ instance ∀ m . Monad (IPresentation m) where return = pure StaticContent c >>= f = Dependent (StaticContent c) f+ DynamicContent c >>= f = Dependent (DynamicContent c) f TweakableInput defV frm >>= f = Dependent (TweakableInput defV frm) f Resultless p >>= f = Dependent (Resultless p) f Feedback p >>= f = Dependent (Feedback p) f Styling _ (Pure x) >>= f = f x Styling s (StaticContent c) >>= f = Dependent (Styling s (StaticContent c)) f+ Styling s (DynamicContent c) >>= f = Dependent (Styling s (DynamicContent c)) f Styling s (Resultless c) >>= f = Dependent (Styling s (Resultless c)) f Styling s (Styling s' x) >>= f = Styling (s++s') x >>= f Styling s (Encaps (WithHeading h) ff x) >>= f@@ -669,10 +730,16 @@ $ f . runIdentity) runIdentity . Identity +type JSCode url0 = (url0 -> [(Text,Text)] -> Text) -> Javascript+ class Sessionable i => Inputtable i where inputElemHtml :: i -- ^ Current value -> String -- ^ id in the DOM -> Html+ inputElemJSRead :: String -- ^ id in the DOM+ -> Javascript -- ^ Expression that reads out the value+ inputElemJSRead inputElId+ = [julius| $("#{rawJS inputElId}").val() |](\_ _ -> mempty) instance Inputtable Int where inputElemHtml currentVal hashedId = [hamlet|@@ -684,7 +751,14 @@ <input type="number" id="#{hashedId}" value=#{currentVal} step="any"> |]() -inputBox :: (Inputtable i, JSON.FromJSON i) => i -> IPresentation m i+instance Inputtable String where+ inputElemHtml currentVal hashedId = [hamlet|+ <input type="string" id="#{hashedId}" value=#{currentVal}>+ |]()+ inputElemJSRead inputElId+ = [julius| JSON.stringify($("#{rawJS inputElId}").val()) |](\_ _ -> mempty)++inputBox :: ∀ i m . (Inputtable i, JSON.FromJSON i) => i -> IPresentation m i inputBox iDef = fmap (maybe iDef id) . TweakableInput (Just iDef) $ \path -> let hashedId = base64md5 . BSL.fromStrict $ Txt.encodeUtf8 path inputElId = "input#"++hashedId@@ -693,12 +767,13 @@ let currentVal = case prevInp of Nothing -> iDef Just v -> v+ valueReader = rawJS . renderJavascript $ inputElemJSRead @i inputElId in ( \pPosition -> [julius| $("#{rawJS inputElId}").click(function(e){ e.stopPropagation(); }) $("#{rawJS inputElId}").change(function(e){- currentVal = $("#{rawJS inputElId}").val()+ currentVal = #{valueReader} pChanger = "@{SetValR pPosition path NoValGiven}".slice(0, -1) // The slice hack removes the `NoValGiven`, to@@ -731,12 +806,91 @@ ) ) where leafNm = " input" +dropdownSelect :: ∀ a m . (a -> String) -> [a] -> Int -> IPresentation m a+dropdownSelect valShow options iDef+ | iDef>=0 && iDef<length options+ = fmap ((options!!) . maybe iDef id) . TweakableInput (Just iDef) $ \path ->+ let hashedId = base64md5 . BSL.fromStrict $ Txt.encodeUtf8 path+ selectElId = "select#"++hashedId+ in ( leafNm+ , \prevInp ->+ let currentIndex = case prevInp of+ Nothing -> iDef+ Just i -> i+ in ( \pPosition -> [julius|+ $("#{rawJS selectElId}").click(function(e){+ e.stopPropagation();+ })+ $("#{rawJS selectElId}").change(function(e){+ currentVal = $("#{rawJS selectElId}").val()+ pChanger =+ "@{SetValR pPosition path NoValGiven}".slice(0, -1)+ // The slice hack removes the `NoValGiven`, to+ // be replaced with the actual value:+ + currentVal;+ e.stopPropagation();+ hasErrored = false;+ $.ajax({+ contentType: "application/json",+ processData: false,+ url: pChanger,+ type: "GET",+ dataType: "text",+ success: function(newURL, textStatus, jqXHR) {+ window.location.href = newURL;+ },+ error: function(jqXHR, textStatus, errorThrown) {+ $("body").css("cursor","not-allowed");+ hasErrored = true;+ setTimeout(function() {+ $("body").css("cursor","auto")}, 500);+ }+ });+ setTimeout(function() {+ if (!hasErrored) {$("body").css("cursor","wait")}+ }, 150);+ })+ |]+ , let ixedOptions = zip [0..] $ valShow<$>options+ isCurrentIndex = (==currentIndex)+ in [hamlet|+ <select id="#{hashedId}">+ $forall (i, optionStr) <- ixedOptions+ $if isCurrentIndex i+ <option value="#{i}" selected>+ #{optionStr}+ $else+ <option value="#{i}">+ #{optionStr}+ |]()+ ) )+ | otherwise = error "Default selection for dropdown not included in options list."+ where leafNm = " select"+ infixr 6 $<>-($<>) :: (r ~ (), TMM.SymbolClass σ, TMM.SCConstraint σ LaTeX)++-- | Include a mathematical expression inline in the document.+($<>) :: (r ~ (), TMM.SymbolClass σ, TMM.SCConstraint σ LaTeX, Monad m) => TMM.CAS (TMM.Infix LaTeX) (TMM.Encapsulation LaTeX) (TMM.SymbolD σ LaTeX) -> IPresentation m r -> IPresentation m r ($<>) = (<>) . renderTeXMaths MathML.DisplayInline . TMM.toMathLaTeX +-- | Include a mathematical expression as a “display” in the document, typically used for equations.+-- +-- Example:+-- +-- @+-- "The constant "<>π$<>" fulfills "+-- <>maths [[ sin π⩵0 ]]"."+-- @+-- +-- The maths expressions use TeX-my-maths syntax ("Math.LaTeX.Prelude").+-- Note that TeX-my-maths has different syntax flavours (e.g. @𝑎×𝑒◝γ@ vs. @a * exp gamma@).+-- Both can be used with '$<>' and 'maths', but the downside is type ambiguity+-- in expressions that include no symbols at all (e.g. single numbers), which can lead to+-- @Could not deduce ‘SymbolClass σ’@ compiler errors. To avoid this problem, you+-- can add local type signatures or use the "Presentation.Yeamer.Maths.Unicode.MathLatin_RomanGreek"+-- module. maths :: (r ~ (), TMM.SymbolClass σ, TMM.SCConstraint σ LaTeX) => [[TMM.CAS (TMM.Infix LaTeX) (TMM.Encapsulation LaTeX) (TMM.SymbolD σ LaTeX)]] -> String -> IPresentation m r@@ -795,9 +949,11 @@ -- | Display an image generated on-the-fly in the server. The image will be -- stored temporarily, in a content-indexed fashion.-imageFromFileSupplier :: String -- ^ File extension- -> (FilePath -> IO ()) -- ^ File-writer function- -> IPresentation IO ()+imageFromFileSupplier+ :: String -- ^ File extension+ -> (FilePath -> IO ()) -- ^ File-writer function. This will be called every time+ -- a slide with the image is requested.+ -> IPresentation IO () imageFromFileSupplier ext = includeMediaFile SimpleImage ext . Left -- | Display an image that lies on the server as any ordinary static file.@@ -841,14 +997,13 @@ includeMediaFile :: FileUsageSetup -> FilePath -> Either (FilePath -> IO ()) FilePath -> IPresentation IO ()-includeMediaFile mediaSetup fileExt fileSupp = do+includeMediaFile mediaSetup fileExt fileSupp = DynamicContent $ do let prepareServing file hashLen completeHash = do let linkPath = pStatDir</>take hashLen completeHash<.>takeExtension file isOccupied <- doesPathExist linkPath- absOrig <- makeAbsolute file let codedName = takeBaseName linkPath makeThisLink = do- createFileLink absOrig linkPath+ createFileLink file linkPath return codedName disambiguate | hashLen < length linkPath = prepareServing file (hashLen+1) completeHash@@ -858,26 +1013,33 @@ if isSymlk then do existingTgt <- getSymbolicLinkTarget linkPath- if existingTgt/=absOrig- then disambiguate+ if existingTgt/=file+ then error $ "Hash collision for path `"<>linkPath<>"` between files `"<>existingTgt<>"` and `"<>file<>"`" else return codedName- else disambiguate- else makeThisLink+ else error $ "A non-link file in occupies the needed path `"<>linkPath<>"`"+ else do+ catchIOError makeThisLink $ \e -> do+ if isAlreadyExistsError e+ then do+ removeFile linkPath -- must have been a dead link anyway, else it+ makeThisLink -- would have already triggered `doesPathExist`.+ else+ error $ "Unknown problem when creating link `"<>linkPath<>"`" imgCode <- case fileSupp of- Right file- -> serverSide . prepareServing file 4 . base64md5 . BSL.fromStrict . BC8.pack- $ show file- Left supplier- -> serverSide $ do+ Right file -> do+ absOrig <- canonicalizePath file+ prepareServing absOrig 10 . base64md5 . BSL.fromStrict . BC8.pack+ $ show absOrig+ Left supplier -> do tmpFile <- emptyTempFile pStatDir fileExt supplier tmpFile longHash <- base64md5 <$> BSL.readFile tmpFile let file = pStatDir</>longHash<.>fileExt renameFile tmpFile file- prepareServing file 4 (base64md5 . BSL.fromStrict $ BC8.pack file)+ prepareServing file 10 (base64md5 . BSL.fromStrict $ BC8.pack file) let servableFile = "/pseudostatic"</>imgCode<.>fileExt- in StaticContent $ case mediaSetup of+ return $ case mediaSetup of SimpleImage -> [hamlet| <img src=#{servableFile}> |]() SimpleVideo -> [hamlet| <video src=#{servableFile} controls> |]() CustomFile use -> use servableFile@@ -910,6 +1072,7 @@ ( Maybe r -- Key value this branch yields , Bool ) -- Whether it contains displayable content go _ [] (StaticContent _) = return $ (Just (), True)+ go _ [] (DynamicContent _) = return $ (Just (), True) go (crumbh,choiceName,crumbp) [] (TweakableInput defV twInp) = do let (pathFin, _) = twInp crumbh fullPath = crumbh<>pathFin@@ -1036,6 +1199,7 @@ skipContentless crumbs (Deterministic f c) = fmap f <$> skipContentless crumbs c skipContentless _ (StaticContent _) = return Nothing+ skipContentless _ (DynamicContent _) = return Nothing skipContentless _ (Encaps _ _ _) = return Nothing skipContentless _ p = error $ "`skipContentless` does not support "++outerConstructorName p@@ -1058,6 +1222,7 @@ hasDisplayableContent crumbs (Deterministic f c) = hasDisplayableContent crumbs c hasDisplayableContent _ (StaticContent _) = return True+ hasDisplayableContent _ (DynamicContent _) = return True hasDisplayableContent _ (Encaps _ _ _) = return True hasDisplayableContent _ p = error $ "`hasDisplayableContent` does not support "++outerConstructorName p
Presentation/Yeamer/Internal/Grid.hs view
@@ -86,34 +86,36 @@ type GridRegionId = Int layoutGridP :: Gridded a -> ( GridLayout (GridRegionId, a)- , [(GridRegionId, b)] -> Gridded b )+ , [(GridRegionId, b)] -> (Gridded b, [(GridRegionId, b)]) ) layoutGridP = (`evalState`0) . go where go (GridRegion a) = do i <- get put $ i+1 return ( GridLayout 1 1 [(GridRange 0 1 0 1, (i, a))]- , \[(_, b)] -> GridRegion b )- go (GridDivisions [[GridRegion a₀, GridRegion a₁]]) = do- i <- get- put $ i+2- return ( GridLayout 2 1 [ (GridRange 0 1 0 1, (i, a₀))- , (GridRange 1 2 0 1, (i+1, a₁)) ]- , \[(_,b₀), (_,b₁)] -> GridDivisions [[GridRegion b₀,GridRegion b₁]] )+ , \((_, b):lgrs) -> (GridRegion b, lgrs) ) go (GridDivisions []) = return ( GridLayout 0 0 []- , \[] -> GridDivisions [] )+ , \lgrs -> (GridDivisions [], lgrs) ) go (GridDivisions [row]) = do layouts <- mapM go row return ( alignLayoutDirectional gridWidth xBegin xEnd gridHeight yBegin yEnd (fst<$>layouts)- , undefined )+ , let procLgrs [] acc lgrs = (GridDivisions [acc []], lgrs)+ procLgrs (srow:srows) acc lgrs+ = let (srowRes, lgrs') = srow lgrs+ in procLgrs srows (acc . (srowRes:)) lgrs'+ in procLgrs (snd<$>layouts) id ) go (GridDivisions rows) = do rLayouts <- mapM (go . GridDivisions . pure) rows return ( alignLayoutDirectional gridHeight yBegin yEnd gridWidth xBegin xEnd (fst<$>rLayouts)- , undefined )+ , let procLgrs [] acc lgrs = (GridDivisions $ acc [], lgrs)+ procLgrs (srow:srows) acc lgrs+ = let (GridDivisions [srowRes], lgrs') = srow lgrs+ in procLgrs srows (acc . (srowRes:)) lgrs'+ in procLgrs (snd<$>rLayouts) id ) alignLayoutDirectional :: Lens' (GridLayout a) Int -> Lens' GridRange Int -> Lens' GridRange Int
+ Presentation/Yeamer/Maths/Unicode/MathLatin_RomanGreek.hs view
@@ -0,0 +1,49 @@+-- |+-- Module : Presentation.Yeamer.Maths.Unicode.MathLatin_RomanGreek+-- Copyright : (c) Justus Sagemüller 2017+-- License : GPL v3+-- +-- Maintainer : (@) jsag $ hvl.no+-- Stability : experimental+-- Portability : portable+-- +-- Convenience module, re-exporting the necessary LaTeX builders for writing maths+-- in a Yeamer presentation.++{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}++module Presentation.Yeamer.Maths.Unicode.MathLatin_RomanGreek+ ( module Presentation.Yeamer+ , module Math.LaTeX.Prelude+ , module Math.LaTeX.StringLiterals+ , Presentation.Yeamer.Maths.Unicode.MathLatin_RomanGreek.maths+ , (Presentation.Yeamer.Maths.Unicode.MathLatin_RomanGreek.$<>)+ , Math+ ) where+++import Presentation.Yeamer hiding (($<>), maths)+import qualified Presentation.Yeamer.Maths as YMth+import Math.LaTeX.Prelude hiding ( maths+#if MIN_VERSION_TeX_my_math(0,201,2)+ , ($<>)+#endif+ )+import CAS.Dumb (CAS, Encapsulation, Infix)+import CAS.Dumb.Symbols.Unicode.MathLatin_RomanGreek__BopomofoGaps+ as UnicodeMth+import Math.LaTeX.StringLiterals ()+import Text.LaTeX (LaTeX)++type Math = Expression LaTeX++($<>) :: CAS (Infix LaTeX) (Encapsulation LaTeX) (UnicodeMth.Symbol LaTeX)+ -> Presentation -> Presentation+($<>) = (YMth.$<>)++maths :: r ~ ()+ => [[CAS (Infix LaTeX) (Encapsulation LaTeX) (UnicodeMth.Symbol LaTeX)]]+ -> String -> IPresentation m r+maths = YMth.maths+
test/Main.hs view
@@ -85,6 +85,14 @@ -> fromString ("Sum is "<>show (i+j)) ) + "Dropdown selectors"+ ====== do+ (const() <$> dropdownSelect @Int show [1,3,9] 0+ →│→ \i -> fromString $ "Value is "<>show i)+ ──+ (const() <$> dropdownSelect @String id ["bla","bli","blub"] 2+ →│→ \s -> fromString $ "You say “"<>s<>"”")+ "Code block" ====== [plaintext| bla
yeamer.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: yeamer-version: 0.1.1.0+version: 0.1.2.0 synopsis: Yesod-based server for interactive presentation slides -- description: homepage: https://github.com/leftaroundabout/yeamer@@ -19,13 +19,14 @@ library exposed-modules: Presentation.Yeamer Presentation.Yeamer.Maths+ Presentation.Yeamer.Maths.Unicode.MathLatin_RomanGreek Presentation.Yeamer.Internal.Grid other-modules: Control.Monad.Trans.Writer.JSONable Presentation.Yeamer.Internal.PrPathStepCompression Presentation.Yeamer.Internal.Progress Data.Traversable.Redundancy -- other-extensions: - build-depends: base >=4.8 && <4.14+ build-depends: base >=4.8 && <4.16 , yesod >=1.4 && <1.7 , yesod-form , yesod-static