From 084022b1da8e0f0e8c9efb814f32c11903f56969 Mon Sep 17 00:00:00 2001
From: Yann Herklotz <git@yannherklotz.com>
Date: Mon, 8 May 2023 22:53:34 +0100
Subject: Move to using a Combine instance instead of Monoid

---
 src/Main.hs   | 22 +++++++++++----------
 src/Zettel.hs | 63 ++++++++++++++++++++++++++++++++++++++++-------------------
 2 files changed, 55 insertions(+), 30 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index c09c4f9..4a6f2f2 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -5,7 +5,6 @@ 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 (..))
@@ -121,18 +120,21 @@ addSelfLinks2 :: ((ZettelId, b), [Text]) -> ((ZettelId, b), [Text])
 addSelfLinks2 ((t, b), l) =
   ((t, b), maybeToList (unZettelId <$> defPredId t) <> l)
 
+decode :: ByteString -> Text
+decode = decodeUtf8
+
 main :: IO ()
-main = withUtf8 $ do
-  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
+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 {\nnode [colorscheme=pastel28,style=filled];\n"
+  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
diff --git a/src/Zettel.hs b/src/Zettel.hs
index a576143..d754741 100644
--- a/src/Zettel.hs
+++ b/src/Zettel.hs
@@ -1,30 +1,51 @@
+{-# Language GeneralizedNewtypeDeriving #-}
+{-# Language DerivingVia #-}
+{-# Language StandaloneDeriving #-}
+
 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)
+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)
+  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 IsString ZettelId where
-  fromString = ZettelId . fromString
+instance Combine (Maybe a) where
+  cappend Nothing a = a
+  cappend a _ = a
 
-instance ToString ZettelId where
-  toString = toString . unZettelId
+  cempty = Nothing
 
-instance Semigroup ZettelId where
-  ZettelId a <> ZettelId b = ZettelId $ a <> b
+instance Combine ZettelMetadata where
+  cappend (ZettelMetadata c m) (ZettelMetadata c' m') =
+    ZettelMetadata (cappend c c') (cappend m m')
 
-instance Monoid ZettelId where
-  mempty = ZettelId mempty
+  cempty = ZettelMetadata cempty cempty
 
 data Zettel = Zettel
   { -- | The ID that is assigned to the Zettel.
@@ -34,12 +55,14 @@ data Zettel = 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
+    zettelBody :: Pandoc,
+    -- | Zettel metadata which is mostly optional.
+    zettelMetadata :: ZettelMetadata
   }
   deriving (Show, Eq)
 
-instance Semigroup Zettel where
-  Zettel a b c <> Zettel _ _ c' = Zettel a b $ c <> c'
+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')
 
-instance Monoid Zettel where
-  mempty = Zettel mempty mempty mempty
+  cempty = Zettel cempty cempty cempty cempty
-- 
cgit