1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
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 = 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 ()
|
