Commit 6fb4dd2e authored by Henrik Tramberend's avatar Henrik Tramberend
Browse files

Revert "Fix short links"

This reverts commit 90e88787.
parent 90e88787
......@@ -32,10 +32,11 @@ processPandoc ::
(Pandoc -> Decker Pandoc) ->
FilePath ->
Disposition ->
Provisioning ->
Pandoc ->
Action Pandoc
processPandoc transform base disp pandoc =
evalStateT (transform pandoc) (DeckerState base disp)
processPandoc transform base disp prov pandoc =
evalStateT (transform pandoc) (DeckerState base disp prov)
-- | Split join columns with CSS3. Must be performed after `wrapBoxes`.
splitJoinColumns :: Slide -> Decker Slide
......
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.Decker.Filter.ShortLink
( evaluateShortLinks,
fillTemplate,
evalUrl,
)
where
( evaluateShortLinks
, fillTemplate
, evalUrl
) where
import Data.List
import Data.List.Split
......@@ -15,22 +14,19 @@ import Network.URI
import Relude
import Text.Decker.Internal.Common
import Text.Decker.Internal.Meta
import Text.Decker.Internal.URI (makeProjectPath)
import Text.Pandoc hiding (lookupMeta)
import Text.Pandoc.Walk
evaluateShortLinks :: Pandoc -> Decker Pandoc
evaluateShortLinks pandoc@(Pandoc meta _) = do
base <- gets basePath
return $ walk (evalLinks meta base) pandoc
where
evalLinks :: Meta -> String -> Inline -> Inline
evalLinks meta base (Link attr alt (url, title)) =
Link attr alt (evalUrl meta url, title)
evalLinks meta base (Image attr alt (url, title)) =
let u = toText $ makeProjectPath base (toString url)
in Image attr alt (evalUrl meta u, title)
evalLinks meta base inline = inline
evaluateShortLinks pandoc@(Pandoc meta _) =
return $ walk (evalLinks meta) pandoc
evalLinks :: Meta -> Inline -> Inline
evalLinks meta (Link attr alt (url, title)) =
Link attr alt (evalUrl meta url, title)
evalLinks meta (Image attr alt (url, title)) =
Image attr alt (evalUrl meta url, title)
evalLinks meta inline = inline
evalUrl :: Meta -> Text -> Text
evalUrl meta url =
......
......@@ -15,7 +15,8 @@ doIO = lift . liftIO
data DeckerState = DeckerState
{ basePath :: String,
disposition :: Disposition
disposition :: Disposition,
provisioning :: Provisioning
}
deriving (Eq, Show)
......@@ -48,6 +49,17 @@ data MediaType
| SvgMedia
| StreamMedia
data Provisioning
= -- | Copy to public and relative URL
Copy
| -- | Symbolic link to public and relative URL
SymLink
| -- | Absolute local URL
Absolute
| -- | Relative local URL
Relative
deriving (Eq, Show, Read)
pandocWriterOpts :: WriterOptions
pandocWriterOpts =
def
......
......@@ -303,7 +303,7 @@ extractSupport templateSource = do
context <- actionContext
liftIO $
handleAll (\_ -> return ()) $ do
copySupportFiles templateSource supportDir
copySupportFiles templateSource Copy supportDir
writeFile (supportDir </> ".origin") $ supportId templateSource
correctSupportInstalled :: TemplateSource -> Action Bool
......
......@@ -48,11 +48,10 @@ readAndFilterMarkdownFile disp globalMeta path = do
readMarkdownFile globalMeta path
>>= mergeDocumentMeta globalMeta
>>= processCites
>>= processPandoc evaluateShortLinks docBase disp
>>= calcRelativeResourcePaths docBase
>>= runNewFilter disp examinerFilter docBase
>>= deckerMediaFilter disp docBase
>>= processPandoc deckerPipeline docBase disp
>>= processPandoc deckerPipeline docBase disp Copy
processCites :: MonadIO m => Pandoc -> m Pandoc
processCites pandoc@(Pandoc meta blocks) = liftIO $ do
......@@ -255,7 +254,8 @@ deckerMediaFilter dispo docBase = runDeckerFilter (mediaFilter dispo options) do
-- |  The old style decker filter pipeline.
deckerPipeline =
concatM
[ expandDeckerMacros,
[ evaluateShortLinks,
expandDeckerMacros,
-- , renderCodeBlocks
includeCode,
-- , provisionResources
......
......@@ -79,15 +79,15 @@ parseTemplateUri uri =
| scheme == Nothing -> LocalDir $ toString base
| otherwise -> Unsupported (URI.render uri)
copySupportFiles :: TemplateSource -> FilePath -> IO ()
copySupportFiles DeckerExecutable destination = do
copySupportFiles :: TemplateSource -> Provisioning -> FilePath -> IO ()
copySupportFiles DeckerExecutable _ destination = do
deckerExecutable <- getExecutablePath
extractSubEntries "support" deckerExecutable (takeDirectory destination)
copySupportFiles (LocalZip zipPath) destination =
copySupportFiles (LocalZip zipPath) _ destination =
extractSubEntries "support" zipPath (takeDirectory destination)
copySupportFiles (LocalDir baseDir) destination =
copySupportFiles (LocalDir baseDir) _ destination =
copyDir (baseDir </> "support") destination
copySupportFiles (Unsupported uri) destination =
copySupportFiles (Unsupported uri) provisioning destination =
bug $ ResourceException $ "Unsupported template source: " <> toString uri
defaultMetaPath = "template/default.yaml"
......
Supports Markdown
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