Add generation for hugo

8 files changed, 685 insertions, 208 deletions

diff --git a/data/markdown.template b/data/markdown.template
new file mode 100644
index 0000000..9a36af3
--- /dev/null
+++ b/data/markdown.template
@@ -0,0 +1,12 @@
++++
+title = "$title/nowrap$"
+$if(date)$date = "$date/nowrap$"
+$endif$$if(author)$author = "$author/nowrap$"
+$endif$tags = [$for(tags)$"$tags$"$sep$, $endfor$]
+categories = [$for(categories)$"$categories$"$sep$, $endfor$]
+backlinks = [$for(backlinks)$"$backlinks$"$sep$, $endfor$]
+forwardlinks = [$for(forwardlinks)$"$forwardlinks$"$sep$, $endfor$]
+$if(custom_id)$customid = "$custom_id$"
+$endif$+++
+
+$body$
diff --git a/org-zk.cabal b/org-zk.cabal
index 27197b9..9bb1d2d 100644
--- a/org-zk.cabal
+++ b/org-zk.cabal
@@ -2,7 +2,7 @@ cabal-version:      2.4
 name:               org-zk
 version:            0.1.0.0
 license:            AGPL-3.0-only
-copyright:          2021 Yann Herklotz
+copyright:          2021-2023 Yann Herklotz
 maintainer:         yann@ymhg.org
 author:             Yann Herklotz
 category:           Web
@@ -21,6 +21,9 @@ extra-source-files:
   LICENSE
   README.md
 
+data-files:
+    data/*.template
+
 executable org-zk
   build-depends:
       base
@@ -30,6 +33,7 @@ executable org-zk
     , relude
     , text
     , with-utf8
+    , directory
 
   mixins:
     base hiding (Prelude),
@@ -45,5 +49,10 @@ executable org-zk
 
   main-is:            Main.hs
   other-modules:      Zettel
+                    , Zettel.Parse
+                    , Zettel.Links
+                    , Zettel.Render
+                    , Zettel.Types
+                    , Paths_org_zk
   hs-source-dirs:     src
   default-language:   Haskell2010
diff --git a/src/Main.hs b/src/Main.hs
index d0bb0e1..7db7885 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,127 +1,203 @@
 module Main where
 
-import Data.Char (isAlphaNum, isLetter, isNumber)
-import Data.Default (def)
-import Data.List (nub)
-import qualified Data.Text as T
-import Data.Text.Read (decimal)
-import Numeric (readInt, showIntAtBase)
-import qualified Relude.Extra.Map as Map
-import Text.Pandoc.Class (runIOorExplode)
-import Text.Pandoc.Definition (Block (..), Inline (..))
-import Text.Pandoc.Readers (readOrg)
-import Text.Pandoc.Shared (stringify)
-import Text.Pandoc.Walk (walkM)
+-- import Data.Char (isAlphaNum, isLetter, isNumber)
+-- import Data.Default (def)
+-- import Data.List (nub)
+-- import qualified Data.Text as T
+-- import Data.Text.Read (decimal)
+-- import Numeric (readInt, showIntAtBase)
+-- import qualified Relude.Extra.Map as Map
+-- import Text.Pandoc.Class (runIOorExplode)
+-- import Text.Pandoc.Definition (Block (..), Inline (..), Pandoc(..), MetaValue(..), Meta(..))
+-- import Text.Pandoc.Readers (readOrg)
+-- import Text.Pandoc.Templates (compileTemplate, WithDefaultPartials(..), Template(..))
+-- import Text.Pandoc.Writers (writeChunkedHTML, writeMarkdown)
+-- import Text.Pandoc.Options (WriterOptions(..))
+-- import Text.Pandoc.Chunks (splitIntoChunks, PathTemplate(..), ChunkedDoc(..), Chunk(..), toTOCTree, tocToList)
+-- import Text.Pandoc.Shared (stringify)
+-- import Text.Pandoc.Walk (walkM, walk)
+-- import qualified Data.ByteString.Lazy as B
+-- import System.Directory (createDirectoryIfMissing)
 import Zettel
 
-data HeaderState = HeaderState
-  { headerStateMap :: Map Text ((ZettelId, Text), [Text]),
-    headerStateCurrent :: Text
-  }
-
-isLink :: Inline -> Bool
-isLink Link {} = True
-isLink _ = False
-
-parseIds :: Text -> Text
-parseIds t
-  | T.null t = ""
-  | T.head t == '#' && T.all isAlphaNum (T.tail t) = T.tail t
-  | otherwise = ""
-
-addLinks :: [Inline] -> Block -> State HeaderState Block
-addLinks il b = do
-  let f = filter isLink il
-  s <- get
-  let m' =
-        Map.insertWith
-          (\(_, y) (z, x) -> (z, x <> y))
-          (headerStateCurrent s)
-          ((mempty, mempty), filter (not . T.null) (parseIds . stringify <$> f))
-          (headerStateMap s)
-  put (HeaderState m' (headerStateCurrent s))
-  return b
-
-getHeaders :: Block -> State HeaderState Block
-getHeaders h@(Header _ (a, _, _) t) = do
-  s <- get
-  let m' = Map.insert a ((ZettelId a, stringify t), []) (headerStateMap s)
-  put (HeaderState m' a)
-  return h
-getHeaders p@(Plain i) = addLinks i p
-getHeaders p@(Para i) = addLinks i p
-getHeaders p@(LineBlock i) = addLinks (concat i) p
-getHeaders p = addLinks [] p
-
-splitId :: ZettelId -> [Text]
-splitId (ZettelId zid)
-  | T.null zid = []
-  | isNumber (T.head zid) = T.takeWhile isNumber zid : (splitId . ZettelId $ T.dropWhile isNumber zid)
-  | isLetter (T.head zid) = T.takeWhile isLetter zid : (splitId . ZettelId $ T.dropWhile isLetter zid)
-  | otherwise = []
-
-combineId :: [Text] -> ZettelId
-combineId = ZettelId . fold
-
-intToDigit26 :: Int -> Char
-intToDigit26 i
-  | i <= 25 && i >= 0 = toEnum $ fromEnum 'a' + i
-  | otherwise = error "Integer out of range."
-
-digitToInt26 :: Char -> Int
-digitToInt26 c = fromEnum c - fromEnum 'a'
-
-fromBase :: Int -> String -> Maybe Int
-fromBase base = fmap fst . viaNonEmpty head . readInt base ((< base) . digitToInt26) digitToInt26
-
-toBase :: Int -> Int -> String
-toBase base num = showIntAtBase base intToDigit26 num ""
-
-opOnBase26 :: (Int -> Int) -> Text -> Maybe Text
-opOnBase26 f t =
-  fromString . toBase 26 . f <$> fromBase 26 (toString t)
-
-opOnIdPart :: (Int -> Int) -> Text -> Maybe Text
-opOnIdPart f t
-  | T.null t = Nothing
-  | isNumber $ T.head t =
-      case decimal t of
-        Right (a, _) -> Just . show $ f a
-        _ -> Nothing
-  | isLetter $ T.head t = opOnBase26 f t
-  | otherwise = Nothing
-
-defPredId :: ZettelId -> Maybe ZettelId
-defPredId z =
-  case nonEmpty (splitId z) of
-    Just ne ->
-      if last ne == "a" || last ne == "1"
-        then Just (combineId (init ne))
-        else combineId . (init ne <>) . (: []) <$> opOnIdPart (subtract 1) (last ne)
-    Nothing -> Nothing
-
-quoted :: Text -> Text
-quoted t = "\"" <> t <> "\""
-
-toDot :: [Text] -> (Text, [Text]) -> Text
-toDot _ (t, l) = foldMap (\l' -> quoted l' <> " -> " <> quoted t <> ";\n") l
-
-toDotNodes :: ZettelId -> Text
-toDotNodes (ZettelId t)
-  | T.null t = ""
-  | isNumber $ T.head t = quoted t <> " [color=" <> T.singleton (T.head t) <> "];\n"
-  | otherwise = ""
-
-addSelfLinks :: Map Text ((ZettelId, Text), [Text]) -> ZettelId -> Map Text ((ZettelId, Text), [Text])
-addSelfLinks m z =
-  Map.insertWith (\((_, _), l') ((z', t), l) -> ((z', t), l ++ l')) (unZettelId z) ((mempty, mempty), [unZettelId z]) m
-
-addSelfLinks2 :: ((ZettelId, b), [Text]) -> ((ZettelId, b), [Text])
-addSelfLinks2 ((t, b), l) =
-  ((t, b), maybeToList (unZettelId <$> defPredId t) <> l)
-
-decode :: ByteString -> Text
-decode = decodeUtf8
+-- data HeaderState = HeaderState
+--  { headerStateMap :: Map Text ((ZettelId, Text), [Text]),
+--    headerStateCurrent :: Text
+--  }
+
+-- isLink :: Inline -> Bool
+-- isLink Link {} = True
+-- isLink _ = False
+--
+-- parseIds :: Text -> Text
+-- parseIds t
+--  | T.null t = ""
+--  | T.head t == '#' && T.all isAlphaNum (T.tail t) = T.tail t
+--  | otherwise = ""
+--
+-- addLinks :: [Inline] -> Block -> State HeaderState Block
+-- addLinks il b = do
+--  let f = filter isLink il
+--  s <- get
+--  let m' =
+--        Map.insertWith
+--          (\(_, y) (z, x) -> (z, x <> y))
+--          (headerStateCurrent s)
+--          ((mempty, mempty), filter (not . T.null) (parseIds . stringify <$> f))
+--          (headerStateMap s)
+--  put (HeaderState m' (headerStateCurrent s))
+--  return b
+--
+-- getHeaders :: Block -> State HeaderState Block
+-- getHeaders h@(Header _ (a, _, _) t) = do
+--  s <- get
+--  let m' = Map.insert a ((ZettelId a, stringify t), []) (headerStateMap s)
+--  put (HeaderState m' a)
+--  return h
+-- getHeaders p@(Plain i) = addLinks i p
+-- getHeaders p@(Para i) = addLinks i p
+-- getHeaders p@(LineBlock i) = addLinks (concat i) p
+-- getHeaders p = addLinks [] p
+--
+-- splitId :: ZettelId -> [Text]
+-- splitId (ZettelId zid)
+--  | T.null zid = []
+--  | isNumber (T.head zid) = T.takeWhile isNumber zid : (splitId . ZettelId $ T.dropWhile isNumber zid)
+--  | isLetter (T.head zid) = T.takeWhile isLetter zid : (splitId . ZettelId $ T.dropWhile isLetter zid)
+--  | otherwise = []
+--
+-- combineId :: [Text] -> ZettelId
+-- combineId = ZettelId . fold
+--
+-- intToDigit26 :: Int -> Char
+-- intToDigit26 i
+--  | i <= 25 && i >= 0 = toEnum $ fromEnum 'a' + i
+--  | otherwise = error "Integer out of range."
+--
+-- digitToInt26 :: Char -> Int
+-- digitToInt26 c = fromEnum c - fromEnum 'a'
+--
+-- fromBase :: Int -> String -> Maybe Int
+-- fromBase base = fmap fst . viaNonEmpty head . readInt base ((< base) . digitToInt26) digitToInt26
+--
+-- toBase :: Int -> Int -> String
+-- toBase base num = showIntAtBase base intToDigit26 num ""
+--
+-- opOnBase26 :: (Int -> Int) -> Text -> Maybe Text
+-- opOnBase26 f t =
+--  fromString . toBase 26 . f <$> fromBase 26 (toString t)
+--
+-- opOnIdPart :: (Int -> Int) -> Text -> Maybe Text
+-- opOnIdPart f t
+--  | T.null t = Nothing
+--  | isNumber $ T.head t =
+--      case decimal t of
+--        Right (a, _) -> Just . show $ f a
+--        _ -> Nothing
+--  | isLetter $ T.head t = opOnBase26 f t
+--  | otherwise = Nothing
+--
+-- defPredId :: ZettelId -> Maybe ZettelId
+-- defPredId z =
+--  case nonEmpty (splitId z) of
+--    Just ne ->
+--      if last ne == "a" || last ne == "1"
+--        then Just (combineId (init ne))
+--        else combineId . (init ne <>) . (: []) <$> opOnIdPart (subtract 1) (last ne)
+--    Nothing -> Nothing
+--
+-- quoted :: Text -> Text
+-- quoted t = "\"" <> t <> "\""
+--
+-- toDot :: [Text] -> (Text, [Text]) -> Text
+-- toDot _ (t, l) = foldMap (\l' -> quoted l' <> " -> " <> quoted t <> ";\n") l
+--
+-- toDotNodes :: ZettelId -> Text
+-- toDotNodes (ZettelId t)
+--  | T.null t = ""
+--  | isNumber $ T.head t = quoted t <> " [color=" <> T.singleton (T.head t) <> "];\n"
+--  | otherwise = ""
+--
+-- addSelfLinks :: Map Text ((ZettelId, Text), [Text]) -> ZettelId -> Map Text ((ZettelId, Text), [Text])
+-- addSelfLinks m z =
+--  Map.insertWith (\((_, _), l') ((z', t), l) -> ((z', t), l ++ l')) (unZettelId z) ((mempty, mempty), [unZettelId z]) m
+--
+-- addSelfLinks2 :: ((ZettelId, b), [Text]) -> ((ZettelId, b), [Text])
+-- addSelfLinks2 ((t, b), l) =
+--  ((t, b), maybeToList (unZettelId <$> defPredId t) <> l)
+--
+-- decode :: ByteString -> Text
+-- decode = decodeUtf8
+--
+-- normaliseHeadings :: Int -> Block -> Block
+-- normaliseHeadings i (Header _ a b) = Header i a b
+-- normaliseHeadings _ a = a
+--
+-- subtractHeadings :: Int -> Block -> Block
+-- subtractHeadings i (Header current a b) = Header (current - i) a b
+-- subtractHeadings _ a = a
+--
+-- removeHeadings :: Block -> Block
+-- removeHeadings (Header _ _ _) = Plain []
+-- removeHeadings a = a
+--
+-- mkLongPath :: ZettelId -> Text
+-- mkLongPath i = fold . intersperse "/" $ splitId i
+--
+-- splitZettel :: Chunk -> Pandoc
+-- splitZettel c =
+--  walk removeHeadings
+--    (Pandoc
+--      (Meta
+--        (fromList [("title", MetaInlines $ chunkHeading c)]))
+--      (chunkContents c))
+--
+-- template :: Text
+-- template = unlines ["+++",
+--                    "title = \"$title$\"",
+--                    "$if(date)$",
+--                    "date = \"$date$\"",
+--                    "$endif$",
+--                    "+++",
+--                    "",
+--                    "$body$"]
+--
+-- main :: IO ()
+-- main = do
+--  let fl =
+--        [ "/Users/ymherklotz/Dropbox/zk/verification.org",
+--          "/Users/ymherklotz/Dropbox/zk/mathematics.org",
+--          "/Users/ymherklotz/Dropbox/zk/hls.org",
+--          "/Users/ymherklotz/Dropbox/zk/computing.org",
+--          "/Users/ymherklotz/Dropbox/zk/hardware.org"
+--        ]
+--  fs <- mapM readFileBS fl
+--  x <- mapM (runIOorExplode . readOrg def . decode) fs
+--  let (_, s) = runState (forM x (walkM getHeaders)) (HeaderState mempty "toplevel")
+--  let allZettel = second nub . addSelfLinks2 <$> headerStateMap s
+--  writeFileText "out.dot" $
+--    "digraph G {\noverlap=false;\nnode [colorscheme=pastel28,style=filled];\n"
+--      <> foldMap (toDotNodes . fst . fst) allZettel
+--      <> foldMap
+--        ( toDot (foldMap snd allZettel)
+--            . (\((ZettelId a, _), b) -> (a, b))
+--        )
+--        allZettel
+--      <> "}\n"
+--
+--  let Just(firstDoc) = viaNonEmpty head x
+----  print firstDoc
+--  let res = splitIntoChunks "%i.md" False Nothing 15 firstDoc
+--  Right templ <- runIOorExplode . runWithDefaultPartials $ compileTemplate "" template
+--  forM_ (chunkedChunks res) $ \c -> do
+--    print (chunkContents c)
+--    let toc = case Map.lookup (chunkId c) allZettel of
+--          Just toLinks ->
+--            [BulletList (map (\x -> [Para [Link mempty [Str ("#" <> x)] ("/" <> x, mempty)]]) (snd toLinks))]
+--          Nothing -> []
+--    text <- runIOorExplode $ writeMarkdown (def { writerTemplate = Just templ }) (splitZettel c)
+--    writeFileText ("test/content/" <> chunkPath c) text
+--
 
 main :: IO ()
 main = do
@@ -132,21 +208,7 @@ main = do
           "/Users/ymherklotz/Dropbox/zk/computing.org",
           "/Users/ymherklotz/Dropbox/zk/hardware.org"
         ]
-  fs <- mapM readFileBS fl
-  x <- mapM (runIOorExplode . readOrg def . decode) fs
-  let (_, s) = runState (forM x (walkM getHeaders)) (HeaderState mempty "toplevel")
-  let allZettel = second nub . addSelfLinks2 <$> headerStateMap s
-  writeFileText "out.dot" $
-    "digraph G {\noverlap=false;\nnode [colorscheme=pastel28,style=filled];\n"
-      <> foldMap (toDotNodes . fst . fst) allZettel
-      <> foldMap
-        ( toDot (foldMap snd allZettel)
-            . (\((ZettelId a, _), b) -> (a, b))
-        )
-        allZettel
-      <> "}\n"
-
---  forM_ allZettel (\(_, ((a, _), _)) -> do
---                      t <- runIOorExplode $ writeMarkdown def p
---                      writeFileText ("neuron/" <> toString a <> ".md") t
---                     )
+  graph <- parseZettelKasten fl
+  let linkedGraph = linkAll graph
+  renderZettelGraphFile "test/content/tree" linkedGraph
+  return ()
diff --git a/src/Zettel.hs b/src/Zettel.hs
index 99c2dd3..c6fe936 100644
--- a/src/Zettel.hs
+++ b/src/Zettel.hs
@@ -1,69 +1,12 @@
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE StandaloneDeriving #-}
-
-module Zettel where
-
-import Text.Pandoc.Definition (Pandoc (..))
-
-class Combine a where
-  cappend :: a -> a -> a
-  cempty :: a
-
-newtype UseCombine a = UC a
-
-instance (Monoid a) => Combine (UseCombine a) where
-  cappend (UC a) (UC b) = UC $ a <> b
-  cempty = UC mempty
-
-deriving via (UseCombine Text) instance Combine Text
-
-deriving via (UseCombine Pandoc) instance Combine Pandoc
-
-newtype ZettelId = ZettelId
-  { -- | The ZettelId is just Text, however, it should also be possible to convert
-    -- it to a list of the ID split up into it's parts.
-    unZettelId :: Text
-  }
-  deriving (Show, Eq, Ord, IsString, ToString, Semigroup, Monoid)
-  deriving (Combine) via (UseCombine ZettelId)
-
-data ZettelMetadata = ZettelMetadata
-  { -- | Optional creation date of the Zettel.e
-    zettelCreationDate :: Maybe Int,
-    -- | Optional last modified date of the Zettel.
-    zettelModifiedDate :: Maybe Int
-  }
-  deriving (Show, Eq)
-
-instance Combine (Maybe a) where
-  cappend Nothing a = a
-  cappend a _ = a
-
-  cempty = Nothing
-
-instance Combine ZettelMetadata where
-  cappend (ZettelMetadata c m) (ZettelMetadata c' m') =
-    ZettelMetadata (cappend c c') (cappend m m')
-
-  cempty = ZettelMetadata cempty cempty
-
-data Zettel = Zettel
-  { -- | The ID that is assigned to the Zettel.
-    zettelId :: !ZettelId,
-    -- | The title of the Zettel, which should also be present in the body, however,
-    -- this is useful to gather metadata about the Zettel.
-    zettelTitle :: !Text,
-    -- | The text body of the Zettel, which is stored as a Pandoc document to make it
-    -- easy to export to other documents.
-    zettelBody :: Pandoc,
-    -- | Zettel metadata which is mostly optional.
-    zettelMetadata :: ZettelMetadata
-  }
-  deriving (Show, Eq)
-
-instance Combine Zettel where
-  cappend (Zettel a b c d) (Zettel a' b' c' d') =
-    Zettel (cappend a a') (cappend b b') (cappend c c') (cappend d d')
-
-  cempty = Zettel cempty cempty cempty cempty
+module Zettel
+  ( module Zettel.Types,
+    module Zettel.Render,
+    module Zettel.Links,
+    module Zettel.Parse,
+  )
+where
+
+import Zettel.Links
+import Zettel.Parse
+import Zettel.Render
+import Zettel.Types
diff --git a/src/Zettel/Links.hs b/src/Zettel/Links.hs
new file mode 100644
index 0000000..6857d45
--- /dev/null
+++ b/src/Zettel/Links.hs
@@ -0,0 +1,158 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+module Zettel.Links where
+
+import Data.Char (isAlphaNum, isLetter, isNumber)
+import Data.List (nub)
+import qualified Data.Map.Strict as Map
+import qualified Data.Text as T
+import Data.Text.Read (decimal)
+import Numeric (readInt, showIntAtBase)
+import Text.Pandoc.Builder (HasMeta (..))
+import Text.Pandoc.Definition (Inline (..), Pandoc (..))
+import Text.Pandoc.Shared (stringify)
+import Text.Pandoc.Walk (query, walk)
+import Zettel.Types
+
+parseIds :: Text -> Text
+parseIds t
+  | T.null t = ""
+  | T.head t == '#' && T.all isAlphaNum (T.tail t) = T.tail t
+  | otherwise = ""
+
+splitId :: ZettelId -> [Text]
+splitId (ZettelId zid)
+  | T.null zid = []
+  | isNumber (T.head zid) = T.takeWhile isNumber zid : (splitId . ZettelId $ T.dropWhile isNumber zid)
+  | isLetter (T.head zid) = T.takeWhile isLetter zid : (splitId . ZettelId $ T.dropWhile isLetter zid)
+  | otherwise = []
+
+combineId :: [Text] -> ZettelId
+combineId = ZettelId . fold
+
+intToDigit26 :: Int -> Char
+intToDigit26 i
+  | i <= 25 && i >= 0 = toEnum $ fromEnum 'a' + i
+  | otherwise = error "Integer out of range."
+
+digitToInt26 :: Char -> Int
+digitToInt26 c = fromEnum c - fromEnum 'a'
+
+fromBase :: Int -> String -> Maybe Int
+fromBase base = fmap fst . viaNonEmpty head . readInt base ((< base) . digitToInt26) digitToInt26
+
+toBase :: Int -> Int -> String
+toBase base num = showIntAtBase base intToDigit26 num ""
+
+opOnBase26 :: (Int -> Int) -> Text -> Maybe Text
+opOnBase26 f t =
+  fromString . toBase 26 . f <$> fromBase 26 (toString t)
+
+opOnIdPart :: (Int -> Int) -> Text -> Maybe Text
+opOnIdPart f t
+  | T.null t = Nothing
+  | isNumber $ T.head t =
+      case decimal t of
+        Right (a, _) -> Just . show $ f a
+        _ -> Nothing
+  | isLetter $ T.head t = opOnBase26 f t
+  | otherwise = Nothing
+
+defPredId :: ZettelId -> Maybe ZettelId
+defPredId z =
+  case nonEmpty (splitId z) of
+    Just ne ->
+      if last ne == "a" || last ne == "1"
+        then Just (combineId (init ne))
+        else combineId . (init ne <>) . (: []) <$> opOnIdPart (subtract 1) (last ne)
+    Nothing -> Nothing
+
+defNextId :: ZettelId -> Maybe ZettelId
+defNextId z =
+  case nonEmpty (splitId z) of
+    Just ne ->
+      combineId . (init ne <>) . (: []) <$> opOnIdPart (+ 1) (last ne)
+    Nothing -> Nothing
+
+defBranchId :: ZettelId -> Maybe ZettelId
+defBranchId (ZettelId t)
+  | T.null t = Nothing
+  | isNumber $ T.last t = Just (ZettelId (t <> "a"))
+  | isLetter $ T.last t = Just (ZettelId (t <> "1"))
+  | otherwise = Nothing
+
+gatherForwardIds :: Inline -> [ZettelId]
+gatherForwardIds (Link _ i _) = [ZettelId . parseIds $ stringify i]
+gatherForwardIds _ = []
+
+addIdPresent :: ZettelGraph -> Maybe ZettelId -> [ZettelId]
+addIdPresent zg (Just ident) =
+  [ident | ident `elem` Map.keys (unZettelGraph zg)]
+addIdPresent _ Nothing = []
+
+forwardLinkNode :: ZettelGraph -> ZettelId -> ZettelNode -> ZettelNode
+forwardLinkNode zg ident zn =
+  zn
+    { zettelNodeNext =
+        nub
+          ( query gatherForwardIds (zn.zettelNodeZettel.zettelBody)
+              <> addIdPresent zg (defNextId ident)
+              <> addIdPresent zg (defBranchId ident)
+          )
+    }
+
+forwardLink :: ZettelGraph -> ZettelGraph
+forwardLink zg = ZettelGraph . Map.mapWithKey (forwardLinkNode zg) $ unZettelGraph zg
+
+backwardLinkNode :: ZettelGraph -> ZettelId -> ZettelNode -> ZettelNode
+backwardLinkNode graph ident node = Map.foldlWithKey' f node (unZettelGraph graph)
+  where
+    f :: ZettelNode -> ZettelId -> ZettelNode -> ZettelNode
+    f l ident' zg
+      | ident `elem` zg.zettelNodeNext =
+          l {zettelNodePrev = ident' : l.zettelNodePrev}
+      | otherwise = l
+
+backwardLink :: ZettelGraph -> ZettelGraph
+backwardLink zg = ZettelGraph . Map.mapWithKey (backwardLinkNode zg) $ unZettelGraph zg
+
+updatePandocLinksInline :: Inline -> Inline
+updatePandocLinksInline l@(Link a i (_, t))
+  | not $ T.null ids = Link a i ("/tree/" <> ids, t)
+  | otherwise = l
+  where
+    ids = parseIds $ stringify i
+updatePandocLinksInline i = i
+
+updatePandocLinksPandoc :: Pandoc -> Pandoc
+updatePandocLinksPandoc = walk updatePandocLinksInline
+
+updatePandocLinksAttr :: [ZettelId] -> [ZettelId] -> Pandoc -> Pandoc
+updatePandocLinksAttr back forw =
+  setMeta "backlinks" back
+    . setMeta "forwardlinks" forw
+
+updatePandocLinksZettel :: Zettel -> Zettel
+updatePandocLinksZettel zg =
+  zg {zettelBody = updatePandocLinksPandoc (zettelBody zg)}
+
+updatePandocLinksZettelNode :: ZettelNode -> ZettelNode
+updatePandocLinksZettelNode zg =
+  zg {zettelNodeZettel = updatePandocLinksZettel (zettelNodeZettel zg)}
+
+updatePandocAttrZettel :: [ZettelId] -> [ZettelId] -> Zettel -> Zettel
+updatePandocAttrZettel back forw zg =
+  zg {zettelBody = updatePandocLinksAttr back forw (zettelBody zg)}
+
+updatePandocAttrZettelNode :: ZettelNode -> ZettelNode
+updatePandocAttrZettelNode zg =
+  zg {zettelNodeZettel = updatePandocAttrZettel (zettelNodePrev zg) (zettelNodeNext zg) (zettelNodeZettel zg)}
+
+updatePandocLinks :: ZettelGraph -> ZettelGraph
+updatePandocLinks zg = ZettelGraph $ updatePandocLinksZettelNode <$> unZettelGraph zg
+
+updatePandocAttrL :: ZettelGraph -> ZettelGraph
+updatePandocAttrL zg = ZettelGraph $ updatePandocAttrZettelNode <$> unZettelGraph zg
+
+linkAll :: ZettelGraph -> ZettelGraph
+linkAll = updatePandocAttrL . backwardLink . forwardLink . updatePandocLinks
diff --git a/src/Zettel/Parse.hs b/src/Zettel/Parse.hs
new file mode 100644
index 0000000..d6d8aa9
--- /dev/null
+++ b/src/Zettel/Parse.hs
@@ -0,0 +1,140 @@
+module Zettel.Parse where
+
+import Data.Default (def)
+import qualified Data.Map.Strict as Map
+import qualified Data.Text as T
+import Text.Pandoc.Builder (toMetaValue)
+import Text.Pandoc.Chunks (Chunk (..), ChunkedDoc (..), splitIntoChunks)
+import Text.Pandoc.Class (runIOorExplode)
+import Text.Pandoc.Definition (Block (..), Inline (..), Meta (..), MetaValue (..), Pandoc (..))
+import Text.Pandoc.Readers (readOrg)
+import Text.Pandoc.Shared (stringify)
+import Text.Pandoc.Walk (query, walk)
+import Zettel.Types
+
+decode :: ByteString -> Text
+decode = decodeUtf8
+
+removeHeadings :: Block -> Block
+removeHeadings Header {} = Plain []
+removeHeadings a = a
+
+removeDiv :: [Block] -> [Block]
+removeDiv = concatMap removeDiv'
+  where
+    removeDiv' (Div _ b') = b'
+    removeDiv' a = [a]
+
+queryHeaderMetaData :: [Block] -> [(Text, MetaValue)]
+queryHeaderMetaData = query headingAttr
+  where
+    headingAttr (Header _ (_, _, l) i) =
+      map (bimap exportDate MetaString) l
+        <> [ ("title", MetaInlines i),
+             ("author", MetaInlines [Str "Yann", Space, Str "Herklotz"])
+           ]
+    headingAttr _ = []
+    exportDate s
+      | 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
+
+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
+
+removeSpan :: [Inline] -> [Inline]
+removeSpan = concatMap removeSpan'
+  where
+    removeSpan' (Span _ _) = []
+    removeSpan' a = [a]
+
+removeMathNL :: Inline -> Inline
+removeMathNL (Math mt t) = Math mt . fold $ T.lines t
+removeMathNL a = a
+
+separateTitleTags :: [Inline] -> ([Inline], [ZettelTag])
+separateTitleTags title =
+  (walk removeSpan $ filter (not . isTagSpan) title, map (ZettelTag . stringify) $ filter isTagSpan title)
+  where
+    isTagSpan (Span (_, l, _) _) = "tag" `elem` l
+    isTagSpan _ = False
+
+parseDate :: Text -> Maybe Text
+parseDate t
+  | T.null t = Just t
+  | T.head t == '[' = viaNonEmpty head . T.words $ T.tail t
+  | otherwise = Just t
+
+parseDateVal :: MetaValue -> Maybe MetaValue
+parseDateVal v = MetaString <$> (metaToString v >>= parseDate)
+
+zettelMetaFromMeta :: [ZettelTag] -> Meta -> ZettelMetadata
+zettelMetaFromMeta t m =
+  ZettelMetadata
+    (lookupString "date" m)
+    (lookupString "modified" m)
+    t
+    []
+
+pandocFromChunk :: Chunk -> Pandoc
+pandocFromChunk c =
+  walk removeMathNL
+    . walk removeDiv
+    . walk removeHeadings
+    . Pandoc
+      (Meta (fromList (("custom_id", 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)
+  where
+    ident = fromMaybe "" $ lookupString "custom_id" attr
+    (title, tags) = maybe ([], []) separateTitleTags $ lookupInlines "title" attr
+
+initNode :: Zettel -> ZettelNode
+initNode zettel = ZettelNode zettel cempty cempty
+
+updatePandocAttr :: Pandoc -> Pandoc
+updatePandocAttr (Pandoc attr b) =
+  Pandoc
+    ( Meta
+        ( Map.insert
+            "tags"
+            tags
+            . Map.update
+              (fmap (MetaInlines . fst . separateTitleTags) . metaToInlines)
+              "title"
+            . Map.update
+              parseDateVal
+              "modified"
+            . Map.update parseDateVal "date"
+            $ unMeta attr
+        )
+    )
+    b
+  where
+    tags =
+      toMetaValue . map unZettelTag $
+        maybe [] (snd . separateTitleTags) $
+          lookupInlines "title" attr
+
+parseZettelKasten :: [FilePath] -> IO ZettelGraph
+parseZettelKasten fl = do
+  fs <- mapM readFileBS fl
+  orgFiles <- mapM (runIOorExplode . readOrg def . decode) fs
+  let splitChunks = map (splitIntoChunks "%i.md" False Nothing 15) orgFiles
+  let pandocList = map (updatePandocAttr . pandocFromChunk) $ concatMap chunkedChunks splitChunks
+  return . ZettelGraph . fromList $ map (second initNode . zettelFromPandoc) pandocList
diff --git a/src/Zettel/Render.hs b/src/Zettel/Render.hs
new file mode 100644
index 0000000..c64a910
--- /dev/null
+++ b/src/Zettel/Render.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+module Zettel.Render where
+
+import Data.Default (def)
+import qualified Data.Map.Strict as Map
+import qualified Data.Text as T
+import Paths_org_zk (getDataFileName)
+import Text.Pandoc.Class (runIOorExplode)
+import Text.Pandoc.Definition (Block (..), Inline (..))
+import Text.Pandoc.Options (WriterOptions (..), multimarkdownExtensions)
+import Text.Pandoc.Templates (WithDefaultPartials (..), compileTemplate)
+import Text.Pandoc.Writers (writeMarkdown)
+import Zettel.Types
+
+zettelIdToLink :: ZettelId -> Inline
+zettelIdToLink ident = Link mempty [Str $ "#" <> unZettelId ident] ("/" <> unZettelId ident, "")
+
+renderZettelLinks :: [ZettelId] -> Block
+renderZettelLinks =
+  BulletList . map (\ident -> [Para [zettelIdToLink ident]])
+
+toInlines :: Text -> [Inline]
+toInlines t = intersperse Space . map Str $ T.words t
+
+renderTitleLinks :: Int -> Text -> [ZettelId] -> [Block]
+renderTitleLinks level title ids =
+  [Header level mempty (toInlines title), renderZettelLinks ids]
+
+renderZettel :: ZettelId -> ZettelNode -> IO Text
+renderZettel _ zettel = do
+  templateFile <- getDataFileName "data/markdown.template"
+  template <- decodeUtf8 <$> readFileBS templateFile
+  Right templ <- runIOorExplode . runWithDefaultPartials $ compileTemplate "" template
+  runIOorExplode $
+    writeMarkdown
+      (def {writerTemplate = Just templ, writerExtensions = multimarkdownExtensions})
+      (zettel.zettelNodeZettel.zettelBody)
+
+renderZettelFile :: FilePath -> ZettelId -> ZettelNode -> IO ()
+renderZettelFile dir ident zettel = do
+  t <- renderZettel ident zettel
+  writeFileText (dir <> "/" <> toString (unZettelId ident <> ".md")) t
+
+renderZettelGraphFile :: FilePath -> ZettelGraph -> IO ()
+renderZettelGraphFile fp zg =
+  forM_ (Map.assocs (unZettelGraph zg)) $ uncurry (renderZettelFile fp)
diff --git a/src/Zettel/Types.hs b/src/Zettel/Types.hs
new file mode 100644
index 0000000..26dee7f
--- /dev/null
+++ b/src/Zettel/Types.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Zettel.Types
+  ( Combine (..),
+    UseCombine (..),
+    ZettelId (..),
+    ZettelCat (..),
+    ZettelTag (..),
+    ZettelMetadata (..),
+    Zettel (..),
+    ZettelNode (..),
+    ZettelGraph (..),
+  )
+where
+
+import Text.Pandoc.Builder (ToMetaValue (..))
+import Text.Pandoc.Definition (Inline (..), Pandoc (..))
+
+class Combine a where
+  cappend :: a -> a -> a
+  cempty :: a
+
+newtype UseCombine a = UC a
+
+instance (Monoid a) => Combine (UseCombine a) where
+  cappend (UC a) (UC b) = UC $ a <> b
+  cempty = UC mempty
+
+deriving via (UseCombine Text) instance Combine Text
+
+deriving via (UseCombine Pandoc) instance Combine Pandoc
+
+deriving via (UseCombine [a]) instance Combine [a]
+
+instance Combine (Maybe a) where
+  cappend Nothing a = a
+  cappend a _ = a
+
+  cempty = Nothing
+
+-- | The ZettelId is just Text, however, it should also be possible to convert
+-- it to a list of the ID split up into it's parts.
+newtype ZettelId = ZettelId {unZettelId :: Text}
+  deriving (Show, Eq, Ord, IsString, ToString, Semigroup, Monoid, ToMetaValue)
+  deriving (Combine) via (UseCombine ZettelId)
+
+newtype ZettelTag = ZettelTag {unZettelTag :: Text}
+  deriving (Show, Eq, Ord, IsString, ToString, Semigroup, Monoid, ToMetaValue)
+  deriving (Combine) via (UseCombine ZettelId)
+
+newtype ZettelCat = ZettelCat {unZettelCat :: Text}
+  deriving (Show, Eq, Ord, IsString, ToString, Semigroup, Monoid, ToMetaValue)
+  deriving (Combine) via (UseCombine ZettelId)
+
+data ZettelMetadata = ZettelMetadata
+  { -- | Optional creation date of the Zettel.
+    zettelCreationDate :: Maybe Text,
+    -- | Optional last modified date of the Zettel.
+    zettelModifiedDate :: Maybe Text,
+    -- | Optional tags.
+    zettelTags :: [ZettelTag],
+    -- | Optional Category
+    zettelCategory :: [ZettelCat]
+  }
+  deriving (Show, Eq)
+
+instance Combine ZettelMetadata where
+  cappend (ZettelMetadata c m t a) (ZettelMetadata c' m' t' a') =
+    ZettelMetadata (cappend c c') (cappend m m') (cappend t t') (cappend a a')
+
+  cempty = ZettelMetadata cempty cempty cempty cempty
+
+data Zettel = Zettel
+  { -- | The title of the Zettel, which should also be present in the body,
+    -- however, this is useful to gather metadata about the Zettel.
+    zettelTitle :: ![Inline],
+    -- | Zettel metadata which is mostly optional.
+    zettelMetadata :: ZettelMetadata,
+    -- | The text body of the Zettel, which is stored as a Pandoc document to
+    -- make it easy to export to other documents.
+    zettelBody :: Pandoc
+  }
+  deriving (Show, Eq)
+
+instance Combine Zettel where
+  cappend (Zettel b c d) (Zettel b' c' d') =
+    Zettel (cappend b b') (cappend c c') (cappend d d')
+
+  cempty = Zettel cempty cempty cempty
+
+data ZettelNode = ZettelNode
+  { zettelNodeZettel :: Zettel,
+    zettelNodeNext :: [ZettelId],
+    zettelNodePrev :: [ZettelId]
+  }
+  deriving (Show, Eq)
+
+instance Combine ZettelNode where
+  cappend (ZettelNode b c d) (ZettelNode b' c' d') =
+    ZettelNode (cappend b b') (cappend c c') (cappend d d')
+
+  cempty = ZettelNode cempty cempty cempty
+
+newtype ZettelGraph = ZettelGraph {unZettelGraph :: Map ZettelId ZettelNode}