From b5caa24b94d1b713baf069d808bf5dce665ad7e2 Mon Sep 17 00:00:00 2001
From: Yann Herklotz <git@yannherklotz.com>
Date: Fri, 25 Jun 2021 18:19:46 +0200
Subject: Add initial implementation of Dot graph

---
 src/Main.hs | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 53 insertions(+), 5 deletions(-)

(limited to 'src')

diff --git a/src/Main.hs b/src/Main.hs
index 1490acd..91fa612 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,10 +1,58 @@
-{-# LANGUAGE TypeApplications #-}
-
 module Main where
 
 import Main.Utf8 (withUtf8)
 
+import Text.Pandoc.Readers (readOrg)
+import Text.Pandoc.Walk (walkM)
+import Text.Pandoc.Definition (Block(..), Inline(..))
+import Text.Pandoc.Shared (stringify)
+import Data.Default (def)
+import Text.Pandoc.Class (runIOorExplode)
+import qualified Relude.Extra.Map as Map
+import qualified Data.Text as T
+import Data.Char (isAlphaNum)
+
+data HeaderState = HeaderState { headerStateMap :: Map Text (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 = ""
+
+getHeaders :: Block -> State HeaderState Block
+getHeaders h@(Header _ (a, _, _) t) = do
+  s <- get
+  let m' = Map.insert (stringify t) (a, []) (headerStateMap s)
+  put (HeaderState m' (stringify t))
+  return h
+getHeaders p@(Para i) = do
+  let f = filter isLink i
+  s <- get
+  let m' = Map.insertWith (\(_, x) (w, y) -> (w, x <> y))
+             (headerStateCurrent s)
+             ("", filter (not . T.null) (parseIds . stringify <$> f))
+             (headerStateMap s)
+  put (HeaderState m' (headerStateCurrent s))
+  return p
+getHeaders a = return a
+
+toDot :: (Text, [Text]) -> Text
+toDot (t, []) = "\"" <> t <> "\"" <> ";\n"
+toDot (t, l) = foldMap (\l' -> "\"" <> t <> "\"" <> " -> " <> "\"" <> l' <> "\"" <> ";\n") l
+
 main :: IO ()
-main = do
-  withUtf8 $ do
-    putStrLn . concat $ permutations "Hello World!"
+main = withUtf8 $ do
+  f <- readFileText "random.org"
+  x <- runIOorExplode (readOrg def ("#+options: H:15\n" <> f))
+  let (_, s) = runState (walkM getHeaders x) (HeaderState mempty "toplevel")
+  putTextLn "digraph G {\n"
+  putTextLn $ fold (toDot <$> toList (headerStateMap s))
+  putTextLn "}\n"
+  return ()
-- 
cgit