Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Start removing duplicated links from PandocUtils #7

Draft
wants to merge 1 commit into
base: master
Choose a base branch
from
Draft

Start removing duplicated links from PandocUtils #7

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
87 changes: 45 additions & 42 deletions src/Lib/PandocUtils.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,8 +4,8 @@


module Lib.PandocUtils
( processPandocLinks
, convertVimWikiLinks
{-( processPandocLinks-}
( convertVimWikiLinks
, countWords
, findSummary
, takeNWords
Expand Down Expand Up @@ -171,13 +171,14 @@ parseMarkdown bs =
Right ast -> Right ast


-- TODO: remove -- now outdated and replaced by Monad version
-- | process the pandoc AST so that:
-- * wikilink links are discovered and turned into Pandoc AST links
-- * local links that don't point to any pages are removed.
-- * links are 'fixed up' so they point to the right place in the eventual
-- site.
processPandocAST :: SGS.VimWikiLinkToSM -> TP.Pandoc -> TP.Pandoc
processPandocAST hmap ast = processPandocLinks hmap $ convertVimWikiLinks ast
{-processPandocAST :: SGS.VimWikiLinkToSM -> TP.Pandoc -> TP.Pandoc-}
{-processPandocAST hmap ast = processPandocLinks hmap $ convertVimWikiLinks ast-}


-- take the Pandoc AST (that's probably been processed) and process it to HTML
Expand Down Expand Up @@ -240,26 +241,27 @@ renderWithOneOfEither pandocF f1 f2 ast =
-- The Link, if it's local, will be the filename minus the extension. i.e. we
-- have to add the extension and then try to match it to the filepath

processPandocLinks :: SGS.VimWikiLinkToSM -> TP.Pandoc -> TP.Pandoc
processPandocLinks hmap = TPW.walk (walkLinksInInlines hmap)
-- TODO: remove as replaced by processPandocLinksM in Pandoc.hs
{-processPandocLinks :: SGS.VimWikiLinkToSM -> TP.Pandoc -> TP.Pandoc-}
{-processPandocLinks hmap = TPW.walk (walkLinksInInlines hmap)-}


walkLinksInInlines :: SGS.VimWikiLinkToSM -> [TP.Inline] -> [TP.Inline]
walkLinksInInlines hmap xs = L.concat $ walkLinksInInlines' hmap [] xs
{-walkLinksInInlines :: SGS.VimWikiLinkToSM -> [TP.Inline] -> [TP.Inline]-}
{-walkLinksInInlines hmap xs = L.concat $ walkLinksInInlines' hmap [] xs-}


walkLinksInInlines' :: SGS.VimWikiLinkToSM
-> [[TP.Inline]]
-> [TP.Inline]
-> [[TP.Inline]]
walkLinksInInlines' hmap ds xs =
let (as, bs) = L.break findLink xs
in case bs of
[] -> L.reverse $ as : ds
(b:bs') -> walkLinksInInlines' hmap (maybeRewriteLink hmap b : as : ds) bs'
where
findLink TPD.Link {} = True
findLink _ = False
{-walkLinksInInlines' :: SGS.VimWikiLinkToSM-}
{--> [[TP.Inline]]-}
{--> [TP.Inline]-}
{--> [[TP.Inline]]-}
{-walkLinksInInlines' hmap ds xs =-}
{-let (as, bs) = L.break findLink xs-}
{-in case bs of-}
{-[] -> L.reverse $ as : ds-}
{-(b:bs') -> walkLinksInInlines' hmap (maybeRewriteLink hmap b : as : ds) bs'-}
{-where-}
{-findLink TPD.Link {} = True-}
{-findLink _ = False-}


-- rewrite the Link. Options
Expand All @@ -271,28 +273,29 @@ walkLinksInInlines' hmap ds xs =
-- use Network.URI to detect the whether it is relative or a URI. If it is
-- relative, parse it, pull out the relative bit, and match it against the
-- relative link of the the SourceMetadata items.
maybeRewriteLink :: SGS.VimWikiLinkToSM -> TP.Inline -> [TP.Inline]
maybeRewriteLink hmap link@(TPD.Link attr desc (url, title)) =
let url' = T.unpack url
-- it's a relative reference; they should ALL be within the site
in if NU.isRelativeReference url'
-- can we parse it
then case NU.parseRelativeReference url' of
Nothing -> [link] -- assume it's something else and leave it alone
Just uri -> case HashMap.lookup (strToLower $ NU.uriPath uri) hmap of
-- if we don't find it, then convert it to text
Nothing -> if null desc
then B.toList $ B.text title
else desc
-- otherwise re-write it to the route (or permalink override);
-- note we need to add back in any of the other bits of the url
-- (query and fragment)
Just sm ->
let newUri = show (uri {NU.uriPath=H.resolveLinkFor sm})
in [TPD.Link attr desc (T.pack newUri, title)]
-- it was absolute or something else; thus we just ignore the link
else [link]
maybeRewriteLink _ _ = error "Must only pass a Link to this function"
-- TODO: remove as replaced by maybeRewriteLinkM
{-maybeRewriteLink :: SGS.VimWikiLinkToSM -> TP.Inline -> [TP.Inline]-}
{-maybeRewriteLink hmap link@(TPD.Link attr desc (url, title)) =-}
{-let url' = T.unpack url-}
{--- it's a relative reference; they should ALL be within the site-}
{-in if NU.isRelativeReference url'-}
{--- can we parse it-}
{-then case NU.parseRelativeReference url' of-}
{-Nothing -> [link] -- assume it's something else and leave it alone-}
{-Just uri -> case HashMap.lookup (strToLower $ NU.uriPath uri) hmap of-}
{--- if we don't find it, then convert it to text-}
{-Nothing -> if null desc-}
{-then B.toList $ B.text title-}
{-else desc-}
{--- otherwise re-write it to the route (or permalink override);-}
{--- note we need to add back in any of the other bits of the url-}
{--- (query and fragment)-}
{-Just sm ->-}
{-let newUri = show (uri {NU.uriPath=H.resolveLinkFor sm})-}
{-in [TPD.Link attr desc (T.pack newUri, title)]-}
{--- it was absolute or something else; thus we just ignore the link-}
{-else [link]-}
{-maybeRewriteLink _ _ = error "Must only pass a Link to this function"-}


----
Expand Down
35 changes: 26 additions & 9 deletions test/Lib/PandocUtilsSpecs.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,8 +21,8 @@ import qualified Types.SiteGenState as SGS


-- module under test
import Lib.PandocUtils (convertVimWikiLinks,
processPandocLinks)
import Lib.PandocUtils (convertVimWikiLinks)
{-processPandocLinks)-}


processPandocLinksSpecs :: Spec
Expand Down Expand Up @@ -94,16 +94,33 @@ parse :: Text -> TP.Pandoc
parse = B.doc . B.para . B.text


runProcessPandocLinks :: SGS.VimWikiLinkToSM -> TP.Pandoc -> TP.Pandoc
runProcessPandocLinks hmap = TPW.walk (processPandocLinks hmap)
{-runProcessPandocLinks :: SGS.VimWikiLinkToSM -> TP.Pandoc -> TP.Pandoc-}
{-runProcessPandocLinks hmap = TPW.walk (processPandocLinks hmap)-}


-- convert the wikilinks and then see if we should re-write them
process :: SGS.VimWikiLinkToSM -> TP.Pandoc -> TP.Pandoc
process hmap doc = runProcessPandocLinks hmap $ convertVimWikiLinks doc
{-process :: SGS.VimWikiLinkToSM -> TP.Pandoc -> TP.Pandoc-}
{-process hmap doc = runProcessPandocLinks hmap $ convertVimWikiLinks doc-}


{-runTest :: SGS.VimWikiLinkToSM -> TP.Pandoc -> Text-}
{-runTest hmap x =-}
{-either (error . show) id-}
{-(TP.runPure (TP.writeHtml5String TP.def (process hmap x)))-}


-- need to run tests in a Monad for the Monad version of link management.
{-type PandocSemEffects r-}
{-= ( Member File r-}
{-, Member (Cache Pandoc) r-}
{-, Member (Cache Int) r-}
{-, Member (State SiteGenState) r-}
{-, Member (Reader SiteGenReader) r-}
{-, Member (Reader SiteGenConfig) r-}
{-, Member (Error SiteGenError) r-}
{-, Member (Log LoggingMessage) r-}
{-, Member Print r-}
{-)-}

runTest :: SGS.VimWikiLinkToSM -> TP.Pandoc -> Text
runTest hmap x =
either (error . show) id
(TP.runPure (TP.writeHtml5String TP.def (process hmap x)))
runTest hmap doc = undefined