diff options
author | Yann Herklotz <git@yannherklotz.com> | 2023-05-28 03:52:10 +0100 |
---|---|---|
committer | Yann Herklotz <git@yannherklotz.com> | 2023-05-28 03:52:10 +0100 |
commit | 02d36d9c5c55d49bdfedf29fb9aff9202f19cf53 (patch) | |
tree | 2f8cc931b77aaefaf71eec3cc15f0015496a2dd2 /src/Zettel/Parse.hs | |
parent | 5681d073ee1ded65bcd944c6abc2c7082cff2b31 (diff) | |
download | zk-visual-02d36d9c5c55d49bdfedf29fb9aff9202f19cf53.tar.gz zk-visual-02d36d9c5c55d49bdfedf29fb9aff9202f19cf53.zip |
Add support for bibliography notes export
Diffstat (limited to 'src/Zettel/Parse.hs')
-rw-r--r-- | src/Zettel/Parse.hs | 52 |
1 files changed, 24 insertions, 28 deletions
diff --git a/src/Zettel/Parse.hs b/src/Zettel/Parse.hs index bb08291..943e343 100644 --- a/src/Zettel/Parse.hs +++ b/src/Zettel/Parse.hs @@ -41,27 +41,6 @@ queryHeaderMetaData = query headingAttr | s == "export_date" = "date" | otherwise = s -metaToString :: MetaValue -> Maybe Text -metaToString (MetaString t) = Just t -metaToString _ = Nothing - -metaToInlines :: MetaValue -> Maybe [Inline] -metaToInlines (MetaInlines t) = Just t -metaToInlines _ = Nothing - -metaToTextList :: MetaValue -> Maybe [Text] -metaToTextList (MetaList t) = traverse metaToString t -metaToTextList _ = Nothing - -lookupString :: Text -> Meta -> Maybe Text -lookupString t m = Map.lookup t (unMeta m) >>= metaToString - -lookupInlines :: Text -> Meta -> Maybe [Inline] -lookupInlines t m = Map.lookup t (unMeta m) >>= metaToInlines - -lookupTextList :: Text -> Meta -> Maybe [Text] -lookupTextList t m = Map.lookup t (unMeta m) >>= metaToTextList - removeSpan :: [Inline] -> [Inline] removeSpan = concatMap removeSpan' where @@ -124,6 +103,9 @@ zettelFromPandoc p@(Pandoc attr _) = tags = maybe [] (map ZettelTag) $ lookupTextList "tags" attr cats = maybe [] (map ZettelCat) $ lookupTextList "categories" attr +bibFromPandoc :: Pandoc -> (BibId, Zettel) +bibFromPandoc p = first (\(ZettelId i) -> BibId i) $ zettelFromPandoc p + updatePandocAttr :: Pandoc -> Pandoc updatePandocAttr (Pandoc attr b) = Pandoc @@ -150,14 +132,28 @@ propagateNames :: [((Int, Text), [Chunk])] -> [(Int, Text, Chunk)] propagateNames n = [(i, name, chunk) | ((i, name), namedChunk) <- n, chunk <- namedChunk] -parseZettelKasten :: [(Int, FilePath)] -> IO ZettelGraph -parseZettelKasten fl = do +readFileUtf8 :: FilePath -> IO Text +readFileUtf8 = fmap decode . readFileBS + +readOrgFile :: Text -> IO Pandoc +readOrgFile = runIOorExplode . readOrg (def {readerExtensions = getDefaultExtensions "org"}) + +parseBibliography :: FilePath -> IO [Pandoc] +parseBibliography fp = do + pandoc <- readFileUtf8 fp >>= readOrgFile + let splitChunks = chunkedChunks $ splitIntoChunks "%i.md" False Nothing 1 pandoc + return $ map (updatePandocAttr . pandocFromChunk . (\c -> (8, "bibliography", c))) splitChunks + +parseZettelKasten :: [(Int, FilePath)] -> Maybe FilePath -> IO ZettelGraph +parseZettelKasten fl bibPath = do let names = map (second (T.pack . takeBaseName)) fl - fs <- mapM (readFileBS . snd) fl - orgFiles <- mapM (runIOorExplode . readOrg (def {readerExtensions = getDefaultExtensions "org"}) . decode) fs + fs <- mapM (readFileUtf8 . snd) fl + orgFiles <- mapM readOrgFile fs let splitChunks = map (splitIntoChunks "%i.md" False Nothing 15) orgFiles let chunks = propagateNames . zip names $ map chunkedChunks splitChunks let pandocList = map (updatePandocAttr . pandocFromChunk) chunks - return . refreshPandocMeta $ ZettelGraph (fromList $ map zettelFromPandoc pandocList) Nothing - --- parseBibliography :: FilePath -> IO [Pandoc] + bibliography <- maybe mempty parseBibliography bibPath + return . refreshPandocMeta $ + ZettelGraph + (fromList $ map zettelFromPandoc pandocList) + (fromList $ map bibFromPandoc bibliography) |