diff options
Diffstat (limited to 'src/Zettel/Parse.hs')
-rw-r--r-- | src/Zettel/Parse.hs | 52 |
1 files changed, 34 insertions, 18 deletions
diff --git a/src/Zettel/Parse.hs b/src/Zettel/Parse.hs index 6ce74fd..13d8536 100644 --- a/src/Zettel/Parse.hs +++ b/src/Zettel/Parse.hs @@ -11,6 +11,7 @@ import Text.Pandoc.Options (ReaderOptions (..), getDefaultExtensions) import Text.Pandoc.Readers (readOrg) import Text.Pandoc.Shared (stringify) import Text.Pandoc.Walk (query, walk) +import System.FilePath (takeBaseName) import Zettel.Common import Zettel.Types @@ -48,12 +49,19 @@ 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 @@ -80,32 +88,36 @@ parseDate t parseDateVal :: MetaValue -> Maybe MetaValue parseDateVal v = MetaString <$> (metaToString v >>= parseDate) -zettelMetaFromMeta :: [ZettelTag] -> Meta -> ZettelMetadata -zettelMetaFromMeta t m = +zettelMetaFromMeta :: [ZettelTag] -> [ZettelCat] -> Meta -> ZettelMetadata +zettelMetaFromMeta t c m = ZettelMetadata (lookupString "date" m) (lookupString "modified" m) t - cempty + c (Just "Yann Herklotz") -pandocFromChunk :: Chunk -> Pandoc -pandocFromChunk c = +pandocFromChunk :: (Int, Text, Chunk) -> Pandoc +pandocFromChunk (_, t, c) = walk removeMathNL . walk removeDiv . walk removeHeadings . Pandoc - (Meta (fromList (("custom_id", MetaString (chunkId c)) : headingMeta))) + (Meta (fromList (("categories", toMetaValue [t]) + : ("zettelid", MetaString (chunkId c)) + : headingMeta))) $ chunkContents c where headingMeta = queryHeaderMetaData $ chunkContents c zettelFromPandoc :: Pandoc -> (ZettelId, Zettel) zettelFromPandoc p@(Pandoc attr _) = - (ZettelId ident, Zettel title (zettelMetaFromMeta tags attr) p cempty cempty) + (ZettelId ident, Zettel title (zettelMetaFromMeta tags cats attr) p cempty cempty) where - ident = fromMaybe "" $ lookupString "custom_id" attr - (title, tags) = maybe ([], []) separateTitleTags $ lookupInlines "title" attr + ident = fromMaybe "" $ lookupString "zettelid" attr + title = fromMaybe [] $ lookupInlines "title" attr + tags = maybe [] (map ZettelTag) $ lookupTextList "tags" attr + cats = maybe [] (map ZettelCat) $ lookupTextList "categories" attr updatePandocAttr :: Pandoc -> Pandoc updatePandocAttr (Pandoc attr b) = @@ -114,9 +126,9 @@ updatePandocAttr (Pandoc attr b) = ( Map.insert "tags" tags - . Map.update - (fmap (MetaInlines . fst . separateTitleTags) . metaToInlines) + . Map.insert "title" + (MetaInlines title') . Map.update parseDateVal "modified" @@ -126,15 +138,19 @@ updatePandocAttr (Pandoc attr b) = ) b where - tags = - toMetaValue . map unZettelTag $ - maybe [] (snd . separateTitleTags) $ - lookupInlines "title" attr + tags = toMetaValue $ map unZettelTag tags' + (title', tags') = maybe ([], []) separateTitleTags $ lookupInlines "title" attr + +propagateNames :: [((Int, Text), [Chunk])] -> [(Int, Text, Chunk)] +propagateNames n = + [(i, name, chunk) | ((i, name), namedChunk) <- n, chunk <- namedChunk] -parseZettelKasten :: [FilePath] -> IO ZettelGraph +parseZettelKasten :: [(Int, FilePath)] -> IO ZettelGraph parseZettelKasten fl = do - fs <- mapM readFileBS fl + let names = map (second (T.pack . takeBaseName)) fl + fs <- mapM (readFileBS . snd) fl orgFiles <- mapM (runIOorExplode . readOrg (def {readerExtensions = getDefaultExtensions "org"}) . decode) fs let splitChunks = map (splitIntoChunks "%i.md" False Nothing 15) orgFiles - let pandocList = map (updatePandocAttr . pandocFromChunk) $ concatMap chunkedChunks splitChunks + let chunks = propagateNames . zip names $ map chunkedChunks splitChunks + let pandocList = map (updatePandocAttr . pandocFromChunk) chunks return . refreshPandocMeta . ZettelGraph . fromList $ map zettelFromPandoc pandocList |