├── .envrc ├── stack-8.8.2.yaml ├── shell.nix ├── stack.yaml ├── CHANGELOG.md ├── ExampleZettel.md ├── src ├── Types.hs ├── PandocParse.hs └── Neo4JEffect.hs ├── .gitignore ├── LICENSE ├── .travis.yml ├── .github └── workflows │ └── ci.yml ├── default.nix ├── nix ├── sources.json └── sources.nix ├── zettel.cabal ├── README.md └── app └── Main.hs /.envrc: -------------------------------------------------------------------------------- 1 | eval "$(lorri direnv)" -------------------------------------------------------------------------------- /stack-8.8.2.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-15 2 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | (import ./default.nix {}).shell 2 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-14.3 2 | extra-deps: 3 | - polysemy-1.3.0.0 4 | - polysemy-plugin-0.2.5.0 5 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | `zettel` uses [PVP Versioning][1]. 4 | The changelog is available [on GitHub][2]. 5 | 6 | ## 0.0.0.0 7 | 8 | * Initially created. 9 | 10 | [1]: https://pvp.haskell.org 11 | [2]: https://github.com/bolt12/zettel/releases 12 | -------------------------------------------------------------------------------- /ExampleZettel.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Title" 3 | author: A, B 4 | tags: t1, t2 5 | connections: | 6 | [ 7 | { 8 | "id": 12, 9 | "reason": 10 | "Bla Bla" 11 | }, 12 | { 13 | "id": 14, 14 | "reason": "Ble Ble" 15 | } 16 | ] 17 | ... 18 | 19 | ## Content 20 | 21 | Content 22 | -------------------------------------------------------------------------------- /src/Types.hs: -------------------------------------------------------------------------------- 1 | module Types 2 | ( ZettelID (..), 3 | Zettel (..), 4 | Connection (..), 5 | ) 6 | where 7 | 8 | import Data.Text 9 | 10 | newtype ZettelID = ZID {getZID :: Int} deriving (Show, Read, Eq) 11 | 12 | data Zettel 13 | = Zettel 14 | { getId :: ZettelID, 15 | getTimestamp :: Text, 16 | getTitle :: Text, 17 | getAuthors :: [Text], 18 | getZettel :: Text, 19 | getTags :: [Text], 20 | getConnections :: [Connection] 21 | } 22 | deriving (Show, Read, Eq) 23 | 24 | data Connection 25 | = Connection 26 | { getCID :: ZettelID, 27 | getDesc :: Text 28 | } 29 | deriving (Show, Read, Eq) 30 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ### Haskell 2 | dist 3 | dist-* 4 | cabal-dev 5 | *.o 6 | *.hi 7 | *.chi 8 | *.chs.h 9 | *.dyn_o 10 | *.dyn_hi 11 | *.prof 12 | *.aux 13 | *.hp 14 | *.eventlog 15 | .virtualenv 16 | .hsenv 17 | .hpc 18 | .cabal-sandbox/ 19 | cabal.sandbox.config 20 | cabal.config 21 | cabal.project.local 22 | .ghc.environment.* 23 | .HTF/ 24 | # Stack 25 | .stack-work/ 26 | stack.yaml.lock 27 | 28 | ### IDE/support 29 | # Vim 30 | [._]*.s[a-v][a-z] 31 | [._]*.sw[a-p] 32 | [._]s[a-v][a-z] 33 | [._]sw[a-p] 34 | *~ 35 | tags 36 | 37 | # IntellijIDEA 38 | .idea/ 39 | .ideaHaskellLib/ 40 | *.iml 41 | 42 | # Atom 43 | .haskell-ghc-mod.json 44 | 45 | # VS 46 | .vscode/ 47 | 48 | # Emacs 49 | *# 50 | .dir-locals.el 51 | TAGS 52 | 53 | # other 54 | .DS_Store 55 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Armando Santos 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: true 2 | language: haskell 3 | 4 | git: 5 | depth: 5 6 | 7 | cabal: "3.0" 8 | 9 | cache: 10 | directories: 11 | - "$HOME/.cabal/store" 12 | - "$HOME/.stack" 13 | - "$TRAVIS_BUILD_DIR/.stack-work" 14 | 15 | matrix: 16 | include: 17 | - ghc: 8.6.5 18 | - ghc: 8.8.2 19 | 20 | - ghc: 8.6.5 21 | env: STACK_YAML="$TRAVIS_BUILD_DIR/stack.yaml" 22 | 23 | install: 24 | # HLint check 25 | - curl -sSL https://raw.github.com/ndmitchell/neil/master/misc/travis.sh | sh -s -- hlint . -XTypeApplications 26 | 27 | - | 28 | if [ -z "$STACK_YAML" ]; then 29 | cabal update 30 | travis_wait 60 cabal build --enable-tests --enable-benchmarks --write-ghc-environment-files=always 31 | else 32 | curl -sSL https://get.haskellstack.org/ | sh 33 | stack --version 34 | travis_wait 60 stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks 35 | fi 36 | 37 | script: 38 | - | 39 | if [ -z "$STACK_YAML" ]; then 40 | travis_wait 120 cabal test --enable-tests 41 | else 42 | travis_wait 120 stack test --system-ghc 43 | fi 44 | 45 | notifications: 46 | email: false 47 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | # Trigger the workflow on push or pull request, but only for the master branch 4 | on: 5 | pull_request: 6 | push: 7 | branches: [master] 8 | 9 | jobs: 10 | build: 11 | name: ghc ${{ matrix.ghc }} 12 | runs-on: ubuntu-16.04 13 | strategy: 14 | matrix: 15 | cabal: ["3.0"] 16 | ghc: 17 | - "8.6.5" 18 | - "8.8.2" 19 | 20 | steps: 21 | - uses: actions/checkout@v2 22 | if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master' 23 | 24 | - uses: actions/setup-haskell@v1 25 | name: Setup Haskell 26 | with: 27 | ghc-version: ${{ matrix.ghc }} 28 | cabal-version: ${{ matrix.cabal }} 29 | 30 | - uses: actions/cache@v1 31 | name: Cache ~/.cabal/store 32 | with: 33 | path: ~/.cabal/store 34 | key: ${{ runner.os }}-${{ matrix.ghc }}-cabal 35 | 36 | - name: Build 37 | run: | 38 | cabal update 39 | cabal build --enable-tests --enable-benchmarks --write-ghc-environment-files=always 40 | - name: Test 41 | run: | 42 | cabal test --enable-tests 43 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { compiler ? "ghc865" }: 2 | 3 | let 4 | sources = import ./nix/sources.nix; 5 | pkgs = import sources.nixpkgs {}; 6 | 7 | gitignore = pkgs.nix-gitignore.gitignoreSourcePure [ ./.gitignore ]; 8 | 9 | myHaskellPackages = pkgs.haskell.packages.${compiler}.override { 10 | overrides = hself: hsuper: { 11 | "zettel" = 12 | hself.callCabal2nix 13 | "zettel" 14 | (gitignore ./.) 15 | {}; 16 | "polysemy-plugin" = 17 | pkgs.haskell.lib.dontCheck (hself.callHackageDirect { 18 | pkg = sources.polysemy-plugin.name; 19 | ver = sources.polysemy-plugin.version; 20 | sha256 = sources.polysemy-plugin.sha256; 21 | } 22 | {}); 23 | "polysemy" = 24 | pkgs.haskell.lib.dontCheck (hself.callCabal2nix 25 | "polysemy" 26 | sources.polysemy 27 | {}); 28 | 29 | mkDerivation = args: hsuper.mkDerivation (args // { 30 | doCheck = false; 31 | doHaddock = false; 32 | enableLibraryProfiling = false; 33 | enableExecutableProfiling = false; 34 | jailbreak = true; 35 | }); 36 | }; 37 | }; 38 | 39 | shell = myHaskellPackages.shellFor { 40 | packages = p: [ 41 | p."zettel" 42 | ]; 43 | buildInputs = with pkgs.haskellPackages; [ 44 | myHaskellPackages.cabal-install 45 | pkgs.neo4j 46 | (import sources.niv {}).niv 47 | pkgs.nixpkgs-fmt 48 | ]; 49 | withHoogle = true; 50 | }; 51 | 52 | exe = pkgs.haskell.lib.justStaticExecutables (myHaskellPackages."zettel"); 53 | 54 | docker = pkgs.dockerTools.buildImage { 55 | name = "zettel"; 56 | config.Cmd = [ "${exe}/bin/zettel" ]; 57 | }; 58 | in 59 | { 60 | inherit shell; 61 | inherit exe; 62 | inherit docker; 63 | inherit myHaskellPackages; 64 | "zettel" = myHaskellPackages."zettel"; 65 | } 66 | -------------------------------------------------------------------------------- /nix/sources.json: -------------------------------------------------------------------------------- 1 | { 2 | "niv": { 3 | "branch": "master", 4 | "description": "Easy dependency management for Nix projects", 5 | "homepage": "https://github.com/nmattia/niv", 6 | "owner": "nmattia", 7 | "repo": "niv", 8 | "rev": "f73bf8d584148677b01859677a63191c31911eae", 9 | "sha256": "0jlmrx633jvqrqlyhlzpvdrnim128gc81q5psz2lpp2af8p8q9qs", 10 | "type": "tarball", 11 | "url": "https://github.com/nmattia/niv/archive/f73bf8d584148677b01859677a63191c31911eae.tar.gz", 12 | "url_template": "https://github.com///archive/.tar.gz" 13 | }, 14 | "nixpkgs": { 15 | "branch": "nixos-20.03", 16 | "description": "A read-only mirror of NixOS/nixpkgs tracking the released channels. Send issues and PRs to", 17 | "homepage": "https://github.com/NixOS/nixpkgs", 18 | "owner": "NixOS", 19 | "repo": "nixpkgs-channels", 20 | "rev": "6460602eec5ced5b9720f4d9fdb0dd717b89b4fd", 21 | "sha256": "0fk22vc780xf8jza4hcin7f88z1g9gsly5mjhfbygcxfxv334q2i", 22 | "type": "tarball", 23 | "url": "https://github.com/NixOS/nixpkgs-channels/archive/6460602eec5ced5b9720f4d9fdb0dd717b89b4fd.tar.gz", 24 | "url_template": "https://github.com///archive/.tar.gz" 25 | }, 26 | "polysemy": { 27 | "name": "polysemy", 28 | "sha256": "1p75i56qpl0v79vrlzw04117czzgwhn1l0vadvka8m7drmcvwsf6", 29 | "type": "tarball", 30 | "url": "https://hackage.haskell.org/package/polysemy-1.3.0.0/polysemy-1.3.0.0.tar.gz", 31 | "url_template": "https://hackage.haskell.org/package/polysemy-1.3.0.0/polysemy-1.3.0.0.tar.gz", 32 | "version": "1.3.0.0" 33 | }, 34 | "polysemy-plugin": { 35 | "name": "polysemy-plugin", 36 | "sha256": "0jnps8kwxd0hakis5ph77r45mv1qnkxdf5506shcjb1zmxqmxpjv", 37 | "type": "tarball", 38 | "url": "https://hackage.haskell.org/package/polysemy-plugin-0.2.5.0/polysemy-plugin-0.2.5.0.tar.gz", 39 | "url_template": "https://hackage.haskell.org/package/polysemy-plugin-0.2.5.0/polysemy-plugin-0.2.5.0.tar.gz", 40 | "version": "0.2.5.0" 41 | } 42 | } 43 | -------------------------------------------------------------------------------- /zettel.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: zettel 3 | version: 1.0.0.0 4 | synopsis: Zettelkasten file processor 5 | description: Zettelkasten file processor 6 | license: MIT 7 | license-file: LICENSE 8 | author: Armando Santos 9 | maintainer: Armando Santos 10 | copyright: 2020 Armando Santos 11 | build-type: Simple 12 | extra-doc-files: README.md 13 | CHANGELOG.md 14 | tested-with: GHC == 8.6.5 GHC == 8.8.2 15 | 16 | common common-options 17 | build-depends: base >=4.12.0, 18 | polysemy, 19 | polysemy-plugin, 20 | hasbolt, 21 | pandoc, 22 | optparse-generic, 23 | editor-open, 24 | bytestring, 25 | time, 26 | directory, 27 | text, 28 | data-default, 29 | containers, 30 | unordered-containers, 31 | scientific, 32 | vector, 33 | aeson, 34 | pretty-simple 35 | 36 | ghc-options: -Wall 37 | -Wcompat 38 | -Widentities 39 | -Wincomplete-uni-patterns 40 | -Wincomplete-record-updates 41 | -fplugin=Polysemy.Plugin 42 | if impl(ghc >= 8.0) 43 | ghc-options: -Wredundant-constraints 44 | if impl(ghc >= 8.2) 45 | ghc-options: -fhide-source-paths 46 | if impl(ghc >= 8.4) 47 | ghc-options: -Wmissing-export-lists 48 | -Wpartial-fields 49 | if impl(ghc >= 8.8) 50 | ghc-options: -Wmissing-deriving-strategies 51 | 52 | default-language: Haskell2010 53 | 54 | executable zettel 55 | import: common-options 56 | hs-source-dirs: app, 57 | src 58 | main-is: Main.hs 59 | other-modules: Neo4JEffect 60 | PandocParse 61 | Types 62 | 63 | ghc-options: -threaded 64 | -rtsopts 65 | -with-rtsopts=-N 66 | -------------------------------------------------------------------------------- /src/PandocParse.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module PandocParse where 4 | 5 | import Data.Aeson 6 | import Data.Aeson.Types 7 | import qualified Data.HashMap.Strict as HM 8 | import Data.Maybe (fromMaybe) 9 | import Data.Scientific 10 | import qualified Data.Text as T 11 | import qualified Data.Text.Lazy as TL 12 | import qualified Data.Text.Lazy.Encoding as E 13 | import qualified Data.Vector as V 14 | import Text.Pandoc 15 | import Types 16 | 17 | type Timestamp = String 18 | 19 | readZettel :: PandocMonad m => FilePath -> m Pandoc 20 | readZettel f = do 21 | content <- E.decodeUtf8 <$> readFileLazy f 22 | let extension = enableExtension Ext_yaml_metadata_block emptyExtensions 23 | readMarkdown (def {readerExtensions = extension}) (TL.toStrict content) 24 | 25 | createZettel :: PandocMonad m => Timestamp -> Pandoc -> m Zettel 26 | createZettel timestamp p@(Pandoc m _) = do 27 | title <- writePlain def (Pandoc nullMeta [Plain (docTitle m)]) 28 | author <- writePlain def (Pandoc nullMeta [Plain (concat $ docAuthors m)]) 29 | tags <- writePlain def (Pandoc nullMeta [Plain (concat $ docTags m)]) 30 | zettel <- writeMarkdown def p 31 | let res = lookupMeta "connections" m 32 | connections <- case res of 33 | Nothing -> return [] 34 | (Just (MetaBlocks r)) -> do 35 | str <- writePlain def (Pandoc nullMeta r) 36 | return $ toConnections (fromMaybe (Array V.empty) . decode $ E.encodeUtf8 (TL.fromStrict str)) 37 | return 38 | ( Zettel 39 | { getId = ZID 0, 40 | getTimestamp = T.pack timestamp, 41 | getTitle = title, 42 | getAuthors = map T.strip $ T.splitOn "," author, 43 | getZettel = zettel, 44 | getTags = map T.strip $ T.splitOn "," tags, 45 | getConnections = connections 46 | } 47 | ) 48 | 49 | toConnections :: Value -> [Connection] 50 | toConnections (Array l) = V.toList $ V.map toConnection l 51 | 52 | toConnection :: Value -> Connection 53 | toConnection (Object m) = 54 | let i = fromMaybe (-1) . toBoundedInteger . fromNumber . fromMaybe (Number 0) $ "id" `HM.lookup` m 55 | reason = fromString . fromMaybe "" $ "reason" `HM.lookup` m 56 | in Connection 57 | { getCID = ZID i, 58 | getDesc = reason 59 | } 60 | where 61 | fromNumber (Number n) = n 62 | fromString (String s) = s 63 | 64 | docTags :: Meta -> [[Inline]] 65 | docTags meta = 66 | case lookupMeta "tags" meta of 67 | Just (MetaString s) -> [[Str s]] 68 | Just (MetaInlines ils) -> [ils] 69 | Just (MetaList ms) -> 70 | [ils | MetaInlines ils <- ms] 71 | ++ [ils | MetaBlocks [Plain ils] <- ms] 72 | ++ [ils | MetaBlocks [Para ils] <- ms] 73 | ++ [[Str x] | MetaString x <- ms] 74 | _ -> [] 75 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # zettel 2 | 3 | [![built with nix](https://builtwithnix.org/badge.svg)](https://builtwithnix.org) 4 | [![GitHub CI](https://github.com/bolt12/zettel/workflows/CI/badge.svg)](https://github.com/bolt12/zettel/actions) 5 | [![Build status](https://img.shields.io/travis/bolt12/zettel.svg?logo=travis)](https://travis-ci.org/bolt12/zettel) 6 | [![Hackage](https://img.shields.io/hackage/v/zettel.svg?logo=haskell)](https://hackage.haskell.org/package/zettel) 7 | [![Stackage Lts](http://stackage.org/package/zettel/badge/lts)](http://stackage.org/lts/package/zettel) 8 | [![Stackage Nightly](http://stackage.org/package/zettel/badge/nightly)](http://stackage.org/nightly/package/zettel) 9 | [![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE) 10 | 11 | `zettel` is a [Zettelkasten](https://writingcooperative.com/zettelkasten-how-one-german-scholar-was-so-freakishly-productive-997e4e0ca125) file processor. 12 | 13 | ## Requirements 14 | 15 | ### Dependencies 16 | 17 | - GHC 18 | - Cabal / Stack 19 | - Neo4J version 3.X (Version 4 is not supported) 20 | 21 | ### Config file 22 | 23 | `zettel` will attempt to read from `HOME/.config/zettel/zettel-conf` a file which has the 24 | credentials for the Neo4J DB, in the following format: 25 | 26 | ``` 27 | 28 | ``` 29 | 30 | If none the directory nor the file exists, `zettel` will create one with default 31 | credentials `neo4j neo4j`. 32 | 33 | ### Other 34 | 35 | `zettel` requires you to have specified a default text editor. To do so please provide one 36 | by exporting VISUAL or EDITOR environment variables: 37 | 38 | > export EDITOR=vim 39 | 40 | By default it will use `vi`. 41 | 42 | ## Quick Start 43 | 44 | ```shell 45 | > zettel -h 46 | Zettelkasten processor 47 | 48 | Usage: zettel (new | list | find | delete | edit) 49 | 50 | Available options: 51 | -h,--help Show this help text 52 | 53 | Available commands: 54 | new 55 | list 56 | find 57 | delete 58 | edit 59 | ``` 60 | 61 | The `new` command will open your default editor so you can write your zettelkasten. On 62 | save the file will be parsed and insert it on the DB. 63 | 64 | The `list` command requires a `--size=` flag and lists all your zettels. 65 | 66 | The `find` command requires a `--tags` flag and finds all zettels that have at least one 67 | of the specified tags in common. __NOTE:__ to search for multiple tags do `zettel find 68 | --tags tag1 --tags tag2`, for example. 69 | 70 | The `delete` command requires a `--did` flag and deletes the zettel with the specified id. 71 | 72 | The `edit` command requires a `--eid` flag and opens the zettel file of the specified id. 73 | __NOTE:__ If any zettel has a connection to the zettel to be edited than it is not 74 | possible to edit that zettel (Editing a zettel will not change its timestamp). 75 | 76 | Your Zettels will be stored in `HOME/.config/zettel/`. 77 | 78 | ## Meta Data 79 | 80 | Zettel Metadata follows the YAML syntax as you can see in the `ExampleZettel.md`. 81 | 82 | Supported fields: 83 | 84 | - `title`: specifies the zettel title 85 | - `authors`: specifies the zettel authors 86 | - `tags`: specifies the zettel tags 87 | - `connections`: specifies the connections to other zettels in the following format 88 | example: 89 | ```YAML 90 | [ 91 | { 92 | "id": 2, 93 | "reason": "text" 94 | } 95 | ] 96 | ``` 97 | 98 | ## Beta 99 | 100 | Please note that this is still a beta version. Please report any issue via Github Issue. 101 | 102 | PRs are welcome! 103 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE AllowAmbiguousTypes #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE DeriveAnyClass #-} 4 | {-# LANGUAGE DeriveGeneric #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# LANGUAGE ScopedTypeVariables #-} 8 | {-# LANGUAGE StandaloneDeriving #-} 9 | {-# LANGUAGE TypeApplications #-} 10 | {-# LANGUAGE TypeOperators #-} 11 | 12 | module Main 13 | ( main, 14 | ) 15 | where 16 | 17 | import Control.Exception (Exception, IOException, SomeException, catch) 18 | import qualified Data.ByteString as B 19 | import Data.ByteString hiding (map, pack, unpack) 20 | import qualified Data.Text as TT (unpack) 21 | import Data.Text (pack) 22 | import qualified Data.Text.Lazy as TL (unpack) 23 | import qualified Data.Time as T 24 | import Data.Time.Format 25 | import qualified Database.Bolt as DB 26 | import Neo4JEffect 27 | import Options.Generic 28 | import PandocParse 29 | import Polysemy 30 | import Polysemy.Error hiding (catch) 31 | import Polysemy.Trace 32 | import System.Directory 33 | import System.Environment 34 | import Text.Editor 35 | import Text.Pandoc hiding (trace) 36 | import Text.Pretty.Simple (pShow) 37 | import Types 38 | 39 | data Options w 40 | = New 41 | | List 42 | { size :: w ::: Int "List size" 43 | } 44 | | Find 45 | { tags :: w ::: [String] "Tags to search for" 46 | } 47 | | Delete 48 | { did :: w ::: Int "Zettel id to delete" 49 | } 50 | | Edit 51 | { eid :: w ::: Int "Zettel id to edit" 52 | } 53 | deriving (Generic) 54 | 55 | instance ParseRecord (Options Wrapped) 56 | 57 | deriving instance Show (Options Unwrapped) 58 | 59 | data ZettelError 60 | = P PandocError 61 | | D DependenciesFoundError 62 | | N NodeNotFoundError 63 | | C ConnectionError 64 | deriving (Show, Exception) 65 | 66 | template :: ByteString 67 | template = 68 | "\ 69 | \---\n\ 70 | \title: \"Test Zettel\"\n\ 71 | \author: A, B\n\ 72 | \tags: T1, T2\n\ 73 | \connections: |\n\ 74 | \ [\n\ 75 | \ {\n\ 76 | \ \"id\": -1,\n\ 77 | \ \"reason\": \"\"\n\ 78 | \ }\n\ 79 | \ ]\n\ 80 | \...\n\ 81 | \\n\ 82 | \## Content\n" 83 | 84 | mainProg :: Members '[Neo4J, Error ZettelError, Trace, Embed IO] r => Sem r () 85 | mainProg = do 86 | x <- unwrapRecord "Zettelkasten processor" 87 | case x of 88 | List s -> do 89 | r <- listNodes s 90 | trace . TL.unpack . pShow $ r 91 | New -> do 92 | r <- embed $ runUserEditorDWIM markdownTemplate template 93 | timestamp <- embed T.getCurrentTime 94 | home <- embed $ getEnv "HOME" 95 | let formated = formatTime defaultTimeLocale "%d-%m-%YT%H:%M:%S" timestamp 96 | filename = formated ++ ".md" 97 | zettelsFile = home ++ "/.config/zettel/" ++ filename 98 | embed $ B.writeFile zettelsFile r 99 | p <- embed . runIO $ readZettel zettelsFile 100 | case p of 101 | Left e -> throw $ P e 102 | Right pandoc -> do 103 | zettel <- embed . runIO $ createZettel formated pandoc 104 | case zettel of 105 | Left e -> throw $ P e 106 | Right z -> createNode z 107 | Find t -> do 108 | r <- findNodes t 109 | trace . TL.unpack . pShow $ r 110 | Delete zid -> deleteNode (ZID zid) 111 | Edit zid -> do 112 | home <- embed $ getEnv "HOME" 113 | zt <- getNode (ZID zid) 114 | case zt of 115 | Nothing -> throw . N $ NodeNotFoundError "No Zettel with given ID found" 116 | (Just z) -> do 117 | let filename = TT.unpack (getTimestamp z) ++ ".md" 118 | filepath = home ++ "/.config/zettel/" ++ filename 119 | r <- embed $ runUserEditorDWIMFile markdownTemplate filepath 120 | embed $ B.writeFile filepath r 121 | p <- embed . runIO $ readZettel filepath 122 | case p of 123 | Left e -> throw $ P e 124 | Right pandoc -> do 125 | zettel <- embed . runIO $ createZettel (TT.unpack $ getTimestamp z) pandoc 126 | case zettel of 127 | Left e -> throw $ P e 128 | Right z -> editNode (z {getId = ZID zid}) 129 | 130 | runMain :: User -> Password -> IO (Either ZettelError ()) 131 | runMain user pass = 132 | runM 133 | . runError @ZettelError 134 | . mapError C 135 | . mapError D 136 | . neo4jToIO user pass 137 | . traceToIO 138 | $ mainProg 139 | 140 | main :: IO () 141 | main = do 142 | home <- getEnv "HOME" 143 | b <- doesFileExist (home ++ "/.config/zettel/zettel-conf") 144 | [user, pass] <- 145 | map pack 146 | <$> if b 147 | then words <$> Prelude.readFile (home ++ "/.config/zettel/zettel-conf") 148 | else do 149 | createDirectoryIfMissing False (home ++ "/.config/zettel") 150 | Prelude.writeFile 151 | (home ++ "/.config/zettel/zettel-conf") 152 | "neo4j neo4j" 153 | return ["neo4j", "neo4j"] 154 | r <- runMain user pass 155 | case r of 156 | Left e -> error (show e) 157 | Right x -> return x 158 | -------------------------------------------------------------------------------- /nix/sources.nix: -------------------------------------------------------------------------------- 1 | # This file has been generated by Niv. 2 | 3 | let 4 | 5 | # 6 | # The fetchers. fetch_ fetches specs of type . 7 | # 8 | 9 | fetch_file = pkgs: spec: 10 | if spec.builtin or true then 11 | builtins_fetchurl { inherit (spec) url sha256; } 12 | else 13 | pkgs.fetchurl { inherit (spec) url sha256; }; 14 | 15 | fetch_tarball = pkgs: name: spec: 16 | let 17 | ok = str: ! builtins.isNull (builtins.match "[a-zA-Z0-9+-._?=]" str); 18 | # sanitize the name, though nix will still fail if name starts with period 19 | name' = stringAsChars (x: if ! ok x then "-" else x) "${name}-src"; 20 | in 21 | if spec.builtin or true then 22 | builtins_fetchTarball { name = name'; inherit (spec) url sha256; } 23 | else 24 | pkgs.fetchzip { name = name'; inherit (spec) url sha256; }; 25 | 26 | fetch_git = spec: 27 | builtins.fetchGit { url = spec.repo; inherit (spec) rev ref; }; 28 | 29 | fetch_local = spec: spec.path; 30 | 31 | fetch_builtin-tarball = name: throw 32 | ''[${name}] The niv type "builtin-tarball" is deprecated. You should instead use `builtin = true`. 33 | $ niv modify ${name} -a type=tarball -a builtin=true''; 34 | 35 | fetch_builtin-url = name: throw 36 | ''[${name}] The niv type "builtin-url" will soon be deprecated. You should instead use `builtin = true`. 37 | $ niv modify ${name} -a type=file -a builtin=true''; 38 | 39 | # 40 | # Various helpers 41 | # 42 | 43 | # The set of packages used when specs are fetched using non-builtins. 44 | mkPkgs = sources: 45 | let 46 | sourcesNixpkgs = 47 | import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) {}; 48 | hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath; 49 | hasThisAsNixpkgsPath = == ./.; 50 | in 51 | if builtins.hasAttr "nixpkgs" sources 52 | then sourcesNixpkgs 53 | else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then 54 | import {} 55 | else 56 | abort 57 | '' 58 | Please specify either (through -I or NIX_PATH=nixpkgs=...) or 59 | add a package called "nixpkgs" to your sources.json. 60 | ''; 61 | 62 | # The actual fetching function. 63 | fetch = pkgs: name: spec: 64 | 65 | if ! builtins.hasAttr "type" spec then 66 | abort "ERROR: niv spec ${name} does not have a 'type' attribute" 67 | else if spec.type == "file" then fetch_file pkgs spec 68 | else if spec.type == "tarball" then fetch_tarball pkgs name spec 69 | else if spec.type == "git" then fetch_git spec 70 | else if spec.type == "local" then fetch_local spec 71 | else if spec.type == "builtin-tarball" then fetch_builtin-tarball name 72 | else if spec.type == "builtin-url" then fetch_builtin-url name 73 | else 74 | abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}"; 75 | 76 | # Ports of functions for older nix versions 77 | 78 | # a Nix version of mapAttrs if the built-in doesn't exist 79 | mapAttrs = builtins.mapAttrs or ( 80 | f: set: with builtins; 81 | listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set)) 82 | ); 83 | 84 | # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/lists.nix#L295 85 | range = first: last: if first > last then [] else builtins.genList (n: first + n) (last - first + 1); 86 | 87 | # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L257 88 | stringToCharacters = s: map (p: builtins.substring p 1 s) (range 0 (builtins.stringLength s - 1)); 89 | 90 | # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269 91 | stringAsChars = f: s: concatStrings (map f (stringToCharacters s)); 92 | concatStrings = builtins.concatStringsSep ""; 93 | 94 | # fetchTarball version that is compatible between all the versions of Nix 95 | builtins_fetchTarball = { url, name, sha256 }@attrs: 96 | let 97 | inherit (builtins) lessThan nixVersion fetchTarball; 98 | in 99 | if lessThan nixVersion "1.12" then 100 | fetchTarball { inherit name url; } 101 | else 102 | fetchTarball attrs; 103 | 104 | # fetchurl version that is compatible between all the versions of Nix 105 | builtins_fetchurl = { url, sha256 }@attrs: 106 | let 107 | inherit (builtins) lessThan nixVersion fetchurl; 108 | in 109 | if lessThan nixVersion "1.12" then 110 | fetchurl { inherit url; } 111 | else 112 | fetchurl attrs; 113 | 114 | # Create the final "sources" from the config 115 | mkSources = config: 116 | mapAttrs ( 117 | name: spec: 118 | if builtins.hasAttr "outPath" spec 119 | then abort 120 | "The values in sources.json should not have an 'outPath' attribute" 121 | else 122 | spec // { outPath = fetch config.pkgs name spec; } 123 | ) config.sources; 124 | 125 | # The "config" used by the fetchers 126 | mkConfig = 127 | { sourcesFile ? ./sources.json 128 | , sources ? builtins.fromJSON (builtins.readFile sourcesFile) 129 | , pkgs ? mkPkgs sources 130 | }: rec { 131 | # The sources, i.e. the attribute set of spec name to spec 132 | inherit sources; 133 | 134 | # The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers 135 | inherit pkgs; 136 | }; 137 | in 138 | mkSources (mkConfig {}) // { __functor = _: settings: mkSources (mkConfig settings); } 139 | -------------------------------------------------------------------------------- /src/Neo4JEffect.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE GADTs #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE PolyKinds #-} 7 | {-# LANGUAGE Rank2Types #-} 8 | {-# LANGUAGE ScopedTypeVariables #-} 9 | {-# LANGUAGE TemplateHaskell #-} 10 | {-# LANGUAGE TypeApplications #-} 11 | {-# LANGUAGE TypeOperators #-} 12 | 13 | module Neo4JEffect where 14 | 15 | import Control.Exception (SomeException) 16 | import Control.Monad 17 | import Data.Default 18 | import Data.Map 19 | import Data.Text 20 | import qualified Database.Bolt as B 21 | import Polysemy 22 | import Polysemy.Error 23 | import Types 24 | 25 | type User = Text 26 | 27 | type Password = Text 28 | 29 | type Tags = String 30 | 31 | data Neo4J m a where 32 | CreateNode :: Zettel -> Neo4J m () 33 | CreateRelation :: ZettelID -> ZettelID -> Text -> Neo4J m () 34 | GetNode :: ZettelID -> Neo4J m (Maybe Zettel) 35 | ListNodes :: Int -> Neo4J m [Zettel] 36 | FindNodes :: [Tags] -> Neo4J m [Zettel] 37 | DeleteNode :: ZettelID -> Neo4J m () 38 | EditNode :: Zettel -> Neo4J m () 39 | 40 | makeSem ''Neo4J 41 | 42 | newtype DependenciesFoundError = DependenciesFoundError String 43 | deriving (Show) 44 | 45 | newtype NodeNotFoundError = NodeNotFoundError String 46 | deriving (Show) 47 | 48 | newtype ConnectionError = ConnectionError String 49 | deriving (Show) 50 | 51 | errorMsg :: String 52 | errorMsg = "Failed to connect to DB.\n" 53 | ++ "Please check your credentials and make sure Neo4J is running." 54 | 55 | neo4jToIO :: 56 | User -> 57 | Password -> 58 | Members '[Error DependenciesFoundError, Error ConnectionError, Embed IO] r => 59 | Sem (Neo4J ': r) a -> 60 | Sem r a 61 | neo4jToIO user pass = 62 | interpret 63 | ( \case 64 | CreateNode zettel -> do 65 | pipe <- 66 | fromExceptionVia @SomeException 67 | (const $ ConnectionError errorMsg) 68 | (B.connect (def {B.user = user, B.password = pass})) 69 | B.run pipe $ 70 | B.queryP_ 71 | "CREATE (node:Zettel { timestamp: {ts}, title: {t}, authors: {a}, zettel: {z}, tags: {tg} })" 72 | ( fromList 73 | [ ("ts", B.T $ getTimestamp zettel), 74 | ("t", B.T $ getTitle zettel), 75 | ("a", B.L . Prelude.map B.T . getAuthors $ zettel), 76 | ("z", B.T $ getZettel zettel), 77 | ("tg", B.L . Prelude.map B.T . getTags $ zettel) 78 | ] 79 | ) 80 | if Prelude.null (getConnections zettel) 81 | then B.close pipe 82 | else do 83 | r <- 84 | B.run pipe $ 85 | B.queryP 86 | "MATCH (z:Zettel) WHERE z.timestamp = {ts} return z" 87 | ( fromList 88 | [("ts", B.T $ getTimestamp zettel)] 89 | ) 90 | B.close pipe 91 | let newZettelId = getId . toZettel . (! "z") . Prelude.head $ r 92 | mapM_ 93 | (\c -> neo4jToIO user pass $ createRelation newZettelId (getCID c) (getDesc c)) 94 | (getConnections zettel) 95 | CreateRelation (ZID id1) (ZID id2) t -> do 96 | pipe <- 97 | fromExceptionVia @SomeException 98 | (const $ ConnectionError errorMsg) 99 | (B.connect (def {B.user = user, B.password = pass})) 100 | x <- B.run pipe $ 101 | B.queryP_ 102 | ( "MATCH (z1:Zettel) WHERE ID(z1)={id1}\n" 103 | `append` "MATCH (z2:Zettel) WHERE ID(z2)={id2}\n" 104 | `append` "CREATE (z1)-[:RELATES { reason: {desc} }]->(z2)" 105 | ) 106 | ( fromList 107 | [ ("id1", B.I id1), 108 | ("id2", B.I id2), 109 | ("desc", B.T t) 110 | ] 111 | ) 112 | B.close pipe 113 | return x 114 | GetNode (ZID i) -> do 115 | pipe <- 116 | fromExceptionVia @SomeException 117 | (const $ ConnectionError errorMsg) 118 | (B.connect (def {B.user = user, B.password = pass})) 119 | r <- 120 | B.run pipe $ 121 | B.queryP 122 | "MATCH (z:Zettel) WHERE ID(z)={id} return z" 123 | (fromList [("id", B.I i)]) 124 | B.close pipe 125 | if Prelude.null r 126 | then return Nothing 127 | else return . Just . toZettel . (! "z") . Prelude.head $ r 128 | ListNodes s -> do 129 | pipe <- 130 | fromExceptionVia @SomeException 131 | (const $ ConnectionError errorMsg) 132 | (B.connect (def {B.user = user, B.password = pass})) 133 | r <- 134 | B.run pipe $ 135 | B.queryP 136 | "MATCH (z:Zettel) RETURN z LIMIT {size}" 137 | (fromList [("size", B.I s)]) 138 | B.close pipe 139 | return . Prelude.map (toZettel . (! "z")) $ r 140 | FindNodes tags -> do 141 | pipe <- 142 | fromExceptionVia @SomeException 143 | (const $ ConnectionError errorMsg) 144 | (B.connect (def {B.user = user, B.password = pass})) 145 | r <- 146 | B.run pipe $ 147 | B.queryP 148 | "MATCH (z:Zettel) WHERE size([tag IN {tags} WHERE tag IN z.tags | 1]) > 0 RETURN z" 149 | (fromList [("tags", B.L . Prelude.map (B.T . pack) $ tags)]) 150 | B.close pipe 151 | return . Prelude.map (toZettel . (! "z")) $ r 152 | DeleteNode (ZID zid) -> do 153 | pipe <- 154 | fromExceptionVia @SomeException 155 | (const $ ConnectionError errorMsg) 156 | (B.connect (def {B.user = user, B.password = pass})) 157 | r <- 158 | B.run pipe $ 159 | B.queryP 160 | ( "MATCH (z:Zettel) WHERE ID(z)={zid}\n" 161 | `append` "MATCH p=()-->(z) RETURN p" 162 | ) 163 | (fromList [("zid", B.I zid)]) 164 | if not (Prelude.null r) 165 | then B.close pipe >> throw (DependenciesFoundError "There are nodes which relate to this Zettel") 166 | else do 167 | -- Delete connections 168 | B.run pipe $ 169 | B.queryP_ 170 | ( "MATCH (z:Zettel) WHERE ID(z)={zid}\n" 171 | `append` "MATCH p=(z)-->() DELETE p" 172 | ) 173 | (fromList [("zid", B.I zid)]) 174 | -- Delete node 175 | B.run pipe $ 176 | B.queryP_ 177 | "MATCH (z:Zettel) WHERE ID(z)={zid} DELETE z" 178 | (fromList [("zid", B.I zid)]) 179 | B.close pipe 180 | EditNode z -> do 181 | neo4jToIO user pass . deleteNode $ getId z 182 | neo4jToIO user pass (createNode z) 183 | ) 184 | 185 | toZettel :: B.Value -> Zettel 186 | toZettel (B.S l) = 187 | let zettel = Zettel {} 188 | in aux (B.fields l) zettel 189 | where 190 | aux [] z = z 191 | aux (B.I i : t) z = aux t (z {getId = ZID i}) 192 | aux (B.M m : t) z = 193 | let (B.T title) = m ! "title" 194 | (B.T timestamp) = m ! "timestamp" 195 | (B.L authors) = m ! "authors" 196 | (B.L tags) = m ! "tags" 197 | (B.T zettel) = m ! "zettel" 198 | in aux 199 | t 200 | ( z 201 | { getAuthors = Prelude.map unT authors, 202 | getTags = Prelude.map unT tags, 203 | getTimestamp = timestamp, 204 | getTitle = title, 205 | getZettel = zettel, 206 | getConnections = [] 207 | } 208 | ) 209 | aux (_ : t) z = aux t z 210 | unT (B.T a) = a 211 | toZettel _ = Zettel {} 212 | --------------------------------------------------------------------------------