From a84e7039f5554a6b8cb13a2944ec3bf1d62e26a6 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Mon, 26 Dec 2022 17:07:47 +0000 Subject: Add new changes --- .envrc | 2 +- flake.lock | 18 ++++++------- org-zk.cabal | 1 + src/Main.hs | 85 ++++++++++++++++++++--------------------------------------- src/Zettel.hs | 7 +++++ 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. -- cgit