From b5caa24b94d1b713baf069d808bf5dce665ad7e2 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Fri, 25 Jun 2021 18:19:46 +0200 Subject: Add initial implementation of Dot graph --- .envrc | 9 +-------- README.md | 27 +-------------------------- flake.nix | 2 ++ org-zk.cabal | 34 ++++++---------------------------- src/Main.hs | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++++----- 5 files changed, 63 insertions(+), 67 deletions(-) diff --git a/.envrc b/.envrc index c9c0b69..1d953f4 100644 --- a/.envrc +++ b/.envrc @@ -1,8 +1 @@ -if type lorri &>/dev/null; then - echo "direnv: using lorri" - eval "$(lorri direnv)" -else - # fall back to using direnv's builtin nix support - # to prevent bootstrapping problems. - use nix -fi +use nix diff --git a/README.md b/README.md index 34523f6..fe5cfcd 100644 --- a/README.md +++ b/README.md @@ -1,26 +1 @@ -# org-zk - -Haskell project template optimized for a fully reproducible and friendly development environment. Based on [Nix](https://notes.srid.ca/haskell-nix) + [Flakes](https://serokell.io/blog/practical-nix-flakes) + VSCode ([HLS](https://github.com/haskell/haskell-language-server)) + [ormolu](https://github.com/tweag/ormolu) autoformatting + [Relude](https://github.com/kowainik/relude#relude) as Prelude. - -## Getting Started - -- [Install Nix](https://nixos.org/download.html) & [enable Flakes](https://nixos.wiki/wiki/Flakes) -- Run `nix-shell --run haskell-language-server` to sanity check your environment -- [Open as single-folder workspace](https://code.visualstudio.com/docs/editor/workspaces#_singlefolder-workspaces) in Visual Studio Code - - Install the [workspace recommended](https://code.visualstudio.com/docs/editor/extension-marketplace#_workspace-recommended-extensions) extensions - - Ctrl+Shift+P to run command "Nix-Env: Select Environment" and select `shell.nix`. The extension will ask you to reload VSCode at the end. -- Press Ctrl+Shift+B in VSCode, or run `bin/run` (`bin/run-via-tmux` if you have tmux installed) in terminal, to launch Ghcid running your program. - -All but the final step need to be done only once. - -Then, before using it for real, - -- Rename all occurrences of `org-zk` to `myproject`, as well as rename the cabal file to `myproject.cabal`. -- Run `git add . && git commit -m rename` followed by `nix develop` (or `bin/run`) to verify that everything continues to work. - -## Other templates - -Some related templates include, - -- [Serokell's Flake template](https://github.com/serokell/templates/tree/master/haskell-cabal2nix) - - [Same, but using haskell.nix](https://github.com/serokell/templates/pull/2) +# Org zettelkasten diff --git a/flake.nix b/flake.nix index 32b480d..4c1d5a6 100644 --- a/flake.nix +++ b/flake.nix @@ -33,6 +33,8 @@ haskell-language-server ormolu pkgs.nixpkgs-fmt + pkgs.zlib.dev + pkgs.zlib ]); }; in diff --git a/org-zk.cabal b/org-zk.cabal index 6ef80cf..d1c7d3e 100644 --- a/org-zk.cabal +++ b/org-zk.cabal @@ -2,9 +2,9 @@ cabal-version: 2.4 name: org-zk version: 0.1.0.0 license: AGPL-3.0-only -copyright: 2021 Sridhar Ratnakumar -maintainer: srid@srid.ca -author: Sridhar Ratnakumar +copyright: 2021 Yann Herklotz +maintainer: yann@ymhg.org +author: Yann Herklotz category: Web -- TODO: Before hackage release. @@ -23,26 +23,12 @@ extra-source-files: executable org-zk build-depends: - , aeson - , async - , base - , bytestring - , containers + base , data-default - , directory - , filepath - , lens - , megaparsec - , monad-logger - , mtl - , neat-interpolation - , profunctors + , pandoc + , pandoc-types , relude - , shower - , tagged , text - , time - , unliftio , with-utf8 mixins: @@ -54,16 +40,8 @@ executable org-zk -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns default-extensions: - FlexibleContexts - FlexibleInstances - KindSignatures LambdaCase - MultiParamTypeClasses - MultiWayIf OverloadedStrings - ScopedTypeVariables - TupleSections - ViewPatterns main-is: Main.hs hs-source-dirs: 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