Add new changes

5 files changed, 46 insertions, 67 deletions

diff --git a/.envrc b/.envrc
index 1d953f4..3550a30 100644
--- a/.envrc
+++ b/.envrc
@@ -1 +1 @@
-use nix
+use flake
diff --git a/flake.lock b/flake.lock
index 81b1cac..4cbbb1e 100644
--- a/flake.lock
+++ b/flake.lock
@@ -3,11 +3,11 @@
     "flake-compat": {
       "flake": false,
       "locked": {
-        "lastModified": 1606424373,
-        "narHash": "sha256-oq8d4//CJOrVj+EcOaSXvMebvuTkmBJuT5tzlfewUnQ=",
+        "lastModified": 1650374568,
+        "narHash": "sha256-Z+s0J8/r907g149rllvwhb4pKi8Wam5ij0st8PwAh+E=",
         "owner": "edolstra",
         "repo": "flake-compat",
-        "rev": "99f1c2157fba4bfe6211a321fd0ee43199025dbf",
+        "rev": "b4a34015c698c7793d592d66adbab377907a2be8",
         "type": "github"
       },
       "original": {
@@ -18,11 +18,11 @@
     },
     "flake-utils": {
       "locked": {
-        "lastModified": 1619345332,
-        "narHash": "sha256-qHnQkEp1uklKTpx3MvKtY6xzgcqXDsz5nLilbbuL+3A=",
+        "lastModified": 1659877975,
+        "narHash": "sha256-zllb8aq3YO3h8B/U0/J1WBgAL8EX5yWf5pMj3G0NAmc=",
         "owner": "numtide",
         "repo": "flake-utils",
-        "rev": "2ebf2558e5bf978c7fb8ea927dfaed8fefab2e28",
+        "rev": "c0e246b9b83f637f4681389ecabcb2681b4f3af0",
         "type": "github"
       },
       "original": {
@@ -33,11 +33,11 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1622501949,
-        "narHash": "sha256-pJfBV/uCHjyLAswopXNfX3lOufFcKVuOybJp6t4Luyk=",
+        "lastModified": 1665087388,
+        "narHash": "sha256-FZFPuW9NWHJteATOf79rZfwfRn5fE0wi9kRzvGfDHPA=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "e09bfc5d1c50ca1bcb2c125472a4b641fb85b3df",
+        "rev": "95fda953f6db2e9496d2682c4fc7b82f959878f7",
         "type": "github"
       },
       "original": {
diff --git a/org-zk.cabal b/org-zk.cabal
index d1c7d3e..27197b9 100644
--- a/org-zk.cabal
+++ b/org-zk.cabal
@@ -44,5 +44,6 @@ executable org-zk
     OverloadedStrings
 
   main-is:            Main.hs
+  other-modules:      Zettel
   hs-source-dirs:     src
   default-language:   Haskell2010
diff --git a/src/Main.hs b/src/Main.hs
index 04c234c..c09c4f9 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,55 +1,19 @@
 module Main where
 
-import Data.Char (isAlphaNum, isLetter, isNumber, intToDigit, digitToInt)
+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 Main.Utf8 (withUtf8)
 import qualified Relude.Extra.Map as Map
 import Text.Pandoc.Class (runIOorExplode)
-import Text.Pandoc.Definition (Block (..), Inline (..), Pandoc (..))
+import Text.Pandoc.Definition (Block (..), Inline (..))
 import Text.Pandoc.Readers (readOrg)
-import Text.Pandoc.Writers (writeHtml5String, writeMarkdown)
 import Text.Pandoc.Shared (stringify)
 import Text.Pandoc.Walk (walkM)
 import Numeric (showIntAtBase, readInt)
-
-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)
-
-instance IsString ZettelId where
-  fromString = ZettelId . fromString
-
-instance ToString ZettelId where
-  toString = toString . unZettelId
-
-instance Semigroup ZettelId where
-  ZettelId a <> ZettelId b = ZettelId $ a <> b
-
-instance Monoid ZettelId where
-  mempty = ZettelId mempty
-
-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
-  }
-  deriving (Show, Eq)
-
-instance Semigroup Zettel where
-  Zettel a b c <> Zettel _ _ c' = Zettel a b $ c <> c'
-
-instance Monoid Zettel where
-  mempty = Zettel mempty mempty mempty
+import Zettel
 
 data HeaderState = HeaderState
   { headerStateMap :: Map Text ((ZettelId, Text), [Text]),
@@ -137,34 +101,41 @@ defPredId z =
       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' -> "\"" <> l' <> "\"" <> " -> " <> "\"" <> t <> "\"" <> ";\n") l
+toDot _ (t, l) = foldMap (\l' -> quoted l' <> " -> " <> quoted t <> ";\n") l
 
-toDotNodes :: Text -> Text
-toDotNodes t
+toDotNodes :: ZettelId -> Text
+toDotNodes (ZettelId t)
   | T.null t = ""
-  | isNumber $ T.head t = "\"" <> t <> "\"" <> " [color=" <> T.singleton (T.head t) <> "];\n"
+  | isNumber $ T.head t = quoted t <> " [color=" <> T.singleton (T.head t) <> "];\n"
   | otherwise = ""
 
-addSelfLinks :: ZettelId -> Map Text ((ZettelId, Text), [Text]) -> Map Text ((ZettelId, Text), [Text])
-addSelfLinks z m =
-  Map.insertWith (\((_, _), l') ((z', t), l) -> ((z', t), l ++ l')) (unZettelId z)
+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 :: (a, ((ZettelId, b), [Text])) -> (a, ((ZettelId, b), [Text]))
-addSelfLinks2 (a, ((t, b), l)) =
-  (a, ((t, b), maybeToList (unZettelId <$> defPredId t) <> l))
+addSelfLinks2 :: ((ZettelId, b), [Text]) -> ((ZettelId, b), [Text])
+addSelfLinks2 ((t, b), l) =
+  ((t, b), maybeToList (unZettelId <$> defPredId t) <> l)
 
 main :: IO ()
 main = withUtf8 $ do
-  let fl = ["/Users/yannherklotz/Dropbox/zk/verification.org", "/Users/yannherklotz/Dropbox/zk/mathematics.org", "/Users/yannherklotz/Dropbox/zk/hls.org", "/Users/yannherklotz/Dropbox/zk/computing.org", "/Users/yannherklotz/Dropbox/zk/hardware.org"]
-  fs <- sequence $ readFileText <$> fl
-  x <- sequence $ runIOorExplode . readOrg def <$> fs
+  let fl = ["/home/ymherklotz/Dropbox/zk/verification.org",
+            "/home/ymherklotz/Dropbox/zk/mathematics.org",
+            "/home/ymherklotz/Dropbox/zk/hls.org",
+            "/home/ymherklotz/Dropbox/zk/computing.org",
+            "/home/ymherklotz/Dropbox/zk/hardware.org"]
+  fs <- mapM readFileText fl
+  x <- mapM (runIOorExplode . readOrg def) fs
   let (_, s) = runState (forM x (walkM getHeaders)) (HeaderState mempty "toplevel")
-  let allZettel = map addSelfLinks $ Map.toPairs (headerStateMap s)
+  let allZettel = second nub . addSelfLinks2 <$> headerStateMap s
   writeFileText "out.dot" $ "digraph G {\nnode [colorscheme=pastel28,style=filled];\n"
-    <> fold (toDotNodes . fst <$> allZettel)
-    <> fold (toDot (foldMap (snd . snd) allZettel)
-              . (\(a, (_, b)) -> (a, b)) <$> allZettel)
+    <> 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
diff --git a/src/Zettel.hs b/src/Zettel.hs
index 5c07af9..a576143 100644
--- a/src/Zettel.hs
+++ b/src/Zettel.hs
@@ -1,5 +1,12 @@
 module Zettel where
 
+import Text.Pandoc.Class (runIOorExplode)
+import Text.Pandoc.Definition (Block (..), Inline (..), Pandoc (..))
+import Text.Pandoc.Readers (readOrg)
+import Text.Pandoc.Writers (writeHtml5String, writeMarkdown)
+import Text.Pandoc.Shared (stringify)
+import Text.Pandoc.Walk (walkM)
+
 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.