Commit 6465dfc8 authored by Henrik Tramberend's avatar Henrik Tramberend
Browse files

Bumbling along on the decker monad

parent 6c6fdb34
......@@ -76,6 +76,7 @@ addScript script = do
data DeckerState = DeckerState
{ basePath :: String
, disposition :: Disposition
, provisioning :: Provisioning
, slideCount :: Int
, externalReferences :: [U.URI]
, scripts :: [Script]
......
......@@ -57,9 +57,9 @@ import Text.Printf
import Text.Read
processPandoc ::
(Pandoc -> Decker Pandoc) -> FilePath -> Disposition -> Pandoc -> Action Pandoc
processPandoc transformation basePath disposition pandoc =
evalStateT (transformation pandoc) (DeckerState basePath disposition 0 [] [])
(Pandoc -> Decker Pandoc) -> FilePath -> Disposition -> Provisioning -> Pandoc -> Action Pandoc
processPandoc transformation basePath disposition provisioning pandoc =
evalStateT (transformation pandoc) (DeckerState basePath disposition provisioning 0 [] [])
isSlideHeader :: Block -> Bool
isSlideHeader (Header 1 _ _) = True
......
......@@ -66,22 +66,26 @@ processors =
"\\end{document}")
]
-- | Assumes that the code is stored in a file regardless of origin.
process :: Processor -> FilePath -> Attr -> Decker Inline
d3Canvas :: Processor -> FilePath -> Attr -> Decker Inline
d3Canvas processor sourceFile (eid, classes, keyvals) = do
basePath <- gets basePath
sourceUrl <-
lift $ provisionResource (provisioningFromMeta meta) basePath sourceFile
sourceUrl <- provisionResource sourceFile
addScript $ ScriptURI "javascript" "https://d3js.org/d3.v4.min.js"
addScript $ ScriptSource "javascript" sourceFile
return $ RawInline (Format "html") $ renderHtml $ canvas ! A.id (toValue eid)
bracketCode ::
bracketShakeCompile ::
String -> String -> Processor -> FilePath -> Attr -> Decker Inline
bracketCode preamble postamble processor sourceFile attr = do
let contents = preamble ++ "\n" ++ code ++ "\n" ++ postamble
let path = writeCompiled contents
return $ Image attr [] (path, "")
shakeCompile :: Processor -> FilePath -> Attr -> Decker Inline
shakeCompile processor sourceFile attr =
-- | Calculates the list of all known file extensions that can be rendered into
-- an SVG image.
renderedCodeExtensions :: [String]
......
......@@ -218,8 +218,9 @@ versionCheck meta =
-- template variables and calls need.
readAndProcessMarkdown :: FilePath -> Disposition -> Action Pandoc
readAndProcessMarkdown markdownFile disposition = do
readMetaMarkdown markdownFile >>= processIncludes baseDir >>=
processPandoc pipeline baseDir disposition
Pandoc meta blocks <-
readMetaMarkdown markdownFile >>= processIncludes baseDir
processPandoc pipeline baseDir disposition (provisioningFromMeta meta) pandoc
where
baseDir = takeDirectory markdownFile
pipeline =
......@@ -236,12 +237,10 @@ readAndProcessMarkdown markdownFile disposition = do
-- >>= walkM (cacheRemoteImages (cache dirs))
provisionResources :: Pandoc -> Decker Pandoc
provisionResources pandoc@(Pandoc meta _) =
lift $ do
let method = provisioningFromMeta meta
baseDir <- gets basePath
mapMetaResources (provisionMetaResource method baseDir) pandoc >>=
mapResources (provisionResource method baseDir)
provisionResources pandoc =
lift $
mapMetaResources provisionMetaResource pandoc >>=
mapResources provisionResource
lookupBool :: String -> Bool -> Meta -> Bool
lookupBool key def meta =
......@@ -249,18 +248,19 @@ lookupBool key def meta =
Just (MetaBool b) -> b
_ -> def
provisionMetaResource ::
Provisioning -> FilePath -> (String, FilePath) -> Action FilePath
provisionMetaResource method base (key, path)
provisionMetaResource :: (String, FilePath) -> Decker FilePath
provisionMetaResource (key, path)
| key `elem` runtimeMetaKeys = do
filePath <- urlToFilePathIfLocal base path
provisionResource method base filePath
provisionMetaResource method base (key, path)
base <- gets basePath
filePath <- lift $ urlToFilePathIfLocal base path
provisionResource filePath
provisionMetaResource (key, path)
| key `elem` compiletimeMetaKeys = do
base <- gets basePath
filePath <- urlToFilePathIfLocal base path
need [filePath]
return filePath
provisionMetaResource _ _ (key, path) = return path
provisionMetaResource (key, path) = return path
-- | Determines if a URL can be resolved to a local file. Absolute file URLs are
-- resolved against and copied or linked to public from
......@@ -277,22 +277,25 @@ provisionMetaResource _ _ (key, path) = return path
-- time.
--
-- Returns a public URL relative to base
provisionResource :: Provisioning -> FilePath -> FilePath -> Action FilePath
provisionResource provisioning base path =
provisionResource :: FilePath -> Decker FilePath
provisionResource path = do
base <- gets basePath
method <- gets provisioning
case parseRelativeReference path of
Nothing -> return path
Just uri -> do
dirs <- getProjectDirs
dirs <- lift $ getProjectDirs
need [uriPath uri]
let resource = resourcePathes dirs base uri
publicResource <- getPublicResource
withResource publicResource 1 $ do
withResource publicResource 1 $
lift $
liftIO $
case provisioning of
Copy -> copyResource resource
SymLink -> linkResource resource
Absolute -> absRefResource resource
Relative -> relRefResource base resource
case provisioning of
Copy -> copyResource resource
SymLink -> linkResource resource
Absolute -> absRefResource resource
Relative -> relRefResource base resource
putCurrentDocument :: FilePath -> Action ()
putCurrentDocument out = do
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment