├── .github └── workflows │ └── haskell.yml ├── .gitignore ├── Makefile ├── README.org ├── cabal.project ├── default.nix ├── flake.lock ├── flake.nix ├── flatparse-util ├── LICENSE ├── README.md ├── Setup.hs ├── flatparse-util.cabal ├── package.yaml └── src │ └── FlatParse │ └── Combinators.hs ├── org-cbor ├── LICENSE ├── README.md ├── Setup.hs ├── org-cbor.cabal ├── package.yaml └── src │ └── Org │ └── CBOR.hs ├── org-data ├── LICENSE ├── README.md ├── Setup.hs ├── org-data.cabal ├── package.yaml └── src │ └── Org │ └── Data.hs ├── org-filetags ├── LICENSE ├── README.md ├── Setup.hs ├── org-filetags.cabal ├── package.yaml └── src │ └── Org │ └── FileTags │ ├── Filter.hs │ └── TagTrees.hs ├── org-json ├── LICENSE ├── README.md ├── Setup.hs ├── org-json.cabal ├── package.yaml └── src │ └── Org │ └── JSON.hs ├── org-jw ├── LICENSE ├── README.md ├── Setup.hs ├── bin │ ├── FileTags │ │ ├── Exec.hs │ │ └── Options.hs │ ├── JSON │ │ ├── Exec.hs │ │ └── Options.hs │ ├── Lint │ │ ├── Exec.hs │ │ └── Options.hs │ ├── Main.hs │ ├── Options.hs │ ├── Read.hs │ ├── Site │ │ ├── Exec.hs │ │ └── Options.hs │ ├── Stats │ │ ├── Exec.hs │ │ └── Options.hs │ └── Trip │ │ ├── Exec.hs │ │ └── Options.hs ├── org-jw.cabal └── package.yaml ├── org-lint ├── LICENSE ├── README.md ├── Setup.hs ├── org-lint.cabal ├── package.yaml ├── src │ └── Org │ │ └── Lint.hs └── tests │ └── inconsistent-whitespace-test.org ├── org-parse ├── LICENSE ├── README.md ├── Setup.hs ├── org-parse.cabal ├── package.yaml └── src │ └── Org │ └── Parse.hs ├── org-print ├── LICENSE ├── README.md ├── Setup.hs ├── org-print.cabal ├── package.yaml └── src │ └── Org │ └── Print.hs ├── org-site ├── LICENSE ├── Setup.hs ├── cabal.project ├── org-site.cabal ├── package.yaml └── src │ └── Org │ └── Site.hs └── org-types ├── LICENSE ├── README.md ├── Setup.hs ├── org-types.cabal ├── package.yaml └── src └── Org └── Types.hs /.github/workflows/haskell.yml: -------------------------------------------------------------------------------- 1 | name: Haskell CI 2 | 3 | on: [push, pull_request] 4 | 5 | permissions: 6 | contents: read 7 | 8 | jobs: 9 | build: 10 | runs-on: ubuntu-latest 11 | steps: 12 | - uses: actions/checkout@v4 13 | - uses: actions/setup-haskell@v1 14 | with: 15 | ghc-version: '9.10.2' 16 | cabal-version: '3.12.1.0' 17 | 18 | - name: Cache 19 | uses: actions/cache@v3 20 | env: 21 | cache-name: cache-cabal 22 | with: 23 | path: ~/.cabal 24 | key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }} 25 | restore-keys: | 26 | ${{ runner.os }}-build-${{ env.cache-name }}- 27 | ${{ runner.os }}-build- 28 | ${{ runner.os }}- 29 | 30 | - name: Install dependencies 31 | run: | 32 | cabal v2-update 33 | cabal v2-build all --enable-tests --enable-benchmarks 34 | - name: Build 35 | run: cabal v2-build --enable-tests --enable-benchmarks all 36 | - name: Run tests 37 | run: cabal v2-test all 38 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /.format 2 | /org.prof 3 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | CABAL_FILES = \ 2 | flatparse-util/flatparse-util.cabal \ 3 | org-data/org-data.cabal \ 4 | org-filetags/org-filetags.cabal \ 5 | org-cbor/org-cbor.cabal \ 6 | org-json/org-json.cabal \ 7 | org-lint/org-lint.cabal \ 8 | org-jw/org-jw.cabal \ 9 | org-parse/org-parse.cabal \ 10 | org-print/org-print.cabal \ 11 | org-site/org-site.cabal \ 12 | org-types/org-types.cabal 13 | 14 | FIND_FILES = find -L ~/org/ \( -name template -type d -prune -o -name '*.org' \) -type f 15 | 16 | all: $(CABAL_FILES) 17 | cabal build all 18 | $(FIND_FILES) \ 19 | | time cabal run org-jw:exe:org -- \ 20 | --config ~/org/org.yaml \ 21 | --keywords ~/org/org.dot \ 22 | lint \ 23 | --check-dir ~/.local/share/org-jw \ 24 | --round-trip \ 25 | -l INFO \ 26 | -F - \ 27 | +RTS -N 28 | 29 | lint: $(CABAL_FILES) 30 | cabal build all 31 | cd ~/org 32 | $(FIND_FILES) \ 33 | | time cabal run org-jw:exe:org -- \ 34 | --config ~/org/org.yaml \ 35 | --keywords ~/org/org.dot \ 36 | lint \ 37 | --round-trip \ 38 | -l INFO \ 39 | -F - \ 40 | +RTS -N 41 | 42 | json: $(CABAL_FILES) 43 | cabal build all 44 | $(FIND_FILES) \ 45 | | cabal run org-jw:exe:org -- \ 46 | --config ~/org/org.yaml \ 47 | --keywords ~/org/org.dot \ 48 | json \ 49 | --output ~/.cache/org-jw-json \ 50 | -F - \ 51 | +RTS -N 52 | 53 | trip: $(CABAL_FILES) 54 | cabal build all 55 | $(FIND_FILES) \ 56 | | cabal run org-jw:exe:org -- \ 57 | --config ~/org/org.yaml \ 58 | --keywords ~/org/org.dot \ 59 | trip \ 60 | -F - \ 61 | +RTS -N 62 | 63 | trip-update: $(CABAL_FILES) 64 | cabal build all 65 | $(FIND_FILES) \ 66 | | cabal run org-jw:exe:org -- \ 67 | --config ~/org/org.yaml \ 68 | --keywords ~/org/org.dot \ 69 | trip \ 70 | --change-in-place \ 71 | -F - \ 72 | +RTS -N 73 | 74 | stats: $(CABAL_FILES) 75 | cabal build all 76 | $(FIND_FILES) \ 77 | | cabal run org-jw:exe:org -- \ 78 | --config ~/org/org.yaml \ 79 | --keywords ~/org/org.dot \ 80 | stats \ 81 | -F - \ 82 | +RTS -N 83 | 84 | meeting-stats: $(CABAL_FILES) 85 | cabal build all 86 | find -L ~/org/journal/ -name '*.org' -type f -print0 \ 87 | | xargs -0 egrep -l '^#\+filetags.*:kadena:' \ 88 | | cabal run org-jw:exe:org -- \ 89 | --config ~/org/org.yaml \ 90 | --keywords ~/org/org.dot \ 91 | stats \ 92 | -F - 93 | 94 | newartisans: $(CABAL_FILES) 95 | cabal build all 96 | cabal run org-jw:exe:org -- \ 97 | --config ~/org/org.yaml \ 98 | --keywords ~/org/org.dot \ 99 | site \ 100 | rebuild \ 101 | ~/org/newartisans/config.yaml 102 | 103 | flatparse-util/flatparse-util.cabal: flatparse-util/package.yaml 104 | (cd flatparse-util; hpack -f) 105 | 106 | org-data/org-data.cabal: org-data/package.yaml 107 | (cd org-data; hpack -f) 108 | 109 | org-filetags/org-filetags.cabal: org-filetags/package.yaml 110 | (cd org-filetags; hpack -f) 111 | 112 | org-cbor/org-cbor.cabal: org-cbor/package.yaml 113 | (cd org-cbor; hpack -f) 114 | 115 | org-json/org-json.cabal: org-json/package.yaml 116 | (cd org-json; hpack -f) 117 | 118 | org-lint/org-lint.cabal: org-lint/package.yaml 119 | (cd org-lint; hpack -f) 120 | 121 | org-jw/org-jw.cabal: org-jw/package.yaml 122 | (cd org-jw; hpack -f) 123 | 124 | org-parse/org-parse.cabal: org-parse/package.yaml 125 | (cd org-parse; hpack -f) 126 | 127 | org-print/org-print.cabal: org-print/package.yaml 128 | (cd org-print; hpack -f) 129 | 130 | org-site/org-site.cabal: org-site/package.yaml 131 | (cd org-site; hpack -f) 132 | 133 | org-types/org-types.cabal: org-types/package.yaml 134 | (cd org-types; hpack -f) 135 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+title: Org-jw 2 | 3 | This repository contains a series of modules that I use for managing my 4 | personal Org-mode. Most of them are not suitable for general use, since the 5 | objective is tailored to managing the data in my own Org-mode files. 6 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: org-types/ 2 | flatparse-util/ 3 | org-cbor/ 4 | org-json/ 5 | org-data/ 6 | org-lint/ 7 | org-parse/ 8 | org-print/ 9 | org-filetags/ 10 | org-site/ 11 | org-jw/ 12 | 13 | source-repository-package 14 | type: git 15 | location: https://github.com/jwiegley/hakyll.git 16 | tag: 1784bb74b0bfcaa0899c522f34f2063b92728bd8 17 | --sha256: sha256-hNr59HQ5hwKctVTfBfgZZMPXJTohsFgAmLKjxuiHqHs= 18 | 19 | allow-newer: hakyll:template-haskell 20 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | (import ( 2 | fetchTarball { 3 | url = "https://github.com/edolstra/flake-compat/archive/35bb57c0c8d8b62bbfd284272c928ceb64ddbde9.tar.gz"; 4 | sha256 = "1prd9b1xx8c0sfwnyzkspplh30m613j42l1k789s521f4kv4c2z2"; } 5 | ) { 6 | src = ./.; 7 | }).defaultNix 8 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "HTTP": { 4 | "flake": false, 5 | "locked": { 6 | "lastModified": 1451647621, 7 | "narHash": "sha256-oHIyw3x0iKBexEo49YeUDV1k74ZtyYKGR2gNJXXRxts=", 8 | "owner": "phadej", 9 | "repo": "HTTP", 10 | "rev": "9bc0996d412fef1787449d841277ef663ad9a915", 11 | "type": "github" 12 | }, 13 | "original": { 14 | "owner": "phadej", 15 | "repo": "HTTP", 16 | "type": "github" 17 | } 18 | }, 19 | "cabal-32": { 20 | "flake": false, 21 | "locked": { 22 | "lastModified": 1603716527, 23 | "narHash": "sha256-X0TFfdD4KZpwl0Zr6x+PLxUt/VyKQfX7ylXHdmZIL+w=", 24 | "owner": "haskell", 25 | "repo": "cabal", 26 | "rev": "48bf10787e27364730dd37a42b603cee8d6af7ee", 27 | "type": "github" 28 | }, 29 | "original": { 30 | "owner": "haskell", 31 | "ref": "3.2", 32 | "repo": "cabal", 33 | "type": "github" 34 | } 35 | }, 36 | "cabal-34": { 37 | "flake": false, 38 | "locked": { 39 | "lastModified": 1645834128, 40 | "narHash": "sha256-wG3d+dOt14z8+ydz4SL7pwGfe7SiimxcD/LOuPCV6xM=", 41 | "owner": "haskell", 42 | "repo": "cabal", 43 | "rev": "5ff598c67f53f7c4f48e31d722ba37172230c462", 44 | "type": "github" 45 | }, 46 | "original": { 47 | "owner": "haskell", 48 | "ref": "3.4", 49 | "repo": "cabal", 50 | "type": "github" 51 | } 52 | }, 53 | "cabal-36": { 54 | "flake": false, 55 | "locked": { 56 | "lastModified": 1669081697, 57 | "narHash": "sha256-I5or+V7LZvMxfbYgZATU4awzkicBwwok4mVoje+sGmU=", 58 | "owner": "haskell", 59 | "repo": "cabal", 60 | "rev": "8fd619e33d34924a94e691c5fea2c42f0fc7f144", 61 | "type": "github" 62 | }, 63 | "original": { 64 | "owner": "haskell", 65 | "ref": "3.6", 66 | "repo": "cabal", 67 | "type": "github" 68 | } 69 | }, 70 | "cardano-shell": { 71 | "flake": false, 72 | "locked": { 73 | "lastModified": 1608537748, 74 | "narHash": "sha256-PulY1GfiMgKVnBci3ex4ptk2UNYMXqGjJOxcPy2KYT4=", 75 | "owner": "input-output-hk", 76 | "repo": "cardano-shell", 77 | "rev": "9392c75087cb9a3d453998f4230930dea3a95725", 78 | "type": "github" 79 | }, 80 | "original": { 81 | "owner": "input-output-hk", 82 | "repo": "cardano-shell", 83 | "type": "github" 84 | } 85 | }, 86 | "flake-compat": { 87 | "flake": false, 88 | "locked": { 89 | "lastModified": 1672831974, 90 | "narHash": "sha256-z9k3MfslLjWQfnjBtEtJZdq3H7kyi2kQtUThfTgdRk0=", 91 | "owner": "input-output-hk", 92 | "repo": "flake-compat", 93 | "rev": "45f2638735f8cdc40fe302742b79f248d23eb368", 94 | "type": "github" 95 | }, 96 | "original": { 97 | "owner": "input-output-hk", 98 | "ref": "hkm/gitlab-fix", 99 | "repo": "flake-compat", 100 | "type": "github" 101 | } 102 | }, 103 | "flake-utils": { 104 | "inputs": { 105 | "systems": "systems" 106 | }, 107 | "locked": { 108 | "lastModified": 1731533236, 109 | "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", 110 | "owner": "numtide", 111 | "repo": "flake-utils", 112 | "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", 113 | "type": "github" 114 | }, 115 | "original": { 116 | "owner": "numtide", 117 | "repo": "flake-utils", 118 | "type": "github" 119 | } 120 | }, 121 | "ghc-8.6.5-iohk": { 122 | "flake": false, 123 | "locked": { 124 | "lastModified": 1600920045, 125 | "narHash": "sha256-DO6kxJz248djebZLpSzTGD6s8WRpNI9BTwUeOf5RwY8=", 126 | "owner": "input-output-hk", 127 | "repo": "ghc", 128 | "rev": "95713a6ecce4551240da7c96b6176f980af75cae", 129 | "type": "github" 130 | }, 131 | "original": { 132 | "owner": "input-output-hk", 133 | "ref": "release/8.6.5-iohk", 134 | "repo": "ghc", 135 | "type": "github" 136 | } 137 | }, 138 | "hackage": { 139 | "flake": false, 140 | "locked": { 141 | "lastModified": 1748219229, 142 | "narHash": "sha256-xiqhny0WsLuK1jCM2vsD0qzxfpRi6e6xU4BwCjhbgGc=", 143 | "owner": "input-output-hk", 144 | "repo": "hackage.nix", 145 | "rev": "7a4e218bd6c60cb13c8f07e46ad85badf3397c5b", 146 | "type": "github" 147 | }, 148 | "original": { 149 | "owner": "input-output-hk", 150 | "repo": "hackage.nix", 151 | "type": "github" 152 | } 153 | }, 154 | "hackage-for-stackage": { 155 | "flake": false, 156 | "locked": { 157 | "lastModified": 1748219218, 158 | "narHash": "sha256-kKe1cGUGkwp/6704BTKlH4yWTL0wmZugofJU20PcIkA=", 159 | "owner": "input-output-hk", 160 | "repo": "hackage.nix", 161 | "rev": "d3c929097030b8405f983de59ea243018d7cf877", 162 | "type": "github" 163 | }, 164 | "original": { 165 | "owner": "input-output-hk", 166 | "ref": "for-stackage", 167 | "repo": "hackage.nix", 168 | "type": "github" 169 | } 170 | }, 171 | "haskellNix": { 172 | "inputs": { 173 | "HTTP": "HTTP", 174 | "cabal-32": "cabal-32", 175 | "cabal-34": "cabal-34", 176 | "cabal-36": "cabal-36", 177 | "cardano-shell": "cardano-shell", 178 | "flake-compat": "flake-compat", 179 | "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", 180 | "hackage": "hackage", 181 | "hackage-for-stackage": "hackage-for-stackage", 182 | "hls": "hls", 183 | "hls-1.10": "hls-1.10", 184 | "hls-2.0": "hls-2.0", 185 | "hls-2.10": "hls-2.10", 186 | "hls-2.2": "hls-2.2", 187 | "hls-2.3": "hls-2.3", 188 | "hls-2.4": "hls-2.4", 189 | "hls-2.5": "hls-2.5", 190 | "hls-2.6": "hls-2.6", 191 | "hls-2.7": "hls-2.7", 192 | "hls-2.8": "hls-2.8", 193 | "hls-2.9": "hls-2.9", 194 | "hpc-coveralls": "hpc-coveralls", 195 | "iserv-proxy": "iserv-proxy", 196 | "nixpkgs": [ 197 | "haskellNix", 198 | "nixpkgs-unstable" 199 | ], 200 | "nixpkgs-2305": "nixpkgs-2305", 201 | "nixpkgs-2311": "nixpkgs-2311", 202 | "nixpkgs-2405": "nixpkgs-2405", 203 | "nixpkgs-2411": "nixpkgs-2411", 204 | "nixpkgs-unstable": "nixpkgs-unstable", 205 | "old-ghc-nix": "old-ghc-nix", 206 | "stackage": "stackage" 207 | }, 208 | "locked": { 209 | "lastModified": 1748220732, 210 | "narHash": "sha256-Io2eq6g94/HCdtU8Xb4/qUawzFvBVNBmme7uOjQiH+o=", 211 | "owner": "input-output-hk", 212 | "repo": "haskell.nix", 213 | "rev": "339479e6413c1974395ca807f55511013ceb0ac6", 214 | "type": "github" 215 | }, 216 | "original": { 217 | "owner": "input-output-hk", 218 | "repo": "haskell.nix", 219 | "type": "github" 220 | } 221 | }, 222 | "hls": { 223 | "flake": false, 224 | "locked": { 225 | "lastModified": 1741604408, 226 | "narHash": "sha256-tuq3+Ip70yu89GswZ7DSINBpwRprnWnl6xDYnS4GOsc=", 227 | "owner": "haskell", 228 | "repo": "haskell-language-server", 229 | "rev": "682d6894c94087da5e566771f25311c47e145359", 230 | "type": "github" 231 | }, 232 | "original": { 233 | "owner": "haskell", 234 | "repo": "haskell-language-server", 235 | "type": "github" 236 | } 237 | }, 238 | "hls-1.10": { 239 | "flake": false, 240 | "locked": { 241 | "lastModified": 1680000865, 242 | "narHash": "sha256-rc7iiUAcrHxwRM/s0ErEsSPxOR3u8t7DvFeWlMycWgo=", 243 | "owner": "haskell", 244 | "repo": "haskell-language-server", 245 | "rev": "b08691db779f7a35ff322b71e72a12f6e3376fd9", 246 | "type": "github" 247 | }, 248 | "original": { 249 | "owner": "haskell", 250 | "ref": "1.10.0.0", 251 | "repo": "haskell-language-server", 252 | "type": "github" 253 | } 254 | }, 255 | "hls-2.0": { 256 | "flake": false, 257 | "locked": { 258 | "lastModified": 1687698105, 259 | "narHash": "sha256-OHXlgRzs/kuJH8q7Sxh507H+0Rb8b7VOiPAjcY9sM1k=", 260 | "owner": "haskell", 261 | "repo": "haskell-language-server", 262 | "rev": "783905f211ac63edf982dd1889c671653327e441", 263 | "type": "github" 264 | }, 265 | "original": { 266 | "owner": "haskell", 267 | "ref": "2.0.0.1", 268 | "repo": "haskell-language-server", 269 | "type": "github" 270 | } 271 | }, 272 | "hls-2.10": { 273 | "flake": false, 274 | "locked": { 275 | "lastModified": 1743069404, 276 | "narHash": "sha256-q4kDFyJDDeoGqfEtrZRx4iqMVEC2MOzCToWsFY+TOzY=", 277 | "owner": "haskell", 278 | "repo": "haskell-language-server", 279 | "rev": "2318c61db3a01e03700bd4b05665662929b7fe8b", 280 | "type": "github" 281 | }, 282 | "original": { 283 | "owner": "haskell", 284 | "ref": "2.10.0.0", 285 | "repo": "haskell-language-server", 286 | "type": "github" 287 | } 288 | }, 289 | "hls-2.2": { 290 | "flake": false, 291 | "locked": { 292 | "lastModified": 1693064058, 293 | "narHash": "sha256-8DGIyz5GjuCFmohY6Fa79hHA/p1iIqubfJUTGQElbNk=", 294 | "owner": "haskell", 295 | "repo": "haskell-language-server", 296 | "rev": "b30f4b6cf5822f3112c35d14a0cba51f3fe23b85", 297 | "type": "github" 298 | }, 299 | "original": { 300 | "owner": "haskell", 301 | "ref": "2.2.0.0", 302 | "repo": "haskell-language-server", 303 | "type": "github" 304 | } 305 | }, 306 | "hls-2.3": { 307 | "flake": false, 308 | "locked": { 309 | "lastModified": 1695910642, 310 | "narHash": "sha256-tR58doOs3DncFehHwCLczJgntyG/zlsSd7DgDgMPOkI=", 311 | "owner": "haskell", 312 | "repo": "haskell-language-server", 313 | "rev": "458ccdb55c9ea22cd5d13ec3051aaefb295321be", 314 | "type": "github" 315 | }, 316 | "original": { 317 | "owner": "haskell", 318 | "ref": "2.3.0.0", 319 | "repo": "haskell-language-server", 320 | "type": "github" 321 | } 322 | }, 323 | "hls-2.4": { 324 | "flake": false, 325 | "locked": { 326 | "lastModified": 1699862708, 327 | "narHash": "sha256-YHXSkdz53zd0fYGIYOgLt6HrA0eaRJi9mXVqDgmvrjk=", 328 | "owner": "haskell", 329 | "repo": "haskell-language-server", 330 | "rev": "54507ef7e85fa8e9d0eb9a669832a3287ffccd57", 331 | "type": "github" 332 | }, 333 | "original": { 334 | "owner": "haskell", 335 | "ref": "2.4.0.1", 336 | "repo": "haskell-language-server", 337 | "type": "github" 338 | } 339 | }, 340 | "hls-2.5": { 341 | "flake": false, 342 | "locked": { 343 | "lastModified": 1701080174, 344 | "narHash": "sha256-fyiR9TaHGJIIR0UmcCb73Xv9TJq3ht2ioxQ2mT7kVdc=", 345 | "owner": "haskell", 346 | "repo": "haskell-language-server", 347 | "rev": "27f8c3d3892e38edaef5bea3870161815c4d014c", 348 | "type": "github" 349 | }, 350 | "original": { 351 | "owner": "haskell", 352 | "ref": "2.5.0.0", 353 | "repo": "haskell-language-server", 354 | "type": "github" 355 | } 356 | }, 357 | "hls-2.6": { 358 | "flake": false, 359 | "locked": { 360 | "lastModified": 1705325287, 361 | "narHash": "sha256-+P87oLdlPyMw8Mgoul7HMWdEvWP/fNlo8jyNtwME8E8=", 362 | "owner": "haskell", 363 | "repo": "haskell-language-server", 364 | "rev": "6e0b342fa0327e628610f2711f8c3e4eaaa08b1e", 365 | "type": "github" 366 | }, 367 | "original": { 368 | "owner": "haskell", 369 | "ref": "2.6.0.0", 370 | "repo": "haskell-language-server", 371 | "type": "github" 372 | } 373 | }, 374 | "hls-2.7": { 375 | "flake": false, 376 | "locked": { 377 | "lastModified": 1708965829, 378 | "narHash": "sha256-LfJ+TBcBFq/XKoiNI7pc4VoHg4WmuzsFxYJ3Fu+Jf+M=", 379 | "owner": "haskell", 380 | "repo": "haskell-language-server", 381 | "rev": "50322b0a4aefb27adc5ec42f5055aaa8f8e38001", 382 | "type": "github" 383 | }, 384 | "original": { 385 | "owner": "haskell", 386 | "ref": "2.7.0.0", 387 | "repo": "haskell-language-server", 388 | "type": "github" 389 | } 390 | }, 391 | "hls-2.8": { 392 | "flake": false, 393 | "locked": { 394 | "lastModified": 1715153580, 395 | "narHash": "sha256-Vi/iUt2pWyUJlo9VrYgTcbRviWE0cFO6rmGi9rmALw0=", 396 | "owner": "haskell", 397 | "repo": "haskell-language-server", 398 | "rev": "dd1be1beb16700de59e0d6801957290bcf956a0a", 399 | "type": "github" 400 | }, 401 | "original": { 402 | "owner": "haskell", 403 | "ref": "2.8.0.0", 404 | "repo": "haskell-language-server", 405 | "type": "github" 406 | } 407 | }, 408 | "hls-2.9": { 409 | "flake": false, 410 | "locked": { 411 | "lastModified": 1719993701, 412 | "narHash": "sha256-wy348++MiMm/xwtI9M3vVpqj2qfGgnDcZIGXw8sF1sA=", 413 | "owner": "haskell", 414 | "repo": "haskell-language-server", 415 | "rev": "90319a7e62ab93ab65a95f8f2bcf537e34dae76a", 416 | "type": "github" 417 | }, 418 | "original": { 419 | "owner": "haskell", 420 | "ref": "2.9.0.1", 421 | "repo": "haskell-language-server", 422 | "type": "github" 423 | } 424 | }, 425 | "hpc-coveralls": { 426 | "flake": false, 427 | "locked": { 428 | "lastModified": 1607498076, 429 | "narHash": "sha256-8uqsEtivphgZWYeUo5RDUhp6bO9j2vaaProQxHBltQk=", 430 | "owner": "sevanspowell", 431 | "repo": "hpc-coveralls", 432 | "rev": "14df0f7d229f4cd2e79f8eabb1a740097fdfa430", 433 | "type": "github" 434 | }, 435 | "original": { 436 | "owner": "sevanspowell", 437 | "repo": "hpc-coveralls", 438 | "type": "github" 439 | } 440 | }, 441 | "iserv-proxy": { 442 | "flake": false, 443 | "locked": { 444 | "lastModified": 1747047742, 445 | "narHash": "sha256-PCDULyZSIPdDdF8Lanbcy+Dl6AJ5z6H2ng3sRsv+gwc=", 446 | "owner": "stable-haskell", 447 | "repo": "iserv-proxy", 448 | "rev": "dea34de4bde325aca22472c18d659bee7800b477", 449 | "type": "github" 450 | }, 451 | "original": { 452 | "owner": "stable-haskell", 453 | "ref": "iserv-syms", 454 | "repo": "iserv-proxy", 455 | "type": "github" 456 | } 457 | }, 458 | "nixpkgs-2305": { 459 | "locked": { 460 | "lastModified": 1705033721, 461 | "narHash": "sha256-K5eJHmL1/kev6WuqyqqbS1cdNnSidIZ3jeqJ7GbrYnQ=", 462 | "owner": "NixOS", 463 | "repo": "nixpkgs", 464 | "rev": "a1982c92d8980a0114372973cbdfe0a307f1bdea", 465 | "type": "github" 466 | }, 467 | "original": { 468 | "owner": "NixOS", 469 | "ref": "nixpkgs-23.05-darwin", 470 | "repo": "nixpkgs", 471 | "type": "github" 472 | } 473 | }, 474 | "nixpkgs-2311": { 475 | "locked": { 476 | "lastModified": 1719957072, 477 | "narHash": "sha256-gvFhEf5nszouwLAkT9nWsDzocUTqLWHuL++dvNjMp9I=", 478 | "owner": "NixOS", 479 | "repo": "nixpkgs", 480 | "rev": "7144d6241f02d171d25fba3edeaf15e0f2592105", 481 | "type": "github" 482 | }, 483 | "original": { 484 | "owner": "NixOS", 485 | "ref": "nixpkgs-23.11-darwin", 486 | "repo": "nixpkgs", 487 | "type": "github" 488 | } 489 | }, 490 | "nixpkgs-2405": { 491 | "locked": { 492 | "lastModified": 1735564410, 493 | "narHash": "sha256-HB/FA0+1gpSs8+/boEavrGJH+Eq08/R2wWNph1sM1Dg=", 494 | "owner": "NixOS", 495 | "repo": "nixpkgs", 496 | "rev": "1e7a8f391f1a490460760065fa0630b5520f9cf8", 497 | "type": "github" 498 | }, 499 | "original": { 500 | "owner": "NixOS", 501 | "ref": "nixpkgs-24.05-darwin", 502 | "repo": "nixpkgs", 503 | "type": "github" 504 | } 505 | }, 506 | "nixpkgs-2411": { 507 | "locked": { 508 | "lastModified": 1746566971, 509 | "narHash": "sha256-I40weT0FZWth1IEjgR5a0zC9LLyrPwTC0DAQcejtTJE=", 510 | "owner": "NixOS", 511 | "repo": "nixpkgs", 512 | "rev": "209c5b3b0f5cf5b5a7e12ddea59bf19699f97e75", 513 | "type": "github" 514 | }, 515 | "original": { 516 | "owner": "NixOS", 517 | "ref": "nixpkgs-24.11-darwin", 518 | "repo": "nixpkgs", 519 | "type": "github" 520 | } 521 | }, 522 | "nixpkgs-unstable": { 523 | "locked": { 524 | "lastModified": 1746576598, 525 | "narHash": "sha256-FshoQvr6Aor5SnORVvh/ZdJ1Sa2U4ZrIMwKBX5k2wu0=", 526 | "owner": "NixOS", 527 | "repo": "nixpkgs", 528 | "rev": "b3582c75c7f21ce0b429898980eddbbf05c68e55", 529 | "type": "github" 530 | }, 531 | "original": { 532 | "owner": "NixOS", 533 | "ref": "nixpkgs-unstable", 534 | "repo": "nixpkgs", 535 | "type": "github" 536 | } 537 | }, 538 | "old-ghc-nix": { 539 | "flake": false, 540 | "locked": { 541 | "lastModified": 1631092763, 542 | "narHash": "sha256-sIKgO+z7tj4lw3u6oBZxqIhDrzSkvpHtv0Kki+lh9Fg=", 543 | "owner": "angerman", 544 | "repo": "old-ghc-nix", 545 | "rev": "af48a7a7353e418119b6dfe3cd1463a657f342b8", 546 | "type": "github" 547 | }, 548 | "original": { 549 | "owner": "angerman", 550 | "ref": "master", 551 | "repo": "old-ghc-nix", 552 | "type": "github" 553 | } 554 | }, 555 | "root": { 556 | "inputs": { 557 | "flake-utils": "flake-utils", 558 | "haskellNix": "haskellNix", 559 | "nixpkgs": [ 560 | "haskellNix", 561 | "nixpkgs-unstable" 562 | ] 563 | } 564 | }, 565 | "stackage": { 566 | "flake": false, 567 | "locked": { 568 | "lastModified": 1748218423, 569 | "narHash": "sha256-Kxq6dht95EwFzqxqM1SlGuzxgvjyrZSHcnAIMz4imV4=", 570 | "owner": "input-output-hk", 571 | "repo": "stackage.nix", 572 | "rev": "9e099770ef4546bb9534db7cf08d4813ece553db", 573 | "type": "github" 574 | }, 575 | "original": { 576 | "owner": "input-output-hk", 577 | "repo": "stackage.nix", 578 | "type": "github" 579 | } 580 | }, 581 | "systems": { 582 | "locked": { 583 | "lastModified": 1681028828, 584 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", 585 | "owner": "nix-systems", 586 | "repo": "default", 587 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", 588 | "type": "github" 589 | }, 590 | "original": { 591 | "owner": "nix-systems", 592 | "repo": "default", 593 | "type": "github" 594 | } 595 | } 596 | }, 597 | "root": "root", 598 | "version": 7 599 | } 600 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "Org data tools"; 3 | 4 | inputs = { 5 | nixpkgs.follows = "haskellNix/nixpkgs-unstable"; 6 | haskellNix.url = "github:input-output-hk/haskell.nix"; 7 | flake-utils.url = "github:numtide/flake-utils"; 8 | }; 9 | 10 | outputs = { self, nixpkgs, flake-utils, haskellNix }: 11 | flake-utils.lib.eachDefaultSystem (system: 12 | let 13 | pkgs = import nixpkgs { 14 | inherit system overlays; 15 | inherit (haskellNix) config; 16 | }; 17 | flake = pkgs.org-jw.flake { 18 | }; 19 | overlays = [ haskellNix.overlay 20 | (final: prev: { 21 | org-jw = 22 | final.haskell-nix.project' { 23 | src = ./.; 24 | supportHpack = true; 25 | compiler-nix-name = "ghc910"; 26 | shell = { 27 | tools = { 28 | cabal = {}; 29 | haskell-language-server = {}; 30 | }; 31 | buildInputs = with pkgs; [ 32 | pkg-config 33 | ]; 34 | withHoogle = true; 35 | }; 36 | # modules = [{ 37 | # enableLibraryProfiling = true; 38 | # enableProfiling = true; 39 | # }]; 40 | }; 41 | }) 42 | ]; 43 | in flake // { 44 | packages.default = flake.packages."org-jw:exe:org"; 45 | }); 46 | } 47 | -------------------------------------------------------------------------------- /flatparse-util/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, John Wiegley 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of John Wiegley nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /flatparse-util/README.md: -------------------------------------------------------------------------------- 1 | # org-data 2 | 3 | Hello. 4 | -------------------------------------------------------------------------------- /flatparse-util/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /flatparse-util/flatparse-util.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.36.1. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: flatparse-util 8 | version: 0.0.1 9 | description: Combinators and utilities for flatparse 10 | author: John Wiegley 11 | maintainer: johnw@newartisans.com 12 | license: BSD3 13 | license-file: LICENSE 14 | build-type: Simple 15 | 16 | library 17 | exposed-modules: 18 | FlatParse.Combinators 19 | other-modules: 20 | Paths_flatparse_util 21 | hs-source-dirs: 22 | src 23 | ghc-options: -Wall -Wno-missing-home-modules -fprof-auto 24 | build-depends: 25 | base >=4.5 26 | , bytestring 27 | , flatparse 28 | , mtl 29 | default-language: Haskell2010 30 | -------------------------------------------------------------------------------- /flatparse-util/package.yaml: -------------------------------------------------------------------------------- 1 | name: flatparse-util 2 | version: 0.0.1 3 | license: BSD3 4 | author: John Wiegley 5 | maintainer: johnw@newartisans.com 6 | description: Combinators and utilities for flatparse 7 | 8 | ghc-options: 9 | - -Wall 10 | - -Wno-missing-home-modules 11 | - -fprof-auto 12 | 13 | dependencies: 14 | - base >= 4.5 15 | - bytestring 16 | - flatparse 17 | - mtl 18 | 19 | library: 20 | source-dirs: src 21 | exposed-modules: 22 | - FlatParse.Combinators 23 | -------------------------------------------------------------------------------- /flatparse-util/src/FlatParse/Combinators.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE ImportQualifiedPost #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | {-# LANGUAGE TupleSections #-} 5 | {-# OPTIONS_GHC -Wno-name-shadowing #-} 6 | 7 | module FlatParse.Combinators where 8 | 9 | import Control.Monad.Except 10 | import Data.ByteString (ByteString) 11 | import Data.Char (isAlphaNum) 12 | import FlatParse.Stateful hiding (Parser) 13 | import FlatParse.Stateful qualified as FP 14 | 15 | liftResult :: (MonadError e m) => FilePath -> Result e a -> m a 16 | liftResult _ (OK res _ _) = pure res 17 | liftResult _ (Err e) = throwError e 18 | liftResult path Fail = error $ "Fatal error parsing " ++ path 19 | 20 | resultToEither :: FilePath -> Result e a -> Either e a 21 | resultToEither _ (OK res _ _) = Right res 22 | resultToEither _ (Err e) = Left e 23 | resultToEither path Fail = error $ "Fatal error parsing " ++ path 24 | 25 | parseMaybe :: r -> FP.Parser r e a -> ByteString -> Maybe a 26 | parseMaybe r p s = case runParser p r 0 s of 27 | OK res _ _ -> Just res 28 | Err _ -> Nothing 29 | Fail -> Nothing 30 | 31 | count :: 32 | Int -> 33 | FP.Parser r e a -> 34 | FP.Parser r e [a] 35 | count cnt p = go cnt 36 | where 37 | go 0 = pure [] 38 | go n = (:) <$> p <*> go (pred n) 39 | 40 | between :: 41 | FP.Parser r e () -> 42 | FP.Parser r e () -> 43 | FP.Parser r e a -> 44 | FP.Parser r e a 45 | between s e p = s *> p <* e 46 | 47 | endBy1 :: 48 | FP.Parser r e a -> 49 | FP.Parser r e sep -> 50 | FP.Parser r e [a] 51 | endBy1 p sep = some $ do 52 | x <- p 53 | _ <- sep 54 | return x 55 | 56 | sepBy1 :: 57 | FP.Parser r e a -> 58 | FP.Parser r e sep -> 59 | FP.Parser r e [a] 60 | sepBy1 p sep = do 61 | x <- p 62 | xs <- many (sep >> p) 63 | return (x : xs) 64 | 65 | manyTill :: 66 | (Show a) => 67 | FP.Parser r e a -> 68 | FP.Parser r e () -> 69 | FP.Parser r e [a] 70 | manyTill p e = go [] 71 | where 72 | go acc = 73 | (reverse acc <$ e) 74 | <|> (go . (: acc) =<< p) 75 | 76 | manyTill_ :: 77 | FP.Parser r e a -> 78 | FP.Parser r e end -> 79 | FP.Parser r e ([a], end) 80 | manyTill_ p e = go [] 81 | where 82 | go !acc = do 83 | (let !y = reverse acc in ((y,) <$> e)) 84 | <|> (go . (: acc) =<< p) 85 | 86 | someTill :: 87 | FP.Parser r e a -> 88 | FP.Parser r e () -> 89 | FP.Parser r e [a] 90 | someTill p e = go [] 91 | where 92 | go acc = do 93 | x <- p 94 | ((x : acc) <$ e) 95 | <|> go (x : acc) 96 | 97 | newline :: FP.Parser r e () 98 | newline = $(char '\n') 99 | 100 | singleSpace :: FP.Parser r e () 101 | singleSpace = $(char ' ') 102 | 103 | spaces_ :: FP.Parser r e () 104 | spaces_ = skipSome singleSpace 105 | 106 | digitChar :: FP.Parser r e Char 107 | digitChar = satisfy isDigit 108 | 109 | trailingSpace :: FP.Parser r e () 110 | trailingSpace = skipMany singleSpace <* newline 111 | 112 | lineOrEof :: FP.Parser r e String 113 | lineOrEof = takeLine 114 | 115 | wholeLine :: FP.Parser r e String 116 | wholeLine = takeLine 117 | 118 | restOfLine :: FP.Parser r e String 119 | restOfLine = takeLine 120 | 121 | identifier :: FP.Parser r e String 122 | identifier = some (satisfy (\c -> isAlphaNum c || c == '_' || c == ' ')) 123 | -------------------------------------------------------------------------------- /org-cbor/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, John Wiegley 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of John Wiegley nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /org-cbor/README.md: -------------------------------------------------------------------------------- 1 | # org-json 2 | 3 | Hello. 4 | -------------------------------------------------------------------------------- /org-cbor/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /org-cbor/org-cbor.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.36.1. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: org-cbor 8 | version: 0.0.1 9 | description: Org-mode parser and data drier 10 | author: John Wiegley 11 | maintainer: johnw@newartisans.com 12 | license: BSD3 13 | license-file: LICENSE 14 | build-type: Simple 15 | 16 | library 17 | exposed-modules: 18 | Org.CBOR 19 | other-modules: 20 | Paths_org_cbor 21 | hs-source-dirs: 22 | src 23 | ghc-options: -Wall -Wno-missing-home-modules -fprof-auto 24 | build-depends: 25 | base >=4.5 26 | , bytestring 27 | , org-types 28 | , serialise 29 | default-language: Haskell2010 30 | -------------------------------------------------------------------------------- /org-cbor/package.yaml: -------------------------------------------------------------------------------- 1 | name: org-cbor 2 | version: 0.0.1 3 | license: BSD3 4 | author: John Wiegley 5 | maintainer: johnw@newartisans.com 6 | description: Org-mode parser and data drier 7 | 8 | ghc-options: 9 | - -Wall 10 | - -Wno-missing-home-modules 11 | - -fprof-auto 12 | 13 | dependencies: 14 | - base >= 4.5 15 | - bytestring 16 | - serialise 17 | 18 | library: 19 | source-dirs: src 20 | exposed-modules: 21 | - Org.CBOR 22 | dependencies: 23 | - org-types 24 | -------------------------------------------------------------------------------- /org-cbor/src/Org/CBOR.hs: -------------------------------------------------------------------------------- 1 | -- {-# LANGUAGE ApplicativeDo #-} 2 | -- {-# LANGUAGE BangPatterns #-} 3 | {-# LANGUAGE DeriveAnyClass #-} 4 | -- {-# LANGUAGE DeriveGeneric #-} 5 | -- {-# LANGUAGE FlexibleContexts #-} 6 | {-# LANGUAGE ImportQualifiedPost #-} 7 | {-# LANGUAGE StandaloneDeriving #-} 8 | {-# OPTIONS_GHC -Wno-orphans #-} 9 | 10 | -- {-# LANGUAGE LambdaCase #-} 11 | -- {-# LANGUAGE MultiWayIf #-} 12 | -- {-# LANGUAGE OverloadedStrings #-} 13 | -- {-# LANGUAGE RankNTypes #-} 14 | -- {-# LANGUAGE TemplateHaskell #-} 15 | -- {-# LANGUAGE TupleSections #-} 16 | -- {-# LANGUAGE TypeApplications #-} 17 | -- {-# LANGUAGE TypeOperators #-} 18 | 19 | module Org.CBOR (orgFileToCBOR, orgFileFromCBOR) where 20 | 21 | import Codec.Serialise 22 | import Data.Bifunctor 23 | import Data.ByteString.Lazy qualified as B 24 | import Org.Types 25 | 26 | deriving instance Serialise Config 27 | 28 | deriving instance Serialise Time 29 | 30 | deriving instance Serialise TimeKind 31 | 32 | deriving instance Serialise TimeSuffix 33 | 34 | deriving instance Serialise TimeSuffixKind 35 | 36 | deriving instance Serialise TimeSpan 37 | 38 | deriving instance Serialise Stamp 39 | 40 | deriving instance Serialise Duration 41 | 42 | deriving instance Serialise Property 43 | 44 | deriving instance Serialise Tag 45 | 46 | deriving instance Serialise Keyword 47 | 48 | deriving instance Serialise Loc 49 | 50 | deriving instance Serialise LogEntry 51 | 52 | deriving instance Serialise DrawerType 53 | 54 | deriving instance Serialise Block 55 | 56 | deriving instance Serialise Body 57 | 58 | deriving instance Serialise Entry 59 | 60 | deriving instance Serialise Header 61 | 62 | deriving instance Serialise OrgFile 63 | 64 | orgFileToCBOR :: FilePath -> OrgFile -> IO () 65 | orgFileToCBOR path org = B.writeFile path (serialise org) 66 | 67 | orgFileFromCBOR :: FilePath -> IO (Either String OrgFile) 68 | orgFileFromCBOR path = bimap show id . deserialiseOrFail <$> B.readFile path 69 | -------------------------------------------------------------------------------- /org-data/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, John Wiegley 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of John Wiegley nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /org-data/README.md: -------------------------------------------------------------------------------- 1 | # org-data 2 | 3 | Hello. 4 | -------------------------------------------------------------------------------- /org-data/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /org-data/org-data.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.37.0. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: org-data 8 | version: 0.0.1 9 | description: Org-mode parser and data drier 10 | author: John Wiegley 11 | maintainer: johnw@newartisans.com 12 | license: BSD3 13 | license-file: LICENSE 14 | build-type: Simple 15 | 16 | library 17 | exposed-modules: 18 | Org.Data 19 | other-modules: 20 | Paths_org_data 21 | hs-source-dirs: 22 | src 23 | ghc-options: -Wall -Wno-missing-home-modules -fprof-auto 24 | build-depends: 25 | base >=4.5 26 | , containers 27 | , filepath 28 | , flatparse 29 | , flatparse-util 30 | , lens 31 | , org-parse 32 | , org-print 33 | , org-types 34 | , split 35 | , text 36 | , time 37 | default-language: Haskell2010 38 | -------------------------------------------------------------------------------- /org-data/package.yaml: -------------------------------------------------------------------------------- 1 | name: org-data 2 | version: 0.0.1 3 | license: BSD3 4 | author: John Wiegley 5 | maintainer: johnw@newartisans.com 6 | description: Org-mode parser and data drier 7 | 8 | ghc-options: 9 | - -Wall 10 | - -Wno-missing-home-modules 11 | - -fprof-auto 12 | 13 | dependencies: 14 | - base >= 4.5 15 | - containers 16 | - filepath 17 | - lens 18 | - flatparse 19 | - flatparse-util 20 | - split 21 | - text 22 | - time 23 | 24 | library: 25 | source-dirs: src 26 | exposed-modules: 27 | - Org.Data 28 | dependencies: 29 | - org-types 30 | - org-parse 31 | - org-print 32 | -------------------------------------------------------------------------------- /org-data/src/Org/Data.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ApplicativeDo #-} 2 | {-# LANGUAGE BangPatterns #-} 3 | {-# LANGUAGE DeriveAnyClass #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE ImportQualifiedPost #-} 6 | {-# LANGUAGE LambdaCase #-} 7 | {-# LANGUAGE MultiWayIf #-} 8 | {-# LANGUAGE OverloadedStrings #-} 9 | {-# LANGUAGE RankNTypes #-} 10 | {-# LANGUAGE StandaloneDeriving #-} 11 | {-# LANGUAGE TemplateHaskell #-} 12 | {-# LANGUAGE TupleSections #-} 13 | {-# LANGUAGE TypeApplications #-} 14 | {-# LANGUAGE TypeOperators #-} 15 | {-# OPTIONS_GHC -Wno-name-shadowing #-} 16 | {-# OPTIONS_GHC -Wno-orphans #-} 17 | 18 | module Org.Data where 19 | 20 | import Control.Applicative 21 | import Control.Lens 22 | import Control.Lens.Unsound 23 | import Control.Monad (unless, void, when) 24 | import Data.Char (isAlphaNum, toLower) 25 | import Data.Data.Lens (biplate) 26 | import Data.List (intercalate, isInfixOf) 27 | import Data.List.Split (splitOn) 28 | import Data.Map (Map) 29 | import Data.Map qualified as M 30 | import Data.Maybe (fromMaybe) 31 | import Data.Text qualified as T 32 | import Data.Text.Encoding qualified as T 33 | import Data.Time (UTCTime, defaultTimeLocale) 34 | import Data.Time.Format (formatTime, parseTimeM) 35 | import FlatParse.Combinators 36 | import FlatParse.Stateful hiding (optional, (<|>)) 37 | import FlatParse.Stateful qualified as FP 38 | import Org.Parse 39 | import Org.Print 40 | import Org.Types 41 | import System.FilePath.Posix 42 | import Prelude hiding (readFile) 43 | 44 | deriving instance Plated Config 45 | 46 | deriving instance Plated Loc 47 | 48 | deriving instance Plated Property 49 | 50 | deriving instance Plated DrawerType 51 | 52 | deriving instance Plated Block 53 | 54 | deriving instance Plated Body 55 | 56 | deriving instance Plated Tag 57 | 58 | deriving instance Plated TimeSpan 59 | 60 | deriving instance Plated TimeKind 61 | 62 | deriving instance Plated TimeSuffixKind 63 | 64 | deriving instance Plated TimeSuffix 65 | 66 | deriving instance Plated Time 67 | 68 | deriving instance Plated Duration 69 | 70 | deriving instance Plated Stamp 71 | 72 | deriving instance Plated Header 73 | 74 | deriving instance Plated Keyword 75 | 76 | deriving instance Plated LogEntry 77 | 78 | deriving instance Plated Entry 79 | 80 | deriving instance Plated OrgFile 81 | 82 | deriving instance Plated CollectionItem 83 | 84 | deriving instance Plated Collection 85 | 86 | makeClassy ''Config 87 | 88 | makeLenses ''Loc 89 | 90 | makeLenses ''Property 91 | 92 | makePrisms ''DrawerType 93 | 94 | makePrisms ''Block 95 | 96 | makeClassy ''Body 97 | 98 | makePrisms ''Tag 99 | 100 | makePrisms ''TimeSpan 101 | 102 | makePrisms ''TimeKind 103 | 104 | makePrisms ''TimeSuffixKind 105 | 106 | makeLenses ''TimeSuffix 107 | 108 | makeClassy ''Time 109 | 110 | makeClassy ''Duration 111 | 112 | makePrisms ''Stamp 113 | 114 | makeClassy ''Header 115 | 116 | makePrisms ''Keyword 117 | 118 | makePrisms ''LogEntry 119 | 120 | makeClassy ''Entry 121 | 122 | makeClassy ''OrgFile 123 | 124 | makePrisms ''CollectionItem 125 | 126 | makeClassy ''Collection 127 | 128 | lined :: Traversal' [String] String 129 | lined f a = lines <$> f (unlines a) 130 | 131 | -- Roughly equivalent to: '^[0-9]{8,}[_-].+?( -- .+?|\[.+?\])\.[^.]+$' 132 | fileNameRe :: 133 | FP.Parser 134 | r 135 | String 136 | ( Maybe FilePath, 137 | FilePath, 138 | Maybe [String], 139 | Maybe FilePath 140 | ) 141 | fileNameRe = do 142 | date <- optional (pDate <* optional pDateSlugSeparator) 143 | slug <- pSlug 144 | tags <- optional pTags 145 | ext <- optional pExt 146 | pure (date, slug, words <$> tags, ext) 147 | where 148 | pDate = 149 | try $ 150 | (++) 151 | <$> count 8 (satisfy isDigit) 152 | <*> many (satisfy isDigit) 153 | pDateSlugSeparator = $(char '-') <|> $(char '_') 154 | pSlug = do 155 | manyTill 156 | anyChar 157 | (lookahead (void pTags <|> void pExt <|> eof)) 158 | pTags = 159 | try 160 | ( spaces_ 161 | *> $(string "--") 162 | *> spaces_ 163 | *> someTill anyChar (lookahead ($(char '.') <|> eof)) 164 | ) 165 | <|> try 166 | ( skipMany singleSpace 167 | *> between 168 | $(char '[') 169 | $(char ']') 170 | (someTill anyChar (lookahead $(char ']'))) 171 | ) 172 | pExt = try $ do 173 | _ <- $(char '.') 174 | str <- many anyChar <* eof 175 | when ("." `isInfixOf` str) $ 176 | err "Error parsing file extension" 177 | pure str 178 | 179 | fileNameReTest :: IO () 180 | fileNameReTest = do 181 | test 182 | "foo.org" 183 | (Nothing, "foo", Nothing, Just "org") 184 | test 185 | "foo-.org" 186 | (Nothing, "foo-", Nothing, Just "org") 187 | test 188 | "-foo-.org" 189 | (Nothing, "-foo-", Nothing, Just "org") 190 | test 191 | "-foo.org" 192 | (Nothing, "-foo", Nothing, Just "org") 193 | test 194 | "20240601-foo.org" 195 | (Just "20240601", "foo", Nothing, Just "org") 196 | test 197 | "20240601foo.org" 198 | (Just "20240601", "foo", Nothing, Just "org") 199 | test 200 | "20240601foo-.org" 201 | (Just "20240601", "foo-", Nothing, Just "org") 202 | test 203 | "20240601-foo-.org" 204 | (Just "20240601", "foo-", Nothing, Just "org") 205 | test 206 | "20240601-foo[foo bar].org" 207 | (Just "20240601", "foo", Just ["foo", "bar"], Just "org") 208 | test 209 | "20240601-foo [foo bar].org" 210 | (Just "20240601", "foo", Just ["foo", "bar"], Just "org") 211 | test 212 | "20240601[foo bar].org" 213 | (Just "20240601", "", Just ["foo", "bar"], Just "org") 214 | test 215 | "20240601 [foo bar].org" 216 | (Just "20240601", "", Just ["foo", "bar"], Just "org") 217 | test 218 | "20240601-foo --foo bar.org" 219 | (Just "20240601", "foo --foo bar", Nothing, Just "org") 220 | test 221 | "20240601-foo -- foo bar.org" 222 | (Just "20240601", "foo", Just ["foo", "bar"], Just "org") 223 | test 224 | "20240601--foo bar.org" 225 | (Just "20240601", "-foo bar", Nothing, Just "org") 226 | test 227 | "20240601-- foo bar.org" 228 | (Just "20240601", "- foo bar", Nothing, Just "org") 229 | test 230 | "20240601 -- foo bar.org" 231 | (Just "20240601", "", Just ["foo", "bar"], Just "org") 232 | test 233 | "foo" 234 | (Nothing, "foo", Nothing, Nothing) 235 | test 236 | "foo-" 237 | (Nothing, "foo-", Nothing, Nothing) 238 | test 239 | "-foo-" 240 | (Nothing, "-foo-", Nothing, Nothing) 241 | test 242 | "-foo" 243 | (Nothing, "-foo", Nothing, Nothing) 244 | test 245 | "20240601-foo" 246 | (Just "20240601", "foo", Nothing, Nothing) 247 | test 248 | "20240601foo" 249 | (Just "20240601", "foo", Nothing, Nothing) 250 | test 251 | "20240601foo-" 252 | (Just "20240601", "foo-", Nothing, Nothing) 253 | test 254 | "20240601-foo-" 255 | (Just "20240601", "foo-", Nothing, Nothing) 256 | test 257 | "20240601-foo[foo bar]" 258 | (Just "20240601", "foo", Just ["foo", "bar"], Nothing) 259 | test 260 | "20240601-foo [foo bar]" 261 | (Just "20240601", "foo", Just ["foo", "bar"], Nothing) 262 | test 263 | "20240601-foo --foo bar" 264 | (Just "20240601", "foo --foo bar", Nothing, Nothing) 265 | test 266 | "20240601-foo -- foo bar" 267 | (Just "20240601", "foo", Just ["foo", "bar"], Nothing) 268 | test 269 | "foo." 270 | (Nothing, "foo", Nothing, Just "") 271 | test 272 | "foo.." 273 | (Nothing, "foo.", Nothing, Just "") 274 | where 275 | test :: 276 | FilePath -> 277 | ( Maybe FilePath, 278 | FilePath, 279 | Maybe [String], 280 | Maybe FilePath 281 | ) -> 282 | IO () 283 | test path expect = do 284 | let res = 285 | parseMaybe 286 | ("", defaultConfig) 287 | fileNameRe 288 | (T.encodeUtf8 (T.pack path)) 289 | unless (res == Just expect) $ 290 | error $ 291 | "Failed to parse " ++ show path ++ ", got: " ++ show res 292 | 293 | fileNameParts :: 294 | Lens' 295 | FilePath 296 | ( Maybe FilePath, 297 | FilePath, 298 | Maybe [String], 299 | Maybe FilePath 300 | ) 301 | fileNameParts f nm = do 302 | case runParser fileNameRe () 0 (T.encodeUtf8 (T.pack nm)) of 303 | OK res _ _ -> 304 | ( \(stamp', slug', tags', ext') -> 305 | maybe "" (<> "-") stamp' 306 | <> slug' 307 | <> maybe "" ((\t -> "[" <> t <> "]") . unwords) tags' 308 | <> maybe "" ("." <>) ext' 309 | ) 310 | <$> f res 311 | Err err -> 312 | error $ "impossible, failed to parse file name: " ++ show err 313 | Fail -> 314 | error $ "impossible, failed to parse file name: " ++ show nm 315 | 316 | dirName :: Lens' FilePath FilePath 317 | dirName f path = ( takeFileName path) <$> f (takeDirectory path) 318 | 319 | fileName :: Lens' FilePath FilePath 320 | fileName f path = (takeDirectory path ) <$> f (takeFileName path) 321 | 322 | fileNameTags :: Lens' FilePath [Tag] 323 | fileNameTags f path = 324 | case path ^. fileNameParts . _3 of 325 | Nothing -> path <$ f [] 326 | Just tags -> 327 | ( \tags' -> 328 | case tags' of 329 | [] -> path 330 | _ -> 331 | path 332 | & fileNameParts . _3 333 | ?~ tags' ^.. traverse . _PlainTag 334 | ) 335 | <$> f (map PlainTag tags) 336 | 337 | fileActualSlug :: Lens' CollectionItem String 338 | fileActualSlug = filePath . fileName . fileNameParts . _2 339 | 340 | filePath :: Lens' CollectionItem FilePath 341 | filePath f (OrgItem o) = OrgItem <$> (o & orgFilePath %%~ f) 342 | filePath f (DataItem path) = DataItem <$> f path 343 | 344 | -- If an Org-mode file has a '#+filetags' property, then the tags are read 345 | -- from there, and written back there. Otherwise, the filename itself is used. 346 | fileTags :: Lens' CollectionItem [Tag] 347 | fileTags f (OrgItem o) = case o ^? orgFileProperty "filetags" . from tagList of 348 | Nothing -> OrgItem <$> (o & orgFilePath . fileNameTags %%~ f) 349 | Just filetags -> 350 | ( \filetags' -> 351 | OrgItem (o & orgFileProperty "filetags" . from tagList .~ filetags') 352 | ) 353 | <$> f filetags 354 | fileTags f (DataItem path) = DataItem <$> (path & fileNameTags %%~ f) 355 | 356 | fileTitle :: Traversal' CollectionItem String 357 | fileTitle = failing (_OrgItem . orgFileProperty "TITLE") fileActualSlug 358 | 359 | sluggify :: String -> String 360 | sluggify = 361 | useDashes 362 | . dropMultipleUnderscores 363 | . squashNonAlphanumerics 364 | . changeCertainCharacters 365 | . removeCertainCharacters 366 | . map toLower 367 | where 368 | dropMultipleUnderscores = 369 | intercalate "_" . filter (not . null) . splitOn "_" 370 | squashNonAlphanumerics = 371 | map (\c -> if isAlphaNum c then c else '_') 372 | changeCertainCharacters = 373 | map 374 | ( \c -> 375 | if 376 | | c == 'á' -> 'a' 377 | | c == 'í' -> 'i' 378 | | c == 'ú' -> 'u' 379 | | otherwise -> c 380 | ) 381 | removeCertainCharacters = 382 | filter (\c -> c `notElem` ['’', '‘', '“', '”', '`', '\'']) 383 | useDashes = 384 | map (\c -> if c == '_' then '-' else c) 385 | 386 | fileSlug :: Fold CollectionItem String 387 | fileSlug = 388 | failing 389 | (_OrgItem . orgFileProperty "SLUG") 390 | (fileTitle . to sluggify) 391 | 392 | fileTimestamp :: Traversal' CollectionItem Time 393 | fileTimestamp = 394 | failing (_OrgItem . orgFilePath) _DataItem . fileName . stringTime 395 | 396 | fileCreatedTime :: Traversal' CollectionItem Time 397 | fileCreatedTime = 398 | failing 399 | (_OrgItem . orgFileProperty "CREATED" . _Time) 400 | fileTimestamp 401 | 402 | {- 403 | fileEditedTime :: Traversal' CollectionItem Time 404 | fileEditedTime = 405 | failing 406 | (_OrgItem . orgFileHeader . headerStamps . traverse . _EditedStamp . _2) 407 | -- If the file does not have an EDITED stamp, we regard the filesystem 408 | -- modification time as the defined stamp. 409 | ( \f org -> 410 | let modTime = unsafePerformIO $ getModificationTime (org ^. filePath) 411 | in ( \tm' -> 412 | let modTime' = timeStartToUTCTime tm' 413 | in unsafePerformIO 414 | ( setModificationTime 415 | (org ^. filePath) 416 | modTime' 417 | ) 418 | `seq` org 419 | ) 420 | <$> f (utcTimeToTime InactiveTime modTime) 421 | ) 422 | -} 423 | 424 | -- fileDateTime :: Traversal' CollectionItem Time 425 | -- fileDateTime = 426 | -- _OrgItem . orgFileHeader . headerStamps . traverse . _DateStamp . _2 427 | 428 | -- A property for an entry is either: 429 | -- 430 | -- - A property explicit defined by the entry, in its PROPERTIES drawer. 431 | -- 432 | -- - A property implicitly inherited from its file or outline context. 433 | property :: String -> Traversal' Entry String 434 | property n = entryProperties . lookupProperty n 435 | 436 | orgFileProperty :: String -> Traversal' OrgFile String 437 | orgFileProperty n = 438 | orgFileHeader 439 | . failing 440 | (headerPropertiesDrawer . lookupProperty n) 441 | (headerFileProperties . lookupProperty n) 442 | 443 | -- "Any property" for an entry includes the above, and also: 444 | -- 445 | -- - A virtual property used as an alternate way to access details about the 446 | -- entry. 447 | anyProperty :: Config -> String -> Fold Entry String 448 | anyProperty cfg n = 449 | failing 450 | (entryProperties . lookupProperty n) 451 | (maybe ignored runFold (lookup n (specialProperties cfg))) 452 | 453 | -- jww (2024-05-13): Need to handle inherited tags 454 | specialProperties :: Config -> [(String, ReifiedFold Entry String)] 455 | specialProperties cfg = 456 | [ -- All tags, including inherited ones. 457 | ("ALLTAGS", undefined), 458 | -- t if task is currently blocked by children or siblings. 459 | ("BLOCKED", undefined), 460 | -- The category of an entry. jww (2024-05-13): NYI 461 | ("CATEGORY", Fold (entryLoc . file)), 462 | -- The sum of CLOCK intervals in the subtree. org-clock-sum must be run 463 | -- first to compute the values in the current buffer. 464 | ("CLOCKSUM", undefined), 465 | -- The sum of CLOCK intervals in the subtree for today. 466 | -- org-clock-sum-today must be run first to compute the values in the 467 | -- current buffer. 468 | ("CLOCKSUM_T", undefined), 469 | -- When was this entry closed? 470 | ("CLOSED", Fold (closedTime . re _Time)), 471 | -- The deadline timestamp. 472 | ("DEADLINE", Fold (deadlineTime . re _Time)), 473 | -- The filename the entry is located in. 474 | ("FILE", Fold (entryLoc . file)), 475 | -- The headline of the entry. 476 | ("ITEM", Fold entryHeadline), 477 | -- The priority of the entry, a string with a single letter. 478 | ("PRIORITY", Fold (entryPriority . _Just)), 479 | -- The scheduling timestamp. 480 | ("SCHEDULED", Fold (scheduledTime . re _Time)), 481 | -- The tags defined directly in the headline. 482 | ("TAGS", Fold entryTagString), 483 | -- The first keyword-less timestamp in the entry. 484 | ("TIMESTAMP", undefined), 485 | -- The first inactive timestamp in the entry. 486 | ("TIMESTAMP_IA", undefined), 487 | -- The TODO keyword of the entry. 488 | ( "TODO", 489 | Fold 490 | ( entryKeyword 491 | . _Just 492 | . keywordString 493 | . filtered (isTodo cfg) 494 | ) 495 | ), 496 | ------------------------------------------------------------------------ 497 | -- The following are not defined by Org-mode as special 498 | ------------------------------------------------------------------------ 499 | ("OFFSET", Fold (entryLoc . pos . re _Show)), 500 | ("DEPTH", Fold (entryDepth . re _Show)), 501 | ("KEYWORD", Fold (entryKeyword . _Just . keywordString)), 502 | ("TITLE", Fold entryTitle), 503 | ("CONTEXT", Fold (entryContext . _Just)), 504 | ("VERB", Fold (entryVerb . _Just)), 505 | ("LOCATOR", Fold (entryLocator . _Just)) 506 | ] 507 | 508 | keywordString :: Lens' Keyword String 509 | keywordString f (OpenKeyword loc kw) = OpenKeyword loc <$> f kw 510 | keywordString f (ClosedKeyword loc kw) = ClosedKeyword loc <$> f kw 511 | 512 | tagString :: Lens' Tag String 513 | tagString f (PlainTag txt) = PlainTag <$> f txt 514 | 515 | keyword :: Traversal' Entry String 516 | keyword = entryKeyword . _Just . keywordString 517 | 518 | entryId :: Traversal' Entry String 519 | entryId = property "ID" 520 | 521 | entryCategory :: Traversal' Entry String 522 | entryCategory = property "CATEGORY" 523 | 524 | tagList :: Iso' [Tag] String 525 | tagList = 526 | iso 527 | ( \tags -> 528 | intercalate 529 | ":" 530 | (":" : tags ^.. traverse . tagString ++ [":"]) 531 | ) 532 | (map PlainTag . filter (not . null) . splitOn ":") 533 | 534 | entryTagString :: Traversal' Entry String 535 | entryTagString f e = e & entryTags . tagList %%~ f 536 | 537 | leadSpace :: Traversal' Body String 538 | leadSpace = blocks . _head . _Whitespace . _2 539 | 540 | endSpace :: Traversal' Body String 541 | endSpace = blocks . _last . _Whitespace . _2 542 | 543 | _Time :: Prism' String Time 544 | _Time = 545 | prism' 546 | showTime 547 | ( \str -> 548 | parseMaybe 549 | ("", defaultConfig) 550 | parseTime 551 | (T.encodeUtf8 (T.pack str)) 552 | ) 553 | 554 | data TimestampFormat 555 | = HourMinSec 556 | | HourMin 557 | | JustDay 558 | 559 | tsFormatFmt :: TimestampFormat -> String 560 | tsFormatFmt HourMinSec = "%Y%m%d%H%M%S" 561 | tsFormatFmt HourMin = "%Y%m%d%H%M" 562 | tsFormatFmt JustDay = "%Y%m%d" 563 | 564 | tsFormatLen :: TimestampFormat -> Int 565 | tsFormatLen HourMinSec = 14 566 | tsFormatLen HourMin = 12 567 | tsFormatLen JustDay = 8 568 | 569 | stringTime :: Traversal' String Time 570 | stringTime f str = 571 | case ptime HourMinSec <|> ptime HourMin <|> ptime JustDay of 572 | Nothing -> pure str 573 | Just (tf, utct) -> do 574 | tm' <- f $ case tf of 575 | JustDay -> tm {_timeStart = Nothing} 576 | _ -> tm 577 | pure $ 578 | formatTime 579 | defaultTimeLocale 580 | (tsFormatFmt tf) 581 | (timeStartToUTCTime tm') 582 | where 583 | tm = utcTimeToTime InactiveTime utct 584 | where 585 | ptime :: TimestampFormat -> Maybe (TimestampFormat, UTCTime) 586 | ptime tf = (tf,) <$> parseTime' (tsFormatFmt tf) 587 | parseTime' :: String -> Maybe UTCTime 588 | parseTime' fmt = parseTimeM False defaultTimeLocale fmt str 589 | 590 | createdTime :: Traversal' Entry Time 591 | createdTime = property "CREATED" . _Time 592 | 593 | editedTime :: Traversal' Entry Time 594 | editedTime = property "EDITED" . _Time 595 | 596 | scheduledTime :: Traversal' Entry Time 597 | scheduledTime = entryStamps . traverse . _ScheduledStamp . _2 598 | 599 | deadlineTime :: Traversal' Entry Time 600 | deadlineTime = entryStamps . traverse . _DeadlineStamp . _2 601 | 602 | closedTime :: Traversal' Entry Time 603 | closedTime = entryStamps . traverse . _ClosedStamp . _2 604 | 605 | foldEntries :: [Property] -> (Entry -> b -> b) -> b -> [Entry] -> b 606 | foldEntries _ _ z [] = z 607 | foldEntries props f z (e : es) = 608 | f 609 | (inheritProperties props e) 610 | ( foldEntries 611 | props 612 | f 613 | z 614 | ( e ^. entryItems 615 | ++ e ^.. entryBody . blocks . traverse . _InlineTask . _2 616 | ++ es 617 | ) 618 | ) 619 | 620 | hardCodedInheritedProperties :: [String] 621 | hardCodedInheritedProperties = ["COLUMNS", "CATEGORY", "ARCHIVE", "LOGGING"] 622 | 623 | inheritProperties :: [Property] -> Entry -> Entry 624 | inheritProperties [] e = e 625 | inheritProperties (Property loc _ n v : ps) e = 626 | inheritProperties ps $ 627 | if has (property n) e 628 | then e 629 | else e & entryProperties <>~ [Property loc True n v] 630 | 631 | traverseEntries :: 632 | (Applicative f) => 633 | [Property] -> 634 | (Entry -> f a) -> 635 | [Entry] -> 636 | f [a] 637 | traverseEntries ps f = foldEntries ps (liftA2 (:) . f) (pure []) 638 | 639 | entries :: [Property] -> Traversal' OrgFile Entry 640 | entries ps f = orgFileEntries %%~ traverseEntries ps f 641 | 642 | -- jww (2024-05-14): Inherited properties can be specified by the user 643 | allEntries :: Traversal' OrgFile Entry 644 | allEntries f org = 645 | org 646 | & entries 647 | ( filter 648 | (\p -> p ^. name `elem` hardCodedInheritedProperties) 649 | ( org ^. orgFileHeader . headerPropertiesDrawer 650 | ++ org ^. orgFileHeader . headerFileProperties 651 | ) 652 | ) 653 | f 654 | 655 | allOrgFiles :: Traversal' Collection OrgFile 656 | allOrgFiles = items . traverse . _OrgItem 657 | 658 | allTaggedItems :: Traversal' Collection (FilePath, [Tag]) 659 | allTaggedItems = items . traverse . lensProduct filePath fileTags 660 | 661 | -- This is the "raw" form of the entries map, with a few invalid yet 662 | -- informational states: 663 | -- 664 | -- - If a key has multiple values, there is an ID conflict between two or 665 | -- more entries 666 | -- 667 | -- - If a key has no value, there is a link to an unknown ID. 668 | -- 669 | -- - If there are values behind the empty key, then there are entries with 670 | -- no ID. This is fine except for certain cases, such as TODOs. 671 | entriesMap :: Collection -> Map String [Entry] 672 | entriesMap db = 673 | foldr 674 | addEntryToMap 675 | M.empty 676 | (db ^.. items . traverse . _OrgItem . allEntries) 677 | 678 | addEntryToMap :: Entry -> Map String [Entry] -> Map String [Entry] 679 | addEntryToMap e = 680 | at ident 681 | %~ Just . \case 682 | Nothing -> [e] 683 | Just es -> (e : es) 684 | where 685 | ident = fromMaybe "" (e ^? entryId) 686 | 687 | addRefToMap :: String -> Map String [Entry] -> Map String [Entry] 688 | addRefToMap ident = 689 | at ident 690 | %~ Just . \case 691 | Nothing -> [] 692 | Just es -> es 693 | 694 | foldAllEntries :: Collection -> b -> (Entry -> b -> b) -> b 695 | foldAllEntries cs z f = 696 | foldr f z (cs ^.. items . traverse . _OrgItem . allEntries) 697 | 698 | findDuplicates :: (Ord a) => [a] -> [a] 699 | findDuplicates = M.keys . M.filter (> 1) . foldr go M.empty 700 | where 701 | go x = at x %~ Just . maybe (1 :: Int) succ 702 | 703 | tallyEntry :: 704 | (IxValue b1 ~ Int, At b1) => 705 | (t1 -> t2 -> (b1 -> Index b1 -> b1) -> b2) -> 706 | t1 -> 707 | t2 -> 708 | b2 709 | tallyEntry f e m = f e m $ \m' r -> m' & at r %~ Just . maybe (1 :: Int) succ 710 | 711 | countEntries :: 712 | (IxValue b1 ~ Int, At b1) => 713 | Collection -> 714 | (Entry -> Map k a -> (b1 -> Index b1 -> b1) -> Map k a) -> 715 | Map k a 716 | countEntries cs = foldAllEntries cs M.empty . tallyEntry 717 | 718 | isTodo :: Config -> String -> Bool 719 | isTodo cfg kw = isOpenTodo cfg kw || kw `elem` cfg ^. closedKeywords 720 | 721 | isOpenTodo :: Config -> String -> Bool 722 | isOpenTodo cfg kw = kw `elem` cfg ^. openKeywords 723 | 724 | isArchive :: OrgFile -> Bool 725 | isArchive org = "archive" `isInfixOf` (org ^. orgFilePath) 726 | 727 | entryStateHistory :: Traversal' Entry LogEntry 728 | entryStateHistory = entryLogEntries . traverse . biplate 729 | 730 | transitionsOf :: Config -> String -> [String] 731 | transitionsOf cfg kw = 732 | fromMaybe [] (lookup kw (cfg ^. keywordTransitions)) 733 | 734 | lookupProperty' :: 735 | (Applicative f) => 736 | String -> 737 | (Property -> f Property) -> 738 | [Property] -> 739 | f [Property] 740 | lookupProperty' n = 741 | traverse . filtered (\x -> map toLower (x ^. name) == map toLower n) 742 | 743 | lookupProperty :: 744 | (Applicative f) => 745 | String -> 746 | (String -> f String) -> 747 | [Property] -> 748 | f [Property] 749 | lookupProperty n = lookupProperty' n . value 750 | 751 | collectionPaths :: Collection -> [FilePath] 752 | collectionPaths (Collection cs) = 753 | map (^. failing (_OrgItem . orgFilePath) _DataItem) cs 754 | -------------------------------------------------------------------------------- /org-filetags/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, John Wiegley 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of John Wiegley nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /org-filetags/README.md: -------------------------------------------------------------------------------- 1 | # org-data 2 | 3 | Hello. 4 | -------------------------------------------------------------------------------- /org-filetags/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /org-filetags/org-filetags.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.37.0. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: org-filetags 8 | version: 0.0.1 9 | description: Org-mode parser and data drier 10 | author: John Wiegley 11 | maintainer: johnw@newartisans.com 12 | license: BSD3 13 | license-file: LICENSE 14 | build-type: Simple 15 | 16 | library 17 | exposed-modules: 18 | Org.FileTags.TagTrees 19 | Org.FileTags.Filter 20 | other-modules: 21 | Paths_org_filetags 22 | hs-source-dirs: 23 | src 24 | ghc-options: -Wall -Wno-missing-home-modules -fprof-auto 25 | build-depends: 26 | base >=4.5 27 | , directory 28 | , filepath 29 | , flatparse 30 | , flatparse-util 31 | , transformers 32 | default-language: Haskell2010 33 | -------------------------------------------------------------------------------- /org-filetags/package.yaml: -------------------------------------------------------------------------------- 1 | name: org-filetags 2 | version: 0.0.1 3 | license: BSD3 4 | author: John Wiegley 5 | maintainer: johnw@newartisans.com 6 | description: Org-mode parser and data drier 7 | 8 | ghc-options: 9 | - -Wall 10 | - -Wno-missing-home-modules 11 | - -fprof-auto 12 | 13 | dependencies: 14 | - base >= 4.5 15 | - directory 16 | - filepath 17 | - flatparse 18 | - flatparse-util 19 | - transformers 20 | 21 | library: 22 | source-dirs: src 23 | exposed-modules: 24 | - Org.FileTags.TagTrees 25 | - Org.FileTags.Filter 26 | -------------------------------------------------------------------------------- /org-filetags/src/Org/FileTags/Filter.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE ImportQualifiedPost #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | 6 | module Org.FileTags.Filter where 7 | 8 | import Control.Monad (unless, when) 9 | import Control.Monad.IO.Class 10 | import Control.Monad.Trans.State 11 | import Data.Char (isAlphaNum) 12 | import Data.Data (Data) 13 | import Data.Foldable (forM_) 14 | import Data.Typeable (Typeable) 15 | import FlatParse.Combinators 16 | import FlatParse.Stateful hiding (Parser, modify) 17 | import FlatParse.Stateful qualified as FP hiding (modify) 18 | import GHC.Generics 19 | import Org.FileTags.TagTrees 20 | 21 | data TagExpr 22 | = TagVar String 23 | | TagAnd TagExpr TagExpr 24 | | TagOr TagExpr TagExpr 25 | | TagNot TagExpr 26 | | TagTrue 27 | | TagFalse 28 | deriving (Data, Show, Eq, Typeable, Generic, Ord) 29 | 30 | tagName :: FP.Parser r String String 31 | tagName = 32 | some (satisfy (\c -> isAlphaNum c || c `elem` ['/', ':', '=', '_', ' '])) 33 | 34 | parseTagExpr :: FP.Parser r String TagExpr 35 | parseTagExpr = f TagAnd TagTrue 36 | where 37 | f binop end = foldr binop end <$> (sepBy1 go spaces_ <* eof) 38 | go = 39 | $( switch 40 | [| 41 | case _ of 42 | "-" -> TagNot . TagVar <$> tagName 43 | "(" -> parseTagExpr <* $(char ')') 44 | "(|" -> f TagOr TagFalse <* $(char ')') 45 | _ -> TagVar <$> tagName 46 | |] 47 | ) 48 | 49 | tagsMatch :: TagExpr -> [String] -> Bool 50 | tagsMatch (TagVar tag) ts = tag `elem` ts 51 | tagsMatch (TagAnd e1 e2) ts = tagsMatch e1 ts && tagsMatch e2 ts 52 | tagsMatch (TagOr e1 e2) ts = tagsMatch e1 ts || tagsMatch e2 ts 53 | tagsMatch (TagNot e) ts = not (tagsMatch e ts) 54 | tagsMatch TagTrue _ = True 55 | tagsMatch TagFalse _ = False 56 | 57 | makeFilter :: 58 | Bool -> FilePath -> Bool -> TagExpr -> [FilePath] -> IO () 59 | makeFilter dryRun filterDir overwrite expr paths = do 60 | unless dryRun $ 61 | createEmptyDirectory overwrite filterDir 62 | 63 | cnt <- flip execStateT (0 :: Int) $ 64 | forM_ paths $ \path -> do 65 | tags <- liftIO $ pathTags path 66 | when (tagsMatch expr tags) $ do 67 | modify succ 68 | unless dryRun $ 69 | liftIO $ 70 | createLinkInDirectory path filterDir 71 | 72 | putStrLn $ 73 | (if dryRun then "Would create " else "Created ") 74 | ++ show cnt 75 | ++ " entry links in " 76 | ++ filterDir 77 | -------------------------------------------------------------------------------- /org-filetags/src/Org/FileTags/TagTrees.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | 3 | module Org.FileTags.TagTrees where 4 | 5 | import Control.Arrow ((***)) 6 | import Control.Monad (unless) 7 | import Control.Monad.IO.Class 8 | import Control.Monad.Trans.State 9 | import Data.Foldable (forM_) 10 | import Data.List (permutations, subsequences) 11 | import Data.Maybe (maybeToList) 12 | import System.Directory 13 | import System.Exit 14 | import System.FilePath.Posix 15 | 16 | combinations :: [a] -> [[a]] 17 | combinations = concatMap (filter (not . null) . permutations) . subsequences 18 | 19 | tagPath :: [String] -> FilePath 20 | tagPath = foldr () "" 21 | 22 | createEmptyDirectory :: Bool -> FilePath -> IO () 23 | createEmptyDirectory overwrite dir = do 24 | isPresent <- doesDirectoryExist dir 25 | if isPresent 26 | then 27 | if overwrite 28 | then do 29 | removeDirectoryRecursive dir 30 | createDirectoryIfMissing True dir 31 | else do 32 | contents <- listDirectory dir 33 | unless (null contents) $ do 34 | putStrLn $ "Cannot overwrite directory " ++ dir 35 | exitWith (ExitFailure 1) 36 | else createDirectoryIfMissing True dir 37 | 38 | createLinkInDirectory :: FilePath -> FilePath -> IO () 39 | createLinkInDirectory src dir = do 40 | createDirectoryIfMissing True dir 41 | createFileLink src (dir takeFileName src) 42 | 43 | pathTags :: FilePath -> IO [String] 44 | pathTags = undefined 45 | 46 | makeTagTrees :: 47 | Bool -> FilePath -> Bool -> Int -> Maybe String -> [FilePath] -> IO () 48 | makeTagTrees dryRun tagTreesDir overwrite depth tagForUntagged paths = do 49 | unless dryRun $ 50 | createEmptyDirectory overwrite tagTreesDir 51 | 52 | (count, maxDepth) <- flip execStateT (0 :: Int, 0 :: Int) $ 53 | forM_ paths $ \path -> do 54 | tags <- 55 | flip fmap (liftIO (pathTags path)) $ \case 56 | [] -> maybeToList tagForUntagged 57 | xs -> xs 58 | forM_ (filter (\ts -> length ts <= depth) (combinations tags)) $ 59 | \tagSet -> do 60 | modify (succ *** max (length tagSet)) 61 | unless dryRun $ 62 | liftIO $ 63 | createLinkInDirectory 64 | path 65 | (tagTreesDir tagPath tagSet) 66 | 67 | putStrLn $ 68 | (if dryRun then "Would create " else "Created ") 69 | ++ show count 70 | ++ " symbolic links, at a maximum depth of " 71 | ++ show maxDepth 72 | ++ " links" 73 | -------------------------------------------------------------------------------- /org-json/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, John Wiegley 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of John Wiegley nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /org-json/README.md: -------------------------------------------------------------------------------- 1 | # org-json 2 | 3 | Hello. 4 | -------------------------------------------------------------------------------- /org-json/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /org-json/org-json.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.36.1. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: org-json 8 | version: 0.0.1 9 | description: Org-mode parser and data drier 10 | author: John Wiegley 11 | maintainer: johnw@newartisans.com 12 | license: BSD3 13 | license-file: LICENSE 14 | build-type: Simple 15 | 16 | library 17 | exposed-modules: 18 | Org.JSON 19 | other-modules: 20 | Paths_org_json 21 | hs-source-dirs: 22 | src 23 | ghc-options: -Wall -Wno-missing-home-modules -fprof-auto 24 | build-depends: 25 | aeson 26 | , base >=4.5 27 | , bytestring 28 | , org-types 29 | default-language: Haskell2010 30 | -------------------------------------------------------------------------------- /org-json/package.yaml: -------------------------------------------------------------------------------- 1 | name: org-json 2 | version: 0.0.1 3 | license: BSD3 4 | author: John Wiegley 5 | maintainer: johnw@newartisans.com 6 | description: Org-mode parser and data drier 7 | 8 | ghc-options: 9 | - -Wall 10 | - -Wno-missing-home-modules 11 | - -fprof-auto 12 | 13 | dependencies: 14 | - base >= 4.5 15 | - aeson 16 | - bytestring 17 | 18 | library: 19 | source-dirs: src 20 | exposed-modules: 21 | - Org.JSON 22 | dependencies: 23 | - org-types 24 | -------------------------------------------------------------------------------- /org-json/src/Org/JSON.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImportQualifiedPost #-} 2 | {-# OPTIONS_GHC -Wno-orphans #-} 3 | 4 | module Org.JSON (orgFileToJSON, orgFileToJSONFile, orgFileFromJSONFile) where 5 | 6 | import Data.Aeson 7 | import Data.Aeson qualified as JSON 8 | import Data.ByteString.Lazy (ByteString) 9 | import Data.Char (toLower) 10 | import Org.Types 11 | import Prelude hiding (readFile) 12 | 13 | lowerFirst :: String -> String 14 | lowerFirst [] = [] 15 | lowerFirst (x : xs) = (toLower x : xs) 16 | 17 | instance FromJSON Config where 18 | parseJSON = 19 | genericParseJSON 20 | JSON.defaultOptions 21 | { fieldLabelModifier = drop 1 -- _ 22 | } 23 | 24 | instance ToJSON Config where 25 | toEncoding = genericToEncoding JSON.defaultOptions 26 | 27 | instance FromJSON Time where 28 | parseJSON = 29 | genericParseJSON 30 | JSON.defaultOptions 31 | { fieldLabelModifier = lowerFirst . drop 5 -- _time 32 | } 33 | 34 | instance ToJSON Time where 35 | toEncoding = 36 | genericToEncoding 37 | JSON.defaultOptions 38 | { fieldLabelModifier = lowerFirst . drop 5 -- _time 39 | } 40 | 41 | instance FromJSON TimeKind where 42 | parseJSON = genericParseJSON JSON.defaultOptions 43 | 44 | instance ToJSON TimeKind where 45 | toEncoding = 46 | genericToEncoding 47 | JSON.defaultOptions 48 | 49 | instance FromJSON TimeSuffix where 50 | parseJSON = 51 | genericParseJSON 52 | JSON.defaultOptions 53 | { fieldLabelModifier = lowerFirst . drop 7 -- _suffix 54 | } 55 | 56 | instance ToJSON TimeSuffix where 57 | toEncoding = 58 | genericToEncoding 59 | JSON.defaultOptions 60 | { fieldLabelModifier = lowerFirst . drop 7 -- _suffix 61 | } 62 | 63 | instance FromJSON TimeSuffixKind where 64 | parseJSON = genericParseJSON JSON.defaultOptions 65 | 66 | instance ToJSON TimeSuffixKind where 67 | toEncoding = 68 | genericToEncoding 69 | JSON.defaultOptions 70 | 71 | instance FromJSON TimeSpan where 72 | parseJSON = genericParseJSON JSON.defaultOptions 73 | 74 | instance ToJSON TimeSpan where 75 | toEncoding = 76 | genericToEncoding 77 | JSON.defaultOptions 78 | 79 | instance FromJSON Stamp where 80 | parseJSON = genericParseJSON JSON.defaultOptions 81 | 82 | instance ToJSON Stamp where 83 | toEncoding = 84 | genericToEncoding 85 | JSON.defaultOptions 86 | 87 | instance FromJSON Duration where 88 | parseJSON = 89 | genericParseJSON 90 | JSON.defaultOptions 91 | { fieldLabelModifier = lowerFirst . drop 1 -- _ 92 | } 93 | 94 | instance ToJSON Duration where 95 | toEncoding = 96 | genericToEncoding 97 | JSON.defaultOptions 98 | { fieldLabelModifier = lowerFirst . drop 1 -- _ 99 | } 100 | 101 | instance FromJSON Property where 102 | parseJSON = 103 | genericParseJSON 104 | JSON.defaultOptions 105 | { fieldLabelModifier = lowerFirst . drop 1 -- _ 106 | } 107 | 108 | instance ToJSON Property where 109 | toEncoding = 110 | genericToEncoding 111 | JSON.defaultOptions 112 | { fieldLabelModifier = lowerFirst . drop 1 -- _ 113 | } 114 | 115 | instance FromJSON Tag where 116 | parseJSON = genericParseJSON JSON.defaultOptions 117 | 118 | instance ToJSON Tag where 119 | toEncoding = 120 | genericToEncoding 121 | JSON.defaultOptions 122 | 123 | instance FromJSON Keyword where 124 | parseJSON = genericParseJSON JSON.defaultOptions 125 | 126 | instance ToJSON Keyword where 127 | toEncoding = 128 | genericToEncoding 129 | JSON.defaultOptions 130 | 131 | instance FromJSON Loc where 132 | parseJSON = 133 | genericParseJSON 134 | JSON.defaultOptions 135 | { fieldLabelModifier = lowerFirst . drop 1 -- _ 136 | } 137 | 138 | instance ToJSON Loc where 139 | toEncoding = 140 | genericToEncoding 141 | JSON.defaultOptions 142 | { fieldLabelModifier = lowerFirst . drop 1 -- _ 143 | } 144 | 145 | instance FromJSON LogEntry where 146 | parseJSON = genericParseJSON JSON.defaultOptions 147 | 148 | instance ToJSON LogEntry where 149 | toEncoding = 150 | genericToEncoding 151 | JSON.defaultOptions 152 | 153 | instance FromJSON DrawerType where 154 | parseJSON = genericParseJSON JSON.defaultOptions 155 | 156 | instance ToJSON DrawerType where 157 | toEncoding = 158 | genericToEncoding 159 | JSON.defaultOptions 160 | 161 | instance FromJSON Block where 162 | parseJSON = genericParseJSON JSON.defaultOptions 163 | 164 | instance ToJSON Block where 165 | toEncoding = 166 | genericToEncoding 167 | JSON.defaultOptions 168 | 169 | instance FromJSON Body where 170 | parseJSON = 171 | genericParseJSON 172 | JSON.defaultOptions 173 | { fieldLabelModifier = lowerFirst . drop 1 -- _ 174 | } 175 | 176 | instance ToJSON Body where 177 | toEncoding = 178 | genericToEncoding 179 | JSON.defaultOptions 180 | { fieldLabelModifier = lowerFirst . drop 1 -- _ 181 | } 182 | 183 | instance FromJSON Entry where 184 | parseJSON = 185 | genericParseJSON 186 | JSON.defaultOptions 187 | { fieldLabelModifier = lowerFirst . drop 6 -- _entry 188 | } 189 | 190 | instance ToJSON Entry where 191 | toEncoding = 192 | genericToEncoding 193 | JSON.defaultOptions 194 | { fieldLabelModifier = lowerFirst . drop 6 -- _entry 195 | } 196 | 197 | instance FromJSON Header where 198 | parseJSON = 199 | genericParseJSON 200 | JSON.defaultOptions 201 | { fieldLabelModifier = lowerFirst . drop 7 -- _header 202 | } 203 | 204 | instance ToJSON Header where 205 | toEncoding = 206 | genericToEncoding 207 | JSON.defaultOptions 208 | { fieldLabelModifier = lowerFirst . drop 7 -- _header 209 | } 210 | 211 | instance FromJSON OrgFile where 212 | parseJSON = 213 | genericParseJSON 214 | JSON.defaultOptions 215 | { fieldLabelModifier = lowerFirst . drop 8 -- _orgFile 216 | } 217 | 218 | instance ToJSON OrgFile where 219 | toEncoding = 220 | genericToEncoding 221 | JSON.defaultOptions 222 | { fieldLabelModifier = lowerFirst . drop 8 -- _orgFile 223 | } 224 | 225 | orgFileToJSON :: OrgFile -> ByteString 226 | orgFileToJSON = encode 227 | 228 | orgFileToJSONFile :: FilePath -> OrgFile -> IO () 229 | orgFileToJSONFile = encodeFile 230 | 231 | orgFileFromJSONFile :: FilePath -> IO (Either String OrgFile) 232 | orgFileFromJSONFile = eitherDecodeFileStrict 233 | -------------------------------------------------------------------------------- /org-jw/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, John Wiegley 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of John Wiegley nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /org-jw/README.md: -------------------------------------------------------------------------------- 1 | # tinderbox 2 | 3 | Implementation of expression language used by the Tinderbox application. 4 | -------------------------------------------------------------------------------- /org-jw/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /org-jw/bin/FileTags/Exec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImportQualifiedPost #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | 7 | module FileTags.Exec where 8 | 9 | import Control.Lens hiding (List) 10 | import Data.Foldable (forM_) 11 | import Data.Map qualified as M 12 | import FileTags.Options 13 | import Org.Data 14 | import Org.FileTags.Filter 15 | import Org.FileTags.TagTrees 16 | import Org.Types 17 | import Prelude hiding (readFile) 18 | 19 | execTags :: Config -> TagsOptions -> Collection -> IO () 20 | execTags _cfg opts coll = case opts ^. command of 21 | List -> do 22 | let counts = countEntries coll $ \e m k -> foldr (flip k) m (e ^. entryTags) 23 | forM_ (M.toList counts) $ \(tag, cnt) -> 24 | putStrLn $ show cnt ++ " " ++ tag ^. tagString 25 | TagTrees dryRun dir overwrite depth tagForUntagged -> 26 | makeTagTrees 27 | dryRun 28 | dir 29 | overwrite 30 | depth 31 | (tagForUntagged) 32 | (collectionPaths coll) 33 | Filter dryRun dir overwrite expr -> 34 | makeFilter dryRun dir overwrite expr (collectionPaths coll) 35 | -------------------------------------------------------------------------------- /org-jw/bin/FileTags/Options.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE ImportQualifiedPost #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | {-# LANGUAGE TypeApplications #-} 7 | 8 | module FileTags.Options where 9 | 10 | import Control.Lens hiding (List, argument) 11 | import Data.Text qualified as T 12 | import Data.Text.Encoding qualified as T 13 | import Data.Typeable (Typeable) 14 | import FlatParse.Combinators 15 | import GHC.Generics 16 | import Options.Applicative as OA 17 | import Org.FileTags.Filter 18 | 19 | data TagsCommand 20 | = List 21 | | TagTrees 22 | { tagTreesDryRun :: Bool, 23 | tagTreesDirectory :: FilePath, 24 | tagTreesOverwrite :: Bool, 25 | tagTreesDepth :: Int, 26 | tagTreesTagForUntagged :: Maybe String 27 | } 28 | | Filter 29 | { filterDryRun :: Bool, 30 | filterDirectory :: FilePath, 31 | filterOverwrite :: Bool, 32 | filterExpr :: TagExpr 33 | } 34 | deriving (Show, Eq, Typeable, Generic) 35 | 36 | makePrisms ''TagsCommand 37 | 38 | data TagsOptions = TagsOptions 39 | { _command :: !TagsCommand 40 | } 41 | deriving (Show, Eq, Typeable, Generic) 42 | 43 | makeLenses ''TagsOptions 44 | 45 | tagsOptions :: Parser TagsOptions 46 | tagsOptions = 47 | TagsOptions 48 | <$> hsubparser 49 | ( tagsCommand 50 | <> tagTreesCommand 51 | <> filterCommand 52 | ) 53 | where 54 | tagsCommand :: Mod CommandFields TagsCommand 55 | tagsCommand = 56 | OA.command 57 | "list" 58 | (info listOptions (progDesc "Org-mode file tags")) 59 | where 60 | listOptions :: Parser TagsCommand 61 | listOptions = pure List 62 | 63 | tagTreesCommand :: Mod CommandFields TagsCommand 64 | tagTreesCommand = 65 | OA.command 66 | "trees" 67 | (info tagTreesOptions (progDesc "Create tag trees")) 68 | where 69 | tagTreesOptions :: Parser TagsCommand 70 | tagTreesOptions = 71 | TagTrees 72 | <$> switch 73 | ( short 'n' 74 | <> long "dry-run" 75 | <> help "If enabled, make no changes to disk" 76 | ) 77 | <*> option 78 | auto 79 | ( long "directory" 80 | <> value ".tagtrees" 81 | <> help "Directory to create tag trees in" 82 | ) 83 | <*> switch 84 | ( short 'f' 85 | <> long "force" 86 | <> help "If enabled, remove existing tagtrees directory" 87 | ) 88 | <*> option 89 | auto 90 | ( short 'd' 91 | <> long "depth" 92 | <> value 2 93 | <> help "Depth of tag hierarchy to create" 94 | ) 95 | <*> optional 96 | ( strOption 97 | ( long "tag-for-untagged" 98 | <> help "Depth of tag hierarchy to create" 99 | ) 100 | ) 101 | 102 | filterCommand :: Mod CommandFields TagsCommand 103 | filterCommand = 104 | OA.command 105 | "filter" 106 | (info filterOptions (progDesc "Filter by tag expression")) 107 | where 108 | filterOptions :: Parser TagsCommand 109 | filterOptions = 110 | Filter 111 | <$> switch 112 | ( short 'n' 113 | <> long "dry-run" 114 | <> help "If enabled, make no changes to disk" 115 | ) 116 | <*> option 117 | auto 118 | ( long "directory" 119 | <> value ".filter" 120 | <> help "Directory to create tag trees in" 121 | ) 122 | <*> switch 123 | ( short 'f' 124 | <> long "force" 125 | <> help "If enabled, remove existing filter directory" 126 | ) 127 | <*> option 128 | ( maybeReader 129 | ( parseMaybe () parseTagExpr 130 | . T.encodeUtf8 131 | . T.pack 132 | ) 133 | ) 134 | ( short 't' 135 | <> long "tags" 136 | <> help "Tags to filter by" 137 | ) 138 | -------------------------------------------------------------------------------- /org-jw/bin/JSON/Exec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImportQualifiedPost #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | 7 | module JSON.Exec where 8 | 9 | import Control.Lens hiding ((<.>)) 10 | import Data.ByteString.Lazy qualified as B 11 | import Data.Foldable (forM_) 12 | import JSON.Options 13 | import Org.Data 14 | import Org.JSON 15 | import Org.Types 16 | import System.FilePath 17 | import Prelude hiding (readFile) 18 | 19 | execJson :: Config -> JsonOptions -> Collection -> IO () 20 | execJson _cfg opts coll = 21 | forM_ (coll ^.. items . traverse . _OrgItem) $ \org -> 22 | case opts ^. jsonDir of 23 | Just dir -> 24 | orgFileToJSONFile (jsonFilePath dir (org ^. orgFilePath)) org 25 | Nothing -> 26 | B.putStr $ orgFileToJSON org 27 | 28 | jsonFilePath :: FilePath -> FilePath -> FilePath 29 | jsonFilePath jdir path = 30 | jdir takeBaseName (map repl path) <.> "json" 31 | where 32 | repl '/' = '!' 33 | repl c = c 34 | -------------------------------------------------------------------------------- /org-jw/bin/JSON/Options.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE ImportQualifiedPost #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | {-# LANGUAGE TypeApplications #-} 7 | 8 | module JSON.Options where 9 | 10 | import Control.Lens hiding (argument) 11 | import Data.Typeable (Typeable) 12 | import GHC.Generics 13 | import Options.Applicative as OA 14 | 15 | data JsonOptions = JsonOptions 16 | { _jsonDir :: !(Maybe FilePath) 17 | } 18 | deriving (Show, Eq, Typeable, Generic) 19 | 20 | makeLenses ''JsonOptions 21 | 22 | jsonOptions :: OA.Parser JsonOptions 23 | jsonOptions = 24 | JsonOptions 25 | <$> optional 26 | ( strOption 27 | ( short 'o' 28 | <> long "output" 29 | <> help "Output Org-mode files as JSON to DIR" 30 | ) 31 | ) 32 | -------------------------------------------------------------------------------- /org-jw/bin/Lint/Exec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImportQualifiedPost #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} 7 | 8 | module Lint.Exec where 9 | 10 | import Control.Lens hiding ((<.>)) 11 | import Data.ByteString qualified as B 12 | import Data.Foldable (forM_) 13 | import Data.List (find) 14 | import Data.Map qualified as M 15 | import Data.Traversable (forM) 16 | import FlatParse.Stateful qualified as FP 17 | import Lint.Options 18 | import Org.Data 19 | import Org.Lint 20 | import Org.Print 21 | import Org.Types 22 | import Read 23 | import System.Exit 24 | import System.FilePath 25 | import System.IO hiding (readFile) 26 | import System.IO.Temp 27 | import System.Process 28 | import Prelude hiding (readFile) 29 | 30 | execLint :: Config -> LintOptions -> Collection -> IO () 31 | execLint cfg opts (Collection xs) = do 32 | let msgs = lintOrgFiles cfg (opts ^. kind) orgItems 33 | n = M.foldl' (\acc ms -> acc + length ms) 0 msgs 34 | ecs <- forM (M.assocs msgs) $ \(path, ms) -> case ms of 35 | [] -> do 36 | ec <- 37 | if opts ^. roundTrip 38 | then withSystemTempFile "lint-roundtrip" $ \tmp h -> do 39 | let Just org = find (\o -> o ^. orgFilePath == path) orgItems 40 | writeOrgFile h org 41 | system $ 42 | "diff -U3 \"" 43 | <> path 44 | <> "\" \"" 45 | <> tmp 46 | <> "\"" 47 | else pure ExitSuccess 48 | case ec of 49 | ExitSuccess -> 50 | forM_ (opts ^. checkDir) $ \cdir -> 51 | createCheckFile cdir path 52 | ExitFailure _ -> 53 | putStrLn $ 54 | showLintOrg path (LintMessage 0 LintError FileFailsToRoundTrip) 55 | pure ec 56 | _ -> do 57 | ms' <- findPositions path ms 58 | forM_ ms' $ \msg -> 59 | putStrLn $ showLintOrg path msg 60 | pure ExitSuccess 61 | let n' = n + sum (map (\ec -> case ec of ExitSuccess -> 0; _ -> 1) ecs) 62 | if n' == 0 63 | then do 64 | putStrLn $ show (length xs) ++ " files passed lint" 65 | exitSuccess 66 | else exitWith (ExitFailure n') 67 | where 68 | orgItems = xs ^.. traverse . _OrgItem 69 | 70 | findPositions :: FilePath -> [LintMessage] -> IO [LintMessage] 71 | findPositions path msgs = do 72 | contents <- B.readFile path 73 | let poss = map (\(LintMessage p _ _) -> FP.Pos p) msgs 74 | linesCols = FP.posLineCols contents poss 75 | pure $ 76 | zipWith 77 | ( curry 78 | ( \((ln, _col), LintMessage _ k c) -> 79 | LintMessage (succ ln) k c 80 | ) 81 | ) 82 | linesCols 83 | msgs 84 | 85 | writeOrgFile h org = do 86 | forM_ (showOrgFile cfg org) $ 87 | hPutStrLn h 88 | hClose h 89 | -------------------------------------------------------------------------------- /org-jw/bin/Lint/Options.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE ImportQualifiedPost #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | {-# LANGUAGE TypeApplications #-} 7 | 8 | module Lint.Options where 9 | 10 | import Control.Lens hiding (argument) 11 | import Data.Typeable (Typeable) 12 | import GHC.Generics 13 | import Options.Applicative as OA 14 | import Org.Lint 15 | 16 | data LintOptions = LintOptions 17 | { _kind :: !LintMessageKind, 18 | _checkDir :: !(Maybe FilePath), 19 | _roundTrip :: !Bool 20 | } 21 | deriving (Show, Eq, Typeable, Generic) 22 | 23 | makeLenses ''LintOptions 24 | 25 | lintOptions :: Parser LintOptions 26 | lintOptions = 27 | LintOptions 28 | <$> option 29 | (maybeReader parseLintMessageKind) 30 | ( short 'l' 31 | <> long "level" 32 | <> value LintInfo 33 | <> help "Log level to report" 34 | ) 35 | <*> optional 36 | ( strOption 37 | ( long "check-dir" 38 | <> help "Directory of flags used to check if files are new" 39 | ) 40 | ) 41 | <*> switch 42 | ( long "round-trip" 43 | <> help "Also check files round-trip through parse/print" 44 | ) 45 | -------------------------------------------------------------------------------- /org-jw/bin/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImportQualifiedPost #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | 5 | module Main where 6 | 7 | import Control.Lens hiding ((<.>)) 8 | import Data.Foldable (forM_) 9 | import Data.Text.Lazy.IO (readFile) 10 | import Data.Yaml qualified as Yaml 11 | import FileTags.Exec 12 | import JSON.Exec 13 | import Lint.Exec 14 | import Lint.Options 15 | import Options 16 | import Org.Data 17 | import Org.Print 18 | import Read hiding (readFile) 19 | import Site.Exec 20 | import Stats.Exec 21 | import System.Exit 22 | import Text.Show.Pretty 23 | import Trip.Exec 24 | import Prelude hiding (readFile) 25 | 26 | main :: IO () 27 | main = do 28 | opts <- getOptions 29 | 30 | cfg' <- 31 | Yaml.decodeFileEither (configFile opts) >>= \case 32 | Left err -> do 33 | putStrLn $ 34 | "Could not open or parse config file " 35 | ++ configFile opts 36 | ++ ": " 37 | ++ show err 38 | exitFailure 39 | Right conf -> pure conf 40 | cfg <- case keywordsGraph opts of 41 | Nothing -> pure cfg' 42 | Just path -> applyDotFile cfg' <$> readFile path 43 | 44 | paths <- getInputPaths (inputs opts) 45 | paths' <- case command opts of 46 | Lint lintOpts -> 47 | -- When linting, only check files that have changed since the last lint 48 | -- run, if --check-dir has been given. 49 | winnowPaths (lintOpts ^. checkDir) paths 50 | _ -> pure paths 51 | coll <- readCollectionIO opts cfg paths' 52 | 53 | let orgItems = coll ^.. items . traverse . _OrgItem 54 | case command opts of 55 | Parse -> 56 | putStrLn $ "Parsed " ++ show (length orgItems) ++ " Org-mode files" 57 | Print -> forM_ orgItems $ \org -> 58 | forM_ (showOrgFile cfg org) putStrLn 59 | Dump -> pPrint coll 60 | Outline -> 61 | forM_ orgItems $ \org -> 62 | forM_ (org ^. orgFileEntries) $ 63 | mapM_ putStrLn . summarizeEntry cfg 64 | Json jsonOpts -> execJson cfg jsonOpts coll 65 | Lint lintOpts -> execLint cfg lintOpts coll 66 | Stats statsOpts -> execStats cfg statsOpts coll 67 | Tags tagsOpts -> execTags cfg tagsOpts coll 68 | Trip tripOpts -> execTrip cfg tripOpts coll 69 | Site siteOpts -> execSite opts siteOpts coll 70 | Test -> case orgItems ^.. traverse . allEntries of 71 | [] -> pure () 72 | e : _ -> do 73 | pPrint $ e ^? anyProperty cfg "ID" 74 | pPrint $ e ^? anyProperty cfg "CATEGORY" 75 | pPrint $ e ^? anyProperty cfg "TITLE" 76 | pPrint $ e ^? anyProperty cfg "ITEM" 77 | pPrint $ e ^? anyProperty cfg "FOOBAR" 78 | -------------------------------------------------------------------------------- /org-jw/bin/Options.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE ImportQualifiedPost #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | 8 | module Options where 9 | 10 | import Data.Foldable (Foldable (..)) 11 | import Data.GraphViz 12 | import Data.GraphViz.Attributes.Complete hiding (Paths) 13 | import Data.Map.Strict qualified as M 14 | import Data.Text.Lazy (Text) 15 | import Data.Typeable (Typeable) 16 | import FileTags.Options 17 | import GHC.Generics 18 | import JSON.Options 19 | import Lint.Options 20 | import Options.Applicative as OA 21 | import Org.Types 22 | import Site.Options 23 | import Stats.Options 24 | import Trip.Options 25 | import Prelude hiding (Foldable (..)) 26 | 27 | version :: String 28 | version = "0.0.1" 29 | 30 | copyright :: String 31 | copyright = "2024" 32 | 33 | tradeJournalSummary :: String 34 | tradeJournalSummary = 35 | "org-jw " 36 | ++ version 37 | ++ ", (C) " 38 | ++ copyright 39 | ++ " John Wiegley" 40 | 41 | data Command 42 | = Parse 43 | | Json JsonOptions 44 | | Print 45 | | Dump 46 | | Outline 47 | | Stats StatsOptions 48 | | Lint LintOptions 49 | | Tags TagsOptions 50 | | Test 51 | | Site SiteOptions 52 | | Trip TripOptions 53 | deriving (Show, Eq, Typeable, Generic) 54 | 55 | data InputFiles 56 | = FileFromStdin -- '-f -' 57 | | ListFromStdin -- '-F -' 58 | | Paths [FilePath] -- '...' 59 | | FilesFromFile FilePath -- '-F ' 60 | deriving (Show, Eq, Typeable, Generic, Ord) 61 | 62 | data Options = Options 63 | { verbose :: !Bool, 64 | cacheDir :: !(Maybe FilePath), 65 | configFile :: !FilePath, 66 | keywordsGraph :: !(Maybe FilePath), 67 | command :: !Command, 68 | inputs :: !InputFiles 69 | } 70 | deriving (Show, Eq, Typeable, Generic) 71 | 72 | tradeJournalOpts :: Parser Options 73 | tradeJournalOpts = 74 | Options 75 | <$> switch 76 | ( short 'v' 77 | <> long "verbose" 78 | <> help "Report progress verbosely" 79 | ) 80 | <*> optional 81 | ( strOption 82 | ( long "cache-dir" 83 | <> help "Directory to cache parsed Org-mode files" 84 | ) 85 | ) 86 | <*> strOption 87 | ( short 'c' 88 | <> long "config" 89 | <> help "Path to Yaml configuration file" 90 | ) 91 | <*> optional 92 | ( strOption 93 | ( long "keywords" 94 | <> help "Keywords graph DOT file" 95 | ) 96 | ) 97 | <*> hsubparser 98 | ( parseCommand 99 | <> jsonCommand 100 | <> printCommand 101 | <> dumpCommand 102 | <> outlineCommand 103 | <> statsCommand 104 | <> lintCommand 105 | <> tagsCommand 106 | <> testCommand 107 | <> siteCommand 108 | <> tripCommand 109 | ) 110 | <*> filesOptions 111 | where 112 | filesOptions = 113 | ( ( \x -> 114 | if x == "-" 115 | then ListFromStdin 116 | else FilesFromFile x 117 | ) 118 | <$> strOption 119 | ( short 'F' 120 | <> long "files" 121 | <> help "List of files to process" 122 | ) 123 | ) 124 | <|> ( ( \xs -> 125 | if xs == ["-"] 126 | then FileFromStdin 127 | else Paths xs 128 | ) 129 | <$> some (argument str (metavar "FILES")) 130 | ) 131 | 132 | parseCommand :: Mod CommandFields Command 133 | parseCommand = 134 | OA.command 135 | "parse" 136 | (info (pure Parse) (progDesc "Parse Org-mode file")) 137 | 138 | jsonCommand :: Mod CommandFields Command 139 | jsonCommand = 140 | OA.command 141 | "json" 142 | (info (Json <$> jsonOptions) (progDesc "Output Org-mode file to JSON")) 143 | 144 | printCommand :: Mod CommandFields Command 145 | printCommand = 146 | OA.command 147 | "print" 148 | (info printOptions (progDesc "Print Org-mode file")) 149 | where 150 | printOptions :: Parser Command 151 | printOptions = 152 | pure Print 153 | 154 | dumpCommand :: Mod CommandFields Command 155 | dumpCommand = 156 | OA.command 157 | "dump" 158 | (info dumpOptions (progDesc "Dump Org-mode file")) 159 | where 160 | dumpOptions :: Parser Command 161 | dumpOptions = 162 | pure Dump 163 | 164 | outlineCommand :: Mod CommandFields Command 165 | outlineCommand = 166 | OA.command 167 | "outline" 168 | (info outlineOptions (progDesc "Outline Org-mode file")) 169 | where 170 | outlineOptions :: Parser Command 171 | outlineOptions = 172 | pure Outline 173 | 174 | statsCommand :: Mod CommandFields Command 175 | statsCommand = 176 | OA.command 177 | "stats" 178 | (info (Stats <$> statsOptions) (progDesc "Statistics on Org-mode files")) 179 | 180 | lintCommand :: Mod CommandFields Command 181 | lintCommand = 182 | OA.command 183 | "lint" 184 | (info (Lint <$> lintOptions) (progDesc "Lint Org-mode file")) 185 | 186 | tagsCommand :: Mod CommandFields Command 187 | tagsCommand = 188 | OA.command 189 | "tags" 190 | (info (Tags <$> tagsOptions) (progDesc "Org-mode filetags")) 191 | 192 | testCommand :: Mod CommandFields Command 193 | testCommand = 194 | OA.command 195 | "test" 196 | (info testOptions (progDesc "Test Org-mode file")) 197 | where 198 | testOptions :: Parser Command 199 | testOptions = 200 | pure Test 201 | 202 | siteCommand :: Mod CommandFields Command 203 | siteCommand = 204 | OA.command 205 | "site" 206 | (info (Site <$> siteOptions) (progDesc "Org-mode website builder")) 207 | 208 | tripCommand :: Mod CommandFields Command 209 | tripCommand = 210 | OA.command 211 | "trip" 212 | (info (Trip <$> tripOptions) (progDesc "Org-mode website builder")) 213 | 214 | optionsDefinition :: ParserInfo Options 215 | optionsDefinition = 216 | info 217 | (helper <*> tradeJournalOpts) 218 | (fullDesc <> progDesc "" <> header tradeJournalSummary) 219 | 220 | getOptions :: IO Options 221 | getOptions = execParser optionsDefinition 222 | 223 | applyDotFile :: Config -> Text -> Config 224 | applyDotFile Config {..} dot = Config {..} 225 | where 226 | gr :: DotGraph String 227 | gr = parseDotGraph dot 228 | 229 | _startKeywords = nodesWithColor Red 230 | _openKeywords = _startKeywords ++ nodesWithColor Blue 231 | _closedKeywords = nodesWithColor Green 232 | _keywordTransitions = 233 | M.toList $ 234 | foldl' 235 | ( flip 236 | ( \e -> 237 | M.alter 238 | ( \case 239 | Nothing -> Just [toNode e] 240 | Just ns -> Just (toNode e : ns) 241 | ) 242 | (fromNode e) 243 | ) 244 | ) 245 | mempty 246 | (graphEdges gr) 247 | 248 | nodesWithColor :: X11Color -> [String] 249 | nodesWithColor clr = map nodeID (filter (hasColor clr) (graphNodes gr)) 250 | 251 | hasColor :: X11Color -> DotNode String -> Bool 252 | hasColor clr = 253 | any 254 | ( \case 255 | Color cs -> 256 | any 257 | ( \c -> case wColor c of 258 | X11Color x11 -> x11 == clr 259 | _ -> False 260 | ) 261 | cs 262 | _ -> False 263 | ) 264 | . nodeAttributes 265 | -------------------------------------------------------------------------------- /org-jw/bin/Read.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BlockArguments #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE ImportQualifiedPost #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | 6 | module Read where 7 | 8 | import Control.Concurrent.ParallelIO qualified as PIO 9 | import Control.Monad (filterM, foldM, join, unless) 10 | import Control.Monad.Except 11 | import Control.Monad.IO.Class 12 | import Data.ByteString (ByteString) 13 | import Data.ByteString qualified as B 14 | import Data.Text qualified as T 15 | import Data.Text.Encoding qualified as T 16 | import Data.Time 17 | import Data.Traversable (forM) 18 | import FlatParse.Stateful qualified as FP 19 | import Options 20 | import Org.CBOR 21 | import Org.Parse 22 | import Org.Types 23 | import System.Directory 24 | import System.FilePath.Posix 25 | import System.IO 26 | 27 | checkFilePath :: FilePath -> FilePath -> FilePath 28 | checkFilePath cdir path = 29 | cdir takeBaseName (map repl path) <.> "chk" 30 | where 31 | repl '/' = '!' 32 | repl c = c 33 | 34 | createCheckFile :: FilePath -> FilePath -> IO () 35 | createCheckFile cdir path = do 36 | existsDir <- doesDirectoryExist cdir 37 | unless existsDir $ 38 | createDirectoryIfMissing True cdir 39 | writeFile checkFile "" 40 | where 41 | checkFile = checkFilePath cdir path 42 | 43 | fileIsChanged :: Maybe FilePath -> FilePath -> IO Bool 44 | fileIsChanged (Just cdir) path = do 45 | existsDir <- doesDirectoryExist cdir 46 | if existsDir 47 | then do 48 | existsFile <- doesFileExist checkFile 49 | if existsFile 50 | then do 51 | checkTime <- getModificationTime checkFile 52 | fileTime <- getModificationTime path 53 | pure $ diffUTCTime fileTime checkTime >= 0 54 | else pure True 55 | else pure True 56 | where 57 | checkFile = checkFilePath cdir path 58 | fileIsChanged Nothing _ = pure True 59 | 60 | winnowPaths :: Maybe FilePath -> [FilePath] -> IO [FilePath] 61 | winnowPaths = filterM . fileIsChanged 62 | 63 | readOrgFile :: 64 | (MonadError (Loc, String) m, MonadIO m) => 65 | Options -> 66 | Config -> 67 | FilePath -> 68 | m OrgFile 69 | readOrgFile opts cfg path = case cacheDir opts of 70 | Just cdir -> do 71 | let cacheFile = 72 | cdir 73 | takeBaseName (map repl path) 74 | <.> "cbor" 75 | existsDir <- liftIO $ doesDirectoryExist cdir 76 | unless existsDir $ 77 | liftIO $ 78 | createDirectoryIfMissing True cdir 79 | existsFile <- liftIO $ doesFileExist cacheFile 80 | if existsFile 81 | then do 82 | cacheTime <- liftIO $ getModificationTime cacheFile 83 | fileTime <- liftIO $ getModificationTime path 84 | if diffUTCTime fileTime cacheTime < 0 85 | then do 86 | mres <- liftIO $ orgFileFromCBOR cacheFile 87 | case mres of 88 | Left _err -> go (Just cacheFile) 89 | Right org -> pure org 90 | else go (Just cacheFile) 91 | else go (Just cacheFile) 92 | Nothing -> go Nothing 93 | where 94 | repl '/' = '!' 95 | repl c = c 96 | 97 | go mjson = do 98 | eres <- 99 | liftIO $ 100 | withFile path ReadMode $ 101 | fmap (parseOrgFile cfg path) . B.hGetContents 102 | case (mjson, eres) of 103 | (_, Left err) -> throwError err 104 | (Nothing, Right org) -> pure org 105 | (Just json, Right org) -> do 106 | liftIO $ orgFileToCBOR json org 107 | pure org 108 | 109 | readStdin :: (MonadIO m) => m ByteString 110 | readStdin = liftIO B.getContents 111 | 112 | readFile :: (MonadIO m) => FilePath -> m ByteString 113 | readFile path = liftIO (B.readFile path) 114 | 115 | readLines :: (MonadIO m) => FilePath -> m [String] 116 | readLines path = lines <$> liftIO (System.IO.readFile path) 117 | 118 | readCollectionItem :: 119 | (MonadError (Loc, String) m, MonadIO m) => 120 | Options -> 121 | Config -> 122 | FilePath -> 123 | m CollectionItem 124 | readCollectionItem opts cfg path = do 125 | if takeExtension path == ".org" 126 | then OrgItem <$> readOrgFile opts cfg path 127 | else pure $ DataItem path 128 | 129 | foldCollection :: 130 | (MonadError (Loc, String) m, MonadIO m) => 131 | Options -> 132 | Config -> 133 | [FilePath] -> 134 | a -> 135 | (FilePath -> Either (Loc, String) CollectionItem -> a -> m a) -> 136 | m a 137 | foldCollection opts cfg paths z f = 138 | (\k -> foldM k z paths) $ \acc path -> 139 | tryError (readCollectionItem opts cfg path) >>= \eres -> 140 | f path eres acc 141 | 142 | readCollection :: 143 | (MonadError (Loc, String) m, MonadIO m) => 144 | Options -> 145 | Config -> 146 | [FilePath] -> 147 | m Collection 148 | readCollection opts cfg paths = 149 | Collection <$> foldCollection opts cfg paths [] go 150 | where 151 | go _path (Left err) _ = throwError err 152 | go _path (Right x) acc = pure (x : acc) 153 | 154 | mapCollection :: 155 | Options -> 156 | Config -> 157 | [FilePath] -> 158 | [IO (Either (Loc, String) CollectionItem)] 159 | mapCollection opts cfg = map \path -> 160 | join <$> runExceptT (tryError (readCollectionItem opts cfg path)) 161 | 162 | readCollectionIO :: 163 | Options -> 164 | Config -> 165 | [FilePath] -> 166 | IO Collection 167 | readCollectionIO opts cfg paths = do 168 | coll <- PIO.parallelInterleaved $ mapCollection opts cfg paths 169 | PIO.stopGlobalPool 170 | fmap (Collection . concat) $ forM coll $ \case 171 | Left (loc, err) -> do 172 | contents <- B.readFile (_file loc) 173 | case FP.posLineCols contents [FP.Pos (_pos loc)] of 174 | [(line, col)] -> do 175 | putStrLn $ 176 | _file loc 177 | ++ ":" 178 | ++ show (succ line) 179 | ++ ":" 180 | ++ show col 181 | ++ ": PARSE ERROR: " 182 | ++ err 183 | pure [] 184 | _ -> error "impossible" 185 | Right x -> pure [x] 186 | 187 | getInputPaths :: InputFiles -> IO [FilePath] 188 | getInputPaths = \case 189 | FileFromStdin -> pure [""] 190 | Paths paths -> pure paths 191 | ListFromStdin -> map T.unpack . T.lines . T.decodeUtf8 <$> readStdin 192 | FilesFromFile path -> readLines path 193 | -------------------------------------------------------------------------------- /org-jw/bin/Site/Exec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImportQualifiedPost #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | 7 | module Site.Exec where 8 | 9 | import Data.Time 10 | import Hakyll as Hakyll 11 | import Options as Org 12 | import Org.Site 13 | import Org.Types 14 | import Site.Options as Site 15 | import System.Directory 16 | import System.Exit 17 | import System.FilePath 18 | import Prelude hiding (readFile) 19 | 20 | execSite :: Org.Options -> SiteOptions -> Collection -> IO () 21 | execSite opts siteOpts (Collection (DataItem config : _)) = do 22 | now <- getCurrentTime 23 | siteConfig <- readSiteConfiguration config 24 | withCurrentDirectory (takeDirectory config) $ 25 | hakyllWithArgs 26 | defaultConfiguration 27 | { destinationDirectory = "_site", 28 | storeDirectory = "_cache", 29 | tmpDirectory = "_cache/tmp", 30 | providerDirectory = ".", 31 | deployCommand = siteDeploy siteConfig, 32 | inMemoryCache = True, 33 | previewHost = "127.0.0.1", 34 | previewPort = 8000, 35 | provideMetadata = pandocMetadata (Just (siteName siteConfig)) 36 | } 37 | Hakyll.Options 38 | { verbosity = Org.verbose opts, 39 | optCommand = Site._hakyllCommand siteOpts 40 | } 41 | (siteRules now siteConfig) 42 | execSite _ _ _ = do 43 | putStrLn "usage: org site " 44 | exitFailure 45 | -------------------------------------------------------------------------------- /org-jw/bin/Site/Options.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE ImportQualifiedPost #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE StandaloneDeriving #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | {-# LANGUAGE TypeApplications #-} 8 | {-# OPTIONS_GHC -Wno-orphans #-} 9 | 10 | module Site.Options where 11 | 12 | import Control.Lens hiding (argument) 13 | import Data.Typeable (Typeable) 14 | import GHC.Generics 15 | import Hakyll qualified as H 16 | import Hakyll.Core.Runtime qualified 17 | import Options.Applicative as OA 18 | 19 | deriving instance Eq Hakyll.Core.Runtime.RunMode 20 | 21 | deriving instance Eq H.Command 22 | 23 | data SiteOptions = SiteOptions 24 | { _hakyllCommand :: H.Command 25 | } 26 | deriving (Show, Eq, Typeable, Generic) 27 | 28 | makeLenses ''SiteOptions 29 | 30 | siteOptions :: Parser SiteOptions 31 | siteOptions = SiteOptions <$> H.commandParser H.defaultConfiguration 32 | -------------------------------------------------------------------------------- /org-jw/bin/Stats/Exec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImportQualifiedPost #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | module Stats.Exec where 6 | 7 | import Control.Lens hiding ((<.>)) 8 | import Control.Monad.State 9 | import Data.Foldable (forM_) 10 | import Data.List (sortOn) 11 | import Data.Map.Strict qualified as M 12 | import Org.Data 13 | import Org.Types 14 | import Stats.Options 15 | import System.IO 16 | import Prelude hiding (readFile) 17 | 18 | fsize :: FilePath -> IO Integer 19 | fsize path = withFile path ReadMode hFileSize 20 | 21 | execStats :: Config -> StatsOptions -> Collection -> IO () 22 | execStats cfg _opts coll = do 23 | putStrLn $ show (length orgItems) ++ " files" 24 | 25 | totalSize <- sum <$> mapM (fsize . view orgFilePath) orgItems 26 | putStrLn $ show (fromIntegral totalSize / 1024.0 / 1024.0 :: Double) ++ " MB" 27 | 28 | putStrLn $ show (length orgEntries) ++ " entries" 29 | putStrLn $ show (length orgTodos) ++ " items" 30 | putStrLn $ show (length orgOpenTodos) ++ " open items" 31 | putStrLn $ show (length orgTodos - length orgOpenTodos) ++ " closed items" 32 | 33 | putStrLn "\nKeywords:" 34 | showStats allKeywords id 35 | 36 | putStrLn "\nTags:" 37 | showStats allTags (\(PlainTag t) -> t) 38 | 39 | putStrLn "\nPriorities:" 40 | showStats (itemsUsed entryPriority) id 41 | 42 | putStrLn "\nVerbs:" 43 | showStats (itemsUsed entryVerb) id 44 | 45 | -- putStrLn "\nContexts:" 46 | -- showStats (itemsUsed entryContext) id 47 | 48 | -- putStrLn "\nLocators:" 49 | -- showStats (itemsUsed entryLocator) id 50 | 51 | putStrLn "\nDrawers:" 52 | let drawersUsed = flip execState M.empty $ 53 | forM_ orgEntries $ \ent -> 54 | forM_ 55 | (ent ^.. entryBody . blocks . traverse . _Drawer . _2 . to show) 56 | register 57 | showStats drawersUsed id 58 | 59 | putStrLn "\nProperty keys:" 60 | let propertiesUsed = flip execState M.empty $ do 61 | forM_ 62 | ( orgItems 63 | ^.. traverse 64 | . orgFileHeader 65 | . headerPropertiesDrawer 66 | . traverse 67 | . name 68 | ) 69 | register 70 | forM_ 71 | ( orgItems 72 | ^.. traverse 73 | . orgFileHeader 74 | . headerFileProperties 75 | . traverse 76 | . name 77 | ) 78 | register 79 | forM_ orgEntries $ \ent -> 80 | forM_ 81 | (ent ^.. entryProperties . traverse . name) 82 | register 83 | showStats propertiesUsed id 84 | 85 | putStrLn "\nLog entry types:" 86 | let logsUsed = flip execState M.empty $ 87 | forM_ orgEntries $ \ent -> 88 | forM_ 89 | ( ent 90 | ^.. entryLogEntries 91 | . traverse 92 | . cosmos 93 | . _LogKey 94 | ) 95 | register 96 | showStats logsUsed id 97 | 98 | putStrLn "\nTimestamps:" 99 | let stampsUsed = flip execState M.empty $ 100 | forM_ orgEntries $ \ent -> 101 | forM_ 102 | ( ent 103 | ^.. entryStamps 104 | . traverse 105 | . cosmos 106 | . _StampKey 107 | ) 108 | register 109 | showStats stampsUsed id 110 | where 111 | _StampKey :: (Applicative f) => (String -> f String) -> Stamp -> f Stamp 112 | _StampKey f e = case e of 113 | ClosedStamp _ _ -> e <$ f "Closed" 114 | ScheduledStamp _ _ -> e <$ f "Scheduled" 115 | DeadlineStamp _ _ -> e <$ f "Deadline" 116 | ActiveStamp _ _ -> e <$ f "Active" 117 | 118 | _LogKey :: (Applicative f) => (String -> f String) -> LogEntry -> f LogEntry 119 | _LogKey f e = case e of 120 | LogClosing _ _ _ -> e <$ f "LogClosing" 121 | LogState _ _ _ _ _ -> e <$ f "LogState" 122 | LogNote _ _ _ -> e <$ f "LogNote" 123 | LogRescheduled _ _ _ _ -> e <$ f "LogRescheduled" 124 | LogNotScheduled _ _ _ _ -> e <$ f "LogNotScheduled" 125 | LogDeadline _ _ _ _ -> e <$ f "LogDeadline" 126 | LogNoDeadline _ _ _ _ -> e <$ f "LogNoDeadline" 127 | LogRefiling _ _ _ -> e <$ f "LogRefiling" 128 | LogClock _ _ _ -> e <$ f "LogClock" 129 | LogBook _ _ -> e <$ f "LogBook" 130 | 131 | orgItems = coll ^.. items . traverse . _OrgItem 132 | orgEntries = orgItems ^.. traverse . allEntries 133 | orgTodos = orgEntries ^.. traverse . keyword . filtered (isTodo cfg) 134 | orgOpenTodos = orgTodos ^.. traverse . filtered (isOpenTodo cfg) 135 | 136 | allKeywords = countEntries coll $ \e m k -> 137 | k m $ case e ^. entryKeyword of 138 | Nothing -> "" 139 | Just (OpenKeyword _ kw) -> kw 140 | Just (ClosedKeyword _ kw) -> kw 141 | 142 | allTags = countEntries coll $ \e m k -> 143 | foldr (flip k) m (e ^. entryTags) 144 | 145 | register k = 146 | at k %= \case 147 | Nothing -> Just (1 :: Int) 148 | Just n -> Just (succ n) 149 | 150 | itemsUsed l = flip execState M.empty $ 151 | forM_ orgEntries $ \ent -> 152 | forM_ (ent ^. l) register 153 | 154 | showStats m k = 155 | forM_ (reverse (sortOn snd (M.assocs m))) $ \(x, n) -> 156 | putStrLn $ " " ++ show n ++ " " ++ k x 157 | -------------------------------------------------------------------------------- /org-jw/bin/Stats/Options.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | 4 | module Stats.Options where 5 | 6 | import Data.Typeable (Typeable) 7 | import GHC.Generics 8 | import Options.Applicative as OA 9 | 10 | data StatsOptions = StatsOptions 11 | { _changeInPlace :: !Bool 12 | } 13 | deriving (Show, Eq, Typeable, Generic) 14 | 15 | statsOptions :: Parser StatsOptions 16 | statsOptions = 17 | StatsOptions 18 | <$> switch 19 | ( long "change-in-place" 20 | <> help "If used, replace original file instead of generating diff" 21 | ) 22 | -------------------------------------------------------------------------------- /org-jw/bin/Trip/Exec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImportQualifiedPost #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | 7 | module Trip.Exec where 8 | 9 | import Control.Lens hiding ((<.>)) 10 | import Control.Monad (void) 11 | import Data.Foldable (forM_) 12 | import Org.Data 13 | import Org.Print 14 | import Org.Types 15 | import System.IO hiding (readFile) 16 | import System.IO.Temp 17 | import System.Process 18 | import Trip.Options 19 | import Prelude hiding (readFile) 20 | 21 | execTrip :: Config -> TripOptions -> Collection -> IO () 22 | execTrip cfg opts coll = do 23 | forM_ (coll ^.. items . traverse . _OrgItem) $ \org -> 24 | if _changeInPlace opts 25 | then withFile (org ^. orgFilePath) WriteMode $ \h -> 26 | writeOrgFile h org 27 | else withSystemTempFile "roundtrip" $ \tmp h -> do 28 | writeOrgFile h org 29 | void $ 30 | system $ 31 | "diff -U3 \"" 32 | <> org ^. orgFilePath 33 | <> "\" \"" 34 | <> tmp 35 | <> "\"" 36 | where 37 | writeOrgFile h org = do 38 | forM_ (showOrgFile cfg org) $ 39 | hPutStrLn h 40 | hClose h 41 | -------------------------------------------------------------------------------- /org-jw/bin/Trip/Options.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | 4 | module Trip.Options where 5 | 6 | import Data.Typeable (Typeable) 7 | import GHC.Generics 8 | import Options.Applicative as OA 9 | 10 | data TripOptions = TripOptions 11 | { _changeInPlace :: !Bool 12 | } 13 | deriving (Show, Eq, Typeable, Generic) 14 | 15 | tripOptions :: Parser TripOptions 16 | tripOptions = 17 | TripOptions 18 | <$> switch 19 | ( long "change-in-place" 20 | <> help "If used, replace original file instead of generating diff" 21 | ) 22 | -------------------------------------------------------------------------------- /org-jw/org-jw.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.37.0. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: org-jw 8 | version: 0.0.1 9 | description: Implementation of expression language used by the Tinderbox application 10 | author: John Wiegley 11 | maintainer: johnw@newartisans.com 12 | license: BSD3 13 | license-file: LICENSE 14 | build-type: Simple 15 | 16 | executable org 17 | main-is: Main.hs 18 | other-modules: 19 | Options 20 | Read 21 | JSON.Options 22 | JSON.Exec 23 | Lint.Options 24 | Lint.Exec 25 | Trip.Options 26 | Trip.Exec 27 | Stats.Options 28 | Stats.Exec 29 | FileTags.Options 30 | FileTags.Exec 31 | Site.Options 32 | Site.Exec 33 | hs-source-dirs: 34 | bin 35 | ghc-options: -Wall -Wno-missing-home-modules -fprof-auto -threaded -rtsopts -with-rtsopts=-N 36 | build-depends: 37 | aeson 38 | , base >=4.5 39 | , bytestring 40 | , containers 41 | , directory 42 | , filepath 43 | , flatparse 44 | , flatparse-util 45 | , graphviz 46 | , hakyll >=4.16.6.0 47 | , lens 48 | , mtl 49 | , optparse-applicative 50 | , org-cbor 51 | , org-data 52 | , org-filetags 53 | , org-json 54 | , org-lint 55 | , org-parse 56 | , org-print 57 | , org-site 58 | , org-types 59 | , parallel-io 60 | , pretty-show 61 | , process 62 | , temporary 63 | , text 64 | , time 65 | , yaml 66 | default-language: Haskell2010 67 | -------------------------------------------------------------------------------- /org-jw/package.yaml: -------------------------------------------------------------------------------- 1 | name: org-jw 2 | version: 0.0.1 3 | license: BSD3 4 | author: John Wiegley 5 | maintainer: johnw@newartisans.com 6 | description: Implementation of expression language used by the Tinderbox application 7 | 8 | ghc-options: 9 | - -Wall 10 | - -Wno-missing-home-modules 11 | - -fprof-auto 12 | 13 | dependencies: 14 | - base >= 4.5 15 | - aeson 16 | - bytestring 17 | - containers 18 | - directory 19 | - filepath 20 | - flatparse 21 | - flatparse-util 22 | - graphviz 23 | - hakyll >= 4.16.6.0 24 | - lens 25 | - mtl 26 | - optparse-applicative 27 | - parallel-io 28 | - pretty-show 29 | - process 30 | - temporary 31 | - text 32 | - time 33 | - yaml 34 | 35 | executables: 36 | org: 37 | main: Main.hs 38 | source-dirs: bin 39 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 40 | other-modules: 41 | - Options 42 | - Read 43 | - JSON.Options 44 | - JSON.Exec 45 | - Lint.Options 46 | - Lint.Exec 47 | - Trip.Options 48 | - Trip.Exec 49 | - Stats.Options 50 | - Stats.Exec 51 | - FileTags.Options 52 | - FileTags.Exec 53 | - Site.Options 54 | - Site.Exec 55 | dependencies: 56 | - org-types 57 | - org-parse 58 | - org-print 59 | - org-data 60 | - org-lint 61 | - org-cbor 62 | - org-json 63 | - org-filetags 64 | - org-site 65 | -------------------------------------------------------------------------------- /org-lint/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, John Wiegley 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of John Wiegley nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /org-lint/README.md: -------------------------------------------------------------------------------- 1 | # org-data 2 | 3 | Hello. 4 | -------------------------------------------------------------------------------- /org-lint/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /org-lint/org-lint.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.36.1. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: org-lint 8 | version: 0.0.1 9 | description: Org-mode parser and data drier 10 | author: John Wiegley 11 | maintainer: johnw@newartisans.com 12 | license: BSD3 13 | license-file: LICENSE 14 | build-type: Simple 15 | 16 | library 17 | exposed-modules: 18 | Org.Lint 19 | other-modules: 20 | Paths_org_lint 21 | hs-source-dirs: 22 | src 23 | ghc-options: -Wall -Wno-missing-home-modules -fprof-auto 24 | build-depends: 25 | base >=4.5 26 | , base16-bytestring 27 | , containers 28 | , cryptohash-sha512 29 | , deepseq 30 | , directory 31 | , filepath 32 | , lens 33 | , monad-par 34 | , mtl 35 | , org-data 36 | , org-parse 37 | , org-print 38 | , org-types 39 | , pretty-show 40 | , process 41 | , regex-tdfa 42 | , text 43 | , transformers 44 | default-language: Haskell2010 45 | -------------------------------------------------------------------------------- /org-lint/package.yaml: -------------------------------------------------------------------------------- 1 | name: org-lint 2 | version: 0.0.1 3 | license: BSD3 4 | author: John Wiegley 5 | maintainer: johnw@newartisans.com 6 | description: Org-mode parser and data drier 7 | 8 | ghc-options: 9 | - -Wall 10 | - -Wno-missing-home-modules 11 | - -fprof-auto 12 | 13 | dependencies: 14 | - base >= 4.5 15 | - base16-bytestring 16 | - containers 17 | - cryptohash-sha512 18 | - deepseq 19 | - directory 20 | - filepath 21 | - lens 22 | - monad-par 23 | - mtl 24 | - pretty-show 25 | - process 26 | - regex-tdfa 27 | - text 28 | - transformers 29 | 30 | library: 31 | source-dirs: src 32 | exposed-modules: 33 | - Org.Lint 34 | dependencies: 35 | - org-types 36 | - org-parse 37 | - org-print 38 | - org-data 39 | -------------------------------------------------------------------------------- /org-lint/tests/inconsistent-whitespace-test.org: -------------------------------------------------------------------------------- 1 | :PROPERTIES: 2 | :ID: D5DDF562-6905-48E7-9BA8-42BB6DEEAF5B 3 | :CREATED: [2024-10-07 Mon 20:15] 4 | :END: 5 | #+filetags: :todo: 6 | #+title: Inconsistent whitespace test 7 | 8 | * Trailing whitespace 9 | ** TODO Test 1 10 | :PROPERTIES: 11 | :ID: 985479B7-EFB6-4390-8C03-F5796EF09BA8 12 | :CREATED: [2018-06-01 Fri 16:02] 13 | :END: 14 | - Note taken on [2018-06-10 Sun 08:57] \\ 15 | alpha 16 | 17 | - Note taken on [2018-06-10 Sun 08:57] \\ 18 | beta 19 | 20 | - Note taken on [2018-06-10 Sun 08:56] \\ 21 | gamma 22 | ** TODO Test 2 23 | :PROPERTIES: 24 | :ID: 868B41BE-153C-457A-B013-B691A076485C 25 | :CREATED: [2018-06-01 Fri 16:02] 26 | :END: 27 | - Note taken on [2018-06-10 Sun 08:57] \\ 28 | alpha 29 | 30 | - Note taken on [2018-06-10 Sun 08:57] \\ 31 | beta 32 | 33 | - Note taken on [2018-06-10 Sun 08:56] \\ 34 | gamma 35 | 36 | ** CANCELED Test 3: Whitespace after log entries is inconsistent 37 | :PROPERTIES: 38 | :ID: C4AA131C-8BE8-4CDB-8F97-B6C4EEB15D3B 39 | :CREATED: [2018-06-01 Fri 16:02] 40 | :END: 41 | - Note taken on [2018-06-10 Sun 08:57] \\ 42 | alpha 43 | 44 | - Note taken on [2018-06-10 Sun 08:57] \\ 45 | beta 46 | 47 | - Note taken on [2018-06-10 Sun 08:56] \\ 48 | gamma 49 | Body 50 | ** TODO Test 4 51 | :PROPERTIES: 52 | :ID: 014B6B00-A826-4707-829C-B96E95DDEE7F 53 | :CREATED: [2018-06-01 Fri 16:02] 54 | :END: 55 | - Note taken on [2018-06-10 Sun 08:57] \\ 56 | alpha 57 | 58 | - Note taken on [2018-06-10 Sun 08:57] \\ 59 | beta 60 | 61 | - Note taken on [2018-06-10 Sun 08:56] \\ 62 | gamma 63 | 64 | Body 65 | ** CANCELED Test 5: Body space inconsistent 66 | :PROPERTIES: 67 | :ID: 7B32CDEF-C108-4231-81C3-0C6BE2014D65 68 | :CREATED: [2018-06-01 Fri 16:02] 69 | :END: 70 | - Note taken on [2018-06-10 Sun 08:57] \\ 71 | alpha 72 | 73 | - Note taken on [2018-06-10 Sun 08:57] \\ 74 | beta 75 | 76 | - Note taken on [2018-06-10 Sun 08:56] \\ 77 | gamma 78 | Body 79 | 80 | ** TODO Test 6 81 | :PROPERTIES: 82 | :ID: 6175A916-D19C-471E-9213-5F7F3CE58268 83 | :CREATED: [2018-06-01 Fri 16:02] 84 | :END: 85 | - Note taken on [2018-06-10 Sun 08:57] \\ 86 | alpha 87 | 88 | - Note taken on [2018-06-10 Sun 08:57] \\ 89 | beta 90 | 91 | - Note taken on [2018-06-10 Sun 08:56] \\ 92 | gamma 93 | 94 | Body 95 | 96 | * Leading whitespace 97 | ** TODO Test 7 98 | :PROPERTIES: 99 | :ID: BB4B77B1-7BC4-444D-B90A-72CECD60DFA2 100 | :CREATED: [2018-06-01 Fri 16:02] 101 | :END: 102 | - Note taken on [2018-06-10 Sun 08:57] \\ 103 | 104 | alpha 105 | - Note taken on [2018-06-10 Sun 08:57] \\ 106 | 107 | beta 108 | - Note taken on [2018-06-10 Sun 08:56] \\ 109 | 110 | gamma 111 | ** TODO Test 8 112 | :PROPERTIES: 113 | :ID: CB47E412-10E1-4271-A7E0-C84ED31BCE63 114 | :CREATED: [2018-06-01 Fri 16:02] 115 | :END: 116 | - Note taken on [2018-06-10 Sun 08:57] \\ 117 | 118 | alpha 119 | - Note taken on [2018-06-10 Sun 08:57] \\ 120 | 121 | beta 122 | - Note taken on [2018-06-10 Sun 08:56] \\ 123 | 124 | gamma 125 | Body 126 | ** CANCELED Test 9: Whitespace after log entries is inconsistent 127 | :PROPERTIES: 128 | :ID: 54B58057-BA0C-40FF-BB8E-76C20275C18D 129 | :CREATED: [2018-06-01 Fri 16:02] 130 | :END: 131 | - Note taken on [2018-06-10 Sun 08:57] \\ 132 | 133 | alpha 134 | - Note taken on [2018-06-10 Sun 08:57] \\ 135 | 136 | beta 137 | - Note taken on [2018-06-10 Sun 08:56] \\ 138 | 139 | gamma 140 | 141 | Body 142 | ** CANCELED Test 10: Body space inconsistent 143 | :PROPERTIES: 144 | :ID: 2FBDCD2A-41EB-4099-AB29-FD462F70C52E 145 | :CREATED: [2018-06-01 Fri 16:02] 146 | :END: 147 | - Note taken on [2018-06-10 Sun 08:57] \\ 148 | 149 | alpha 150 | - Note taken on [2018-06-10 Sun 08:57] \\ 151 | 152 | beta 153 | - Note taken on [2018-06-10 Sun 08:56] \\ 154 | 155 | gamma 156 | Body 157 | 158 | ** TODO Test 11 159 | :PROPERTIES: 160 | :ID: C12721FA-CEF1-4E63-B7C4-3EAF8542507F 161 | :CREATED: [2018-06-01 Fri 16:02] 162 | :END: 163 | - Note taken on [2018-06-10 Sun 08:57] \\ 164 | 165 | alpha 166 | - Note taken on [2018-06-10 Sun 08:57] \\ 167 | 168 | beta 169 | - Note taken on [2018-06-10 Sun 08:56] \\ 170 | 171 | gamma 172 | 173 | Body 174 | 175 | * Trailing and trailing whitespace 176 | ** TODO Test 12 177 | :PROPERTIES: 178 | :ID: 6F7106B5-CACD-4AF4-913E-18AB65BAD95E 179 | :CREATED: [2018-06-01 Fri 16:02] 180 | :END: 181 | - Note taken on [2018-06-10 Sun 08:57] \\ 182 | 183 | alpha 184 | 185 | - Note taken on [2018-06-10 Sun 08:57] \\ 186 | 187 | beta 188 | 189 | - Note taken on [2018-06-10 Sun 08:56] \\ 190 | 191 | gamma 192 | ** TODO Test 13 193 | :PROPERTIES: 194 | :ID: 10552068-24EC-490F-84D5-3B6E7C160DF8 195 | :CREATED: [2018-06-01 Fri 16:02] 196 | :END: 197 | - Note taken on [2018-06-10 Sun 08:57] \\ 198 | 199 | alpha 200 | 201 | - Note taken on [2018-06-10 Sun 08:57] \\ 202 | 203 | beta 204 | 205 | - Note taken on [2018-06-10 Sun 08:56] \\ 206 | 207 | gamma 208 | 209 | ** TODO Test 14 210 | :PROPERTIES: 211 | :ID: 8C07784B-AC22-4B7F-AE06-75189AA98582 212 | :CREATED: [2018-06-01 Fri 16:02] 213 | :END: 214 | - Note taken on [2018-06-10 Sun 08:57] \\ 215 | 216 | alpha 217 | 218 | - Note taken on [2018-06-10 Sun 08:57] \\ 219 | 220 | beta 221 | 222 | - Note taken on [2018-06-10 Sun 08:56] \\ 223 | 224 | gamma 225 | 226 | Body 227 | ** TODO Test 15 228 | :PROPERTIES: 229 | :ID: 8D7A089A-E54E-4A72-9DB2-306A7E9DED11 230 | :CREATED: [2018-06-01 Fri 16:02] 231 | :END: 232 | - Note taken on [2018-06-10 Sun 08:57] \\ 233 | 234 | alpha 235 | 236 | - Note taken on [2018-06-10 Sun 08:57] \\ 237 | 238 | beta 239 | 240 | - Note taken on [2018-06-10 Sun 08:56] \\ 241 | 242 | gamma 243 | 244 | Body 245 | 246 | * No whitespace 247 | ** TODO Test 16 248 | :PROPERTIES: 249 | :ID: 6D012E33-920B-4193-A4E1-41F3A1AA6D63 250 | :CREATED: [2018-06-01 Fri 16:02] 251 | :END: 252 | - Note taken on [2018-06-10 Sun 08:57] \\ 253 | alpha 254 | - Note taken on [2018-06-10 Sun 08:57] \\ 255 | beta 256 | - Note taken on [2018-06-10 Sun 08:56] \\ 257 | gamma 258 | ** TODO Test 17 259 | :PROPERTIES: 260 | :ID: C47CBD09-AA45-4452-8765-912453EE85E9 261 | :CREATED: [2018-06-01 Fri 16:02] 262 | :END: 263 | - Note taken on [2018-06-10 Sun 08:57] \\ 264 | alpha 265 | - Note taken on [2018-06-10 Sun 08:57] \\ 266 | beta 267 | - Note taken on [2018-06-10 Sun 08:56] \\ 268 | gamma 269 | Body 270 | ** CANCELED Test 18: Whitespace after log entries is inconsistent 271 | :PROPERTIES: 272 | :ID: 687A50D4-9F43-4A2D-AE91-D47391B5952B 273 | :CREATED: [2018-06-01 Fri 16:02] 274 | :END: 275 | - Note taken on [2018-06-10 Sun 08:57] \\ 276 | alpha 277 | - Note taken on [2018-06-10 Sun 08:57] \\ 278 | beta 279 | - Note taken on [2018-06-10 Sun 08:56] \\ 280 | gamma 281 | 282 | Body 283 | ** CANCELED Test 19: Body space inconsistent 284 | :PROPERTIES: 285 | :ID: 7F2D472D-2F51-41F6-9B2A-1020742691E2 286 | :CREATED: [2018-06-01 Fri 16:02] 287 | :END: 288 | - Note taken on [2018-06-10 Sun 08:57] \\ 289 | alpha 290 | - Note taken on [2018-06-10 Sun 08:57] \\ 291 | beta 292 | - Note taken on [2018-06-10 Sun 08:56] \\ 293 | gamma 294 | Body 295 | 296 | ** TODO Test 20 297 | :PROPERTIES: 298 | :ID: A9E8EA2F-DE19-4E24-8A84-D9435D4192EE 299 | :CREATED: [2018-06-01 Fri 16:02] 300 | :END: 301 | - Note taken on [2018-06-10 Sun 08:57] \\ 302 | alpha 303 | - Note taken on [2018-06-10 Sun 08:57] \\ 304 | beta 305 | - Note taken on [2018-06-10 Sun 08:56] \\ 306 | gamma 307 | 308 | Body 309 | 310 | * End 311 | -------------------------------------------------------------------------------- /org-parse/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, John Wiegley 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of John Wiegley nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /org-parse/README.md: -------------------------------------------------------------------------------- 1 | # org-data 2 | 3 | Hello. 4 | -------------------------------------------------------------------------------- /org-parse/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /org-parse/org-parse.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.36.1. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: org-parse 8 | version: 0.0.1 9 | description: Org-mode parser 10 | author: John Wiegley 11 | maintainer: johnw@newartisans.com 12 | license: BSD3 13 | license-file: LICENSE 14 | build-type: Simple 15 | 16 | library 17 | exposed-modules: 18 | Org.Parse 19 | other-modules: 20 | Paths_org_parse 21 | hs-source-dirs: 22 | src 23 | ghc-options: -Wall -Wno-missing-home-modules -fprof-auto 24 | build-depends: 25 | base >=4.5 26 | , bytestring 27 | , flatparse 28 | , flatparse-util 29 | , org-types 30 | , text 31 | , time 32 | default-language: Haskell2010 33 | -------------------------------------------------------------------------------- /org-parse/package.yaml: -------------------------------------------------------------------------------- 1 | name: org-parse 2 | version: 0.0.1 3 | license: BSD3 4 | author: John Wiegley 5 | maintainer: johnw@newartisans.com 6 | description: Org-mode parser 7 | 8 | ghc-options: 9 | - -Wall 10 | - -Wno-missing-home-modules 11 | - -fprof-auto 12 | 13 | dependencies: 14 | - base >= 4.5 15 | - bytestring 16 | - flatparse 17 | - flatparse-util 18 | - text 19 | - time 20 | 21 | library: 22 | source-dirs: src 23 | exposed-modules: 24 | - Org.Parse 25 | dependencies: 26 | - org-types 27 | -------------------------------------------------------------------------------- /org-print/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, John Wiegley 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of John Wiegley nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /org-print/README.md: -------------------------------------------------------------------------------- 1 | # org-data 2 | 3 | Hello. 4 | -------------------------------------------------------------------------------- /org-print/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /org-print/org-print.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.36.1. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: org-print 8 | version: 0.0.1 9 | description: Org-mode parser and data drier 10 | author: John Wiegley 11 | maintainer: johnw@newartisans.com 12 | license: BSD3 13 | license-file: LICENSE 14 | build-type: Simple 15 | 16 | library 17 | exposed-modules: 18 | Org.Print 19 | other-modules: 20 | Paths_org_print 21 | hs-source-dirs: 22 | src 23 | ghc-options: -Wall -Wno-missing-home-modules -fprof-auto 24 | build-depends: 25 | base >=4.5 26 | , mtl 27 | , org-types 28 | , regex-tdfa 29 | , time 30 | default-language: Haskell2010 31 | -------------------------------------------------------------------------------- /org-print/package.yaml: -------------------------------------------------------------------------------- 1 | name: org-print 2 | version: 0.0.1 3 | license: BSD3 4 | author: John Wiegley 5 | maintainer: johnw@newartisans.com 6 | description: Org-mode parser and data drier 7 | 8 | ghc-options: 9 | - -Wall 10 | - -Wno-missing-home-modules 11 | - -fprof-auto 12 | 13 | dependencies: 14 | - base >= 4.5 15 | - mtl 16 | - regex-tdfa 17 | - time 18 | 19 | library: 20 | source-dirs: src 21 | exposed-modules: 22 | - Org.Print 23 | dependencies: 24 | - org-types 25 | -------------------------------------------------------------------------------- /org-print/src/Org/Print.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImportQualifiedPost #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE RankNTypes #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | {-# LANGUAGE ScopedTypeVariables #-} 7 | 8 | module Org.Print 9 | ( showOrgFile, 10 | showTime, 11 | showBlock, 12 | showEntry, 13 | summarizeEntry, 14 | ) 15 | where 16 | 17 | import Control.Applicative (asum) 18 | import Control.Monad.Reader 19 | import Data.Functor.Identity (Identity (..)) 20 | import Data.Maybe (isNothing, maybeToList) 21 | import Data.Time 22 | import Org.Types 23 | import Text.Regex.TDFA 24 | import Text.Regex.TDFA.String () 25 | 26 | concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b] 27 | concatMapM f = fmap concat . mapM f 28 | 29 | showStamp :: Stamp -> String 30 | showStamp (ClosedStamp _ tm) = "CLOSED: " <> showTime tm 31 | showStamp (ScheduledStamp _ tm) = "SCHEDULED: " <> showTime tm 32 | showStamp (DeadlineStamp _ tm) = "DEADLINE: " <> showTime tm 33 | showStamp x = error $ "showStamp not support for " ++ show x 34 | 35 | showTime :: Time -> String 36 | showTime = showTime' False 37 | 38 | showTime' :: Bool -> Time -> String 39 | showTime' splitTime tm = 40 | concat $ 41 | showTimeSingle' splitTime tm 42 | : case _timeDayEnd tm of 43 | Just end 44 | | splitTime || end /= _timeDay tm -> 45 | [ "--", 46 | showTimeSingle 47 | tm 48 | { _timeDay = end, 49 | _timeDayEnd = Nothing, 50 | _timeStart = _timeEnd tm, 51 | _timeEnd = Nothing 52 | } 53 | ] 54 | _ -> [] 55 | 56 | showTimeSingle :: Time -> String 57 | showTimeSingle = showTimeSingle' False 58 | 59 | showTimeSingle' :: Bool -> Time -> String 60 | showTimeSingle' splitTime Time {..} = 61 | concat $ 62 | [ beg, 63 | formatTime 64 | defaultTimeLocale 65 | "%Y-%m-%d %a" 66 | (ModifiedJulianDay _timeDay) 67 | ] 68 | ++ case _timeStart of 69 | Nothing -> [] 70 | Just start -> 71 | [ formatTime 72 | defaultTimeLocale 73 | " %H:%M" 74 | ( UTCTime 75 | (ModifiedJulianDay _timeDay) 76 | (secondsToDiffTime (start * 60)) 77 | ) 78 | ] 79 | ++ case _timeEnd of 80 | Just finish 81 | | not splitTime 82 | && ( isNothing _timeDayEnd 83 | || _timeDayEnd == Just _timeDay 84 | ) -> 85 | [ formatTime 86 | defaultTimeLocale 87 | "-%H:%M" 88 | ( UTCTime 89 | (ModifiedJulianDay _timeDay) 90 | (secondsToDiffTime (finish * 60)) 91 | ) 92 | ] 93 | _ -> [] 94 | ++ case _timeSuffix of 95 | Nothing -> [] 96 | Just TimeSuffix {..} -> 97 | [ " ", 98 | case _suffixKind of 99 | TimeRepeat -> "+" 100 | TimeDottedRepeat -> ".+" 101 | TimeWithin -> "-", 102 | show _suffixNum, 103 | case _suffixSpan of 104 | DaySpan -> "d" 105 | WeekSpan -> "w" 106 | MonthSpan -> "m" 107 | ] 108 | ++ case _suffixLargerSpan of 109 | Nothing -> [] 110 | Just (num, s) -> 111 | [ "/" <> show num, 112 | case s of 113 | DaySpan -> "d" 114 | WeekSpan -> "w" 115 | MonthSpan -> "m" 116 | ] 117 | ++ [ end 118 | ] 119 | where 120 | (beg, end) = case _timeKind of 121 | ActiveTime -> ("<", ">") 122 | InactiveTime -> ("[", "]") 123 | 124 | showDuration :: Duration -> String 125 | showDuration Duration {..} = 126 | pad ' ' (show _hours) <> ":" <> pad '0' (show _mins) 127 | where 128 | pad c [x] = [c, x] 129 | pad _ xs = xs 130 | 131 | showLogEntry :: LogEntry -> Reader Config [String] 132 | showLogEntry (LogClosing _ tm text) = 133 | ( ( "- CLOSING NOTE" 134 | <> showTime tm 135 | <> if null text then "" else " \\\\" 136 | ) 137 | : 138 | ) 139 | <$> maybe (pure []) (showBody " ") text 140 | showLogEntry (LogState _ fr t tm text) = 141 | ( concat 142 | ( ["- State "] 143 | ++ [padded 13 ("\"" <> showKeyword fr <> "\"")] 144 | ++ [ padded 18 ("from \"" <> showKeyword k <> "\"") 145 | | k <- maybeToList t 146 | ] 147 | ++ [ showTime tm, 148 | if null text then "" else " \\\\" 149 | ] 150 | ) 151 | : 152 | ) 153 | <$> maybe (pure []) (showBody " ") text 154 | where 155 | padded n s = s <> replicate (n - length s) ' ' 156 | showLogEntry (LogNote _ tm text) = 157 | ( ( "- Note taken on " 158 | <> showTime tm 159 | <> if null text then "" else " \\\\" 160 | ) 161 | : 162 | ) 163 | <$> maybe (pure []) (showBody " ") text 164 | showLogEntry (LogRescheduled _ tm1 tm2 text) = 165 | ( ( "- Rescheduled from \"" 166 | <> showTime tm1 167 | <> "\" on " 168 | <> showTime tm2 169 | <> if null text then "" else " \\\\" 170 | ) 171 | : 172 | ) 173 | <$> maybe (pure []) (showBody " ") text 174 | showLogEntry (LogNotScheduled _ tm1 tm2 text) = 175 | ( ( "- Not scheduled, was \"" 176 | <> showTime tm1 177 | <> "\" on " 178 | <> showTime tm2 179 | <> if null text then "" else " \\\\" 180 | ) 181 | : 182 | ) 183 | <$> maybe (pure []) (showBody " ") text 184 | showLogEntry (LogDeadline _ tm1 tm2 text) = 185 | ( ( "- New deadline from \"" 186 | <> showTime tm1 187 | <> "\" on " 188 | <> showTime tm2 189 | <> if null text then "" else " \\\\" 190 | ) 191 | : 192 | ) 193 | <$> maybe (pure []) (showBody " ") text 194 | showLogEntry (LogNoDeadline _ tm1 tm2 text) = 195 | ( ( "- Removed deadline, was \"" 196 | <> showTime tm1 197 | <> "\" on " 198 | <> showTime tm2 199 | <> if null text then "" else " \\\\" 200 | ) 201 | : 202 | ) 203 | <$> maybe (pure []) (showBody " ") text 204 | showLogEntry (LogRefiling _ tm text) = 205 | ( ( "- Refiled on " 206 | <> showTime tm 207 | <> if null text then "" else " \\\\" 208 | ) 209 | : 210 | ) 211 | <$> maybe (pure []) (showBody " ") text 212 | showLogEntry (LogClock _ tm Nothing) = 213 | pure ["CLOCK: " <> showTimeSingle tm] 214 | showLogEntry (LogClock _ tm (Just dur)) = 215 | pure ["CLOCK: " <> showTime' True tm <> " => " <> showDuration dur] 216 | showLogEntry (LogBook _ tms) = do 217 | entries <- concatMapM showLogEntry tms 218 | pure $ ":LOGBOOK:" : entries ++ [":END:"] 219 | 220 | showKeyword :: Keyword -> String 221 | showKeyword (OpenKeyword _ n) = n 222 | showKeyword (ClosedKeyword _ n) = n 223 | 224 | showEntry :: Entry -> Reader Config [String] 225 | showEntry Entry {..} = do 226 | props <- properties 227 | logEnts <- logEntries 228 | entry <- entryLines 229 | items <- concatMapM showEntry _entryItems 230 | tagsCol <- asks _tagsColumn 231 | pure $ 232 | [title tagsCol] 233 | ++ timestamps 234 | ++ props 235 | ++ logEnts 236 | ++ activeStamp 237 | ++ entry 238 | ++ items 239 | where 240 | title tagsCol 241 | | null suffix = prefix 242 | | otherwise = prefix <> spacer <> suffix 243 | where 244 | count x = length . filter (x ==) 245 | 246 | prefixLength = 247 | -(count '=' prefix) 248 | + case prefix =~ ("\\[\\[[^]]+\\]\\[" :: String) of 249 | AllTextSubmatches ([link] :: [String]) -> 250 | length prefix - length link - 2 251 | _ -> length prefix 252 | 253 | spacer 254 | | width < 2 = " " 255 | | otherwise = replicate (fromIntegral width) ' ' 256 | where 257 | width = 258 | tagsCol 259 | - fromIntegral prefixLength 260 | - fromIntegral (length suffix) 261 | prefix = 262 | concat $ 263 | [replicate (fromIntegral _entryDepth) '*'] 264 | ++ [" "] 265 | ++ [showKeyword kw <> " " | kw <- maybeToList _entryKeyword] 266 | ++ ["[#" <> prio <> "] " | prio <- maybeToList _entryPriority] 267 | ++ [ "(" <> c <> ") " 268 | | c <- maybeToList _entryContext 269 | ] 270 | ++ [ c <> ": " 271 | | c <- maybeToList _entryVerb 272 | ] 273 | ++ [_entryTitle] 274 | ++ [ " {" <> c <> "}" 275 | | c <- maybeToList _entryLocator 276 | ] 277 | suffix 278 | | not (null _entryTags) = 279 | concat $ 280 | ":" 281 | : [ case tag of 282 | PlainTag t -> t <> ":" 283 | | tag <- _entryTags 284 | ] 285 | | otherwise = "" 286 | timestamps 287 | | null leadingStamps = [] 288 | | otherwise = [unwords (map showStamp leadingStamps)] 289 | where 290 | leadingStamps = filter isLeadingStamp _entryStamps 291 | properties 292 | | null _entryProperties = pure [] 293 | | otherwise = showProperties _entryProperties 294 | logEntries = concatMapM showLogEntry _entryLogEntries 295 | activeStamp = case asum 296 | ( map 297 | ( \case 298 | ActiveStamp _ t -> Just t 299 | _ -> Nothing 300 | ) 301 | _entryStamps 302 | ) of 303 | Nothing -> [] 304 | Just stamp -> [showTime stamp] 305 | entryLines = showBody "" _entryBody 306 | 307 | showBody :: String -> Body -> Reader Config [String] 308 | showBody leader (Body b) = concatMapM (showBlock leader) b 309 | 310 | prefixLeader :: String -> String -> String 311 | prefixLeader _ "" = "" 312 | prefixLeader leader str = leader <> str 313 | 314 | showBlock :: String -> Block -> Reader Config [String] 315 | showBlock _ (Whitespace _ txt) = pure [txt] 316 | showBlock leader (Paragraph _ xs) = pure $ map (prefixLeader leader) xs 317 | showBlock leader (Drawer _ _ xs) = pure $ map (prefixLeader leader) xs 318 | showBlock _ (InlineTask _ e) = do 319 | entry <- showEntry e 320 | pure $ entry ++ ["*************** END"] 321 | 322 | bodyLength :: Body -> Reader Config Int 323 | bodyLength body = do 324 | txt <- showBody "" body 325 | pure $ sum $ Prelude.map (fromIntegral . length) txt 326 | 327 | showOrgFile :: Config -> OrgFile -> [String] 328 | showOrgFile cfg OrgFile {..} = 329 | flip runReader cfg $ 330 | (++) 331 | <$> showHeader _orgFileHeader 332 | <*> concatMapM showEntry _orgFileEntries 333 | 334 | showHeader :: Header -> Reader Config [String] 335 | showHeader Header {..} = do 336 | propDrawer <- propertiesDrawer 337 | fileProps <- fileProperties 338 | preamb <- preamble 339 | pure $ propDrawer ++ fileProps ++ preamb 340 | where 341 | propertiesDrawer 342 | | null _headerPropertiesDrawer = pure [] 343 | | otherwise = showProperties _headerPropertiesDrawer 344 | fileProperties 345 | | null _headerFileProperties = pure [] 346 | | otherwise = pure $ showFileProperties _headerFileProperties 347 | preamble = showBody "" _headerPreamble 348 | 349 | showProperties :: [Property] -> Reader Config [String] 350 | showProperties ps = ReaderT $ \cfg -> 351 | Identity $ 352 | [":PROPERTIES:"] 353 | ++ map (propLine (_propertyColumn cfg)) ps 354 | ++ [":END:"] 355 | where 356 | propLine propCol Property {..} 357 | | null suffix = prefix 358 | | otherwise = prefix <> spacer <> suffix 359 | where 360 | spacer 361 | | width < 1 = " " 362 | | otherwise = replicate (fromIntegral width) ' ' 363 | where 364 | width = propCol - fromIntegral (length prefix) 365 | prefix = ":" <> _name <> ":" 366 | suffix = _value 367 | 368 | showFileProperties :: [Property] -> [String] 369 | showFileProperties ps = 370 | [ "#+" <> _name <> ": " <> _value 371 | | Property {..} <- ps 372 | ] 373 | 374 | summarizeEntry :: Config -> Entry -> [String] 375 | summarizeEntry cfg Entry {..} = 376 | [replicate (fromIntegral _entryDepth) '*' <> " " <> _entryTitle] 377 | ++ runReader 378 | ( do 379 | bodyLen <- bodyLength _entryBody 380 | showProperties 381 | ( _entryProperties 382 | ++ [Property _entryLoc False "FILE" (_file _entryLoc)] 383 | ++ [Property _entryLoc False "OFFSET" (show (_pos _entryLoc))] 384 | ++ [ Property _entryLoc False "KEYWORD" (show x) 385 | | x <- maybeToList _entryKeyword 386 | ] 387 | ++ [ Property _entryLoc False "PRIORITY" x 388 | | x <- maybeToList _entryPriority 389 | ] 390 | ++ [ Property _entryLoc False "CONTEXT" x 391 | | x <- maybeToList _entryContext 392 | ] 393 | ++ [ Property _entryLoc False "VERB" x 394 | | x <- maybeToList _entryVerb 395 | ] 396 | ++ [ Property _entryLoc False "LOCATOR" x 397 | | x <- maybeToList _entryLocator 398 | ] 399 | ++ [ Property 400 | _entryLoc 401 | False 402 | "LOG_ENTRIES" 403 | (show (length _entryLogEntries)) 404 | | not (null _entryLogEntries) 405 | ] 406 | ++ [ Property 407 | _entryLoc 408 | False 409 | "BODY_LEN" 410 | (show bodyLen) 411 | | not (emptyBody _entryBody) 412 | ] 413 | ++ case _entryTags of 414 | [] -> [] 415 | _ -> 416 | [ Property 417 | _entryLoc 418 | False 419 | "TAGS" 420 | ( concat $ 421 | ":" 422 | : [ case tag of 423 | PlainTag t -> t <> ":" 424 | | tag <- _entryTags 425 | ] 426 | ) 427 | ] 428 | ++ map 429 | ( \case 430 | ClosedStamp _ tm -> 431 | Property _entryLoc False "CLOSED" (showTime tm) 432 | ScheduledStamp _ tm -> 433 | Property _entryLoc False "SCHEDULED" (showTime tm) 434 | DeadlineStamp _ tm -> 435 | Property _entryLoc False "DEADLINE" (showTime tm) 436 | ActiveStamp _ tm -> 437 | Property _entryLoc False "ACTIVE" (showTime tm) 438 | ) 439 | _entryStamps 440 | ) 441 | ) 442 | cfg {_propertyColumn = 0} 443 | ++ concatMap (summarizeEntry cfg) _entryItems 444 | -------------------------------------------------------------------------------- /org-site/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1994-2016, John Wiegley All rights reserved. 2 | 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this 7 | list of conditions and the following disclaimer. 8 | 9 | 2. Redistributions in binary form must reproduce the above copyright notice, 10 | this list of conditions and the following disclaimer in the documentation 11 | and/or other materials provided with the distribution. 12 | 13 | 3. Neither the name of the copyright holder nor the names of its contributors 14 | may be used to endorse or promote products derived from this software without 15 | specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 18 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 23 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 24 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 25 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 26 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | -------------------------------------------------------------------------------- /org-site/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /org-site/cabal.project: -------------------------------------------------------------------------------- 1 | packages: ./*.cabal 2 | 3 | source-repository-package 4 | type: git 5 | location: https://github.com/jwiegley/hakyll.git 6 | tag: 1784bb74b0bfcaa0899c522f34f2063b92728bd8 7 | --sha256: sha256-hNr59HQ5hwKctVTfBfgZZMPXJTohsFgAmLKjxuiHqHs= 8 | -------------------------------------------------------------------------------- /org-site/org-site.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.37.0. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: org-site 8 | version: 1.0.0 9 | synopsis: A Hakyll site builder 10 | description: A Hakyll site builder 11 | category: System 12 | author: John Wiegley 13 | maintainer: johnw@newartisans.com 14 | license: BSD3 15 | license-file: LICENSE 16 | build-type: Simple 17 | 18 | library 19 | exposed-modules: 20 | Org.Site 21 | other-modules: 22 | Paths_org_site 23 | hs-source-dirs: 24 | src 25 | ghc-options: -Wall -Wno-missing-home-modules -fprof-auto 26 | build-depends: 27 | aeson 28 | , base >=4.12 29 | , containers 30 | , directory >=1.2.7.0 31 | , filepath >=1.3 32 | , hakyll >=4.16.6.0 33 | , hakyll-images 34 | , org-types 35 | , pandoc >=2.11 && <2.20 || >=3.0 && <3.7 36 | , pandoc-types >=1.22 && <1.24 37 | , process 38 | , regex-posix 39 | , split 40 | , syb 41 | , text 42 | , time 43 | , yaml 44 | default-language: Haskell2010 45 | -------------------------------------------------------------------------------- /org-site/package.yaml: -------------------------------------------------------------------------------- 1 | name: org-site 2 | version: 1.0.0 3 | synopsis: A Hakyll site builder 4 | author: John Wiegley 5 | maintainer: johnw@newartisans.com 6 | category: System 7 | license: BSD3 8 | 9 | ghc-options: 10 | - -Wall 11 | - -Wno-missing-home-modules 12 | - -fprof-auto 13 | 14 | description: 15 | A Hakyll site builder 16 | 17 | dependencies: 18 | - base >= 4.12 19 | - aeson 20 | - containers 21 | - directory >= 1.2.7.0 22 | - filepath >= 1.3 23 | - hakyll >= 4.16.6.0 24 | - hakyll-images 25 | - pandoc >= 2.11 && < 2.20 || >= 3.0 && < 3.7 26 | - pandoc-types >= 1.22 && < 1.24 27 | - process 28 | - regex-posix 29 | - split 30 | - syb 31 | - text 32 | - time 33 | - yaml 34 | 35 | library: 36 | source-dirs: src 37 | exposed-modules: 38 | - Org.Site 39 | dependencies: 40 | - org-types 41 | -------------------------------------------------------------------------------- /org-site/src/Org/Site.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE PatternGuards #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | {-# LANGUAGE TupleSections #-} 7 | {-# LANGUAGE ViewPatterns #-} 8 | {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} 9 | {-# OPTIONS_GHC -fno-warn-orphans #-} 10 | 11 | {-# HLINT ignore "Use lambda-case" #-} 12 | 13 | module Org.Site where 14 | 15 | import Control.Applicative 16 | import Control.Arrow ((***)) 17 | import Control.Monad hiding (forM_) 18 | import Data.Aeson (FromJSON (..), Value (Object), (.:)) 19 | import qualified Data.Aeson.Key as AT 20 | import qualified Data.Aeson.KeyMap as AT 21 | import Data.Aeson.Types (typeMismatch) 22 | import qualified Data.Aeson.Types as AT 23 | import Data.Char (toLower) 24 | import Data.Foldable hiding (elem) 25 | import Data.Functor 26 | import Data.Generics (everywhereM, mkM) 27 | import Data.List hiding (all, any, concatMap) 28 | import Data.List.Split hiding (oneOf) 29 | import qualified Data.Map.Strict as M 30 | import Data.Maybe 31 | import Data.Monoid 32 | import qualified Data.Text as T 33 | import qualified Data.Text.IO as TIO 34 | import Data.Time 35 | import Data.Time.Format.ISO8601 36 | import Data.Yaml (decodeFileEither) 37 | import Hakyll 38 | import Hakyll.Images (loadImage, resizeImageCompiler) 39 | import System.Directory 40 | import System.FilePath 41 | import System.IO.Unsafe (unsafePerformIO) 42 | import System.Process (readProcess) 43 | import qualified Text.Pandoc as P 44 | import Text.Regex.Posix hiding (empty, match) 45 | import Prelude hiding (all, any, concatMap) 46 | 47 | siteRules :: UTCTime -> SiteConfiguration -> Rules () 48 | siteRules now site@SiteConfiguration {..} = do 49 | match "templates/*" $ 50 | compile templateCompiler 51 | 52 | match 53 | ( "files/**" 54 | .||. "favicon.ico" 55 | ) 56 | $ do 57 | route idRoute 58 | compile copyFileCompiler 59 | 60 | match "images/**" $ do 61 | route idRoute 62 | compile $ 63 | loadImage 64 | >>= resizeImageCompiler 1024 768 65 | 66 | match ("css/*.css" .||. "js/*.js") $ do 67 | route idRoute 68 | compile yuiCompressor 69 | 70 | tags <- 71 | buildTagsWith 72 | (getTagsByField "tags") 73 | "posts/**.org" 74 | (fromCapture "tags/*/index.html") 75 | 76 | posts <- getMatchesToPublishBefore now "posts/*.org" 77 | match (fromList posts) $ do 78 | route $ metadataRoute (constRoute . getRouteFromMeta) 79 | compile $ 80 | postPandocCompiler posts 81 | >>= saveSnapshot "teaser" 82 | >>= "templates/post.html" 83 | $$= postCtxWithTags tags 84 | >>= saveSnapshot "content" 85 | >>= loadForSite 86 | 87 | match ("posts/**.jpg" .||. "posts/**.png") $ do 88 | -- For images, remove the "posts/" prefix 89 | route $ 90 | customRoute 91 | ( joinPath 92 | . drop 1 93 | . splitDirectories 94 | . toFilePath 95 | ) 96 | compile $ 97 | loadImage 98 | >>= resizeImageCompiler 1024 768 99 | 100 | tagsRules tags $ \tag pat -> do 101 | route idRoute 102 | compile $ do 103 | ps <- recentFirst =<< loadAll pat 104 | makeItem "" 105 | >>= "templates/archives.html" 106 | $$= ( constField "title" ("Posts tagged \"" ++ tag ++ "\"") 107 | <> listField "posts" (postCtxWithTags tags) (return ps) 108 | <> listField 109 | "tags" 110 | postCtx 111 | ( return $ 112 | map 113 | (\x -> Item (fromFilePath (fst x)) (fst x)) 114 | (tagsMap tags) 115 | ) 116 | <> defaultContext 117 | ) 118 | >>= loadForSite 119 | 120 | paginate posts 6 10 $ \idx maxIndex itemsForPage -> 121 | create 122 | [ fromFilePath $ 123 | if idx == 1 124 | then "index.html" 125 | else "page/" ++ show idx ++ "/index.html" 126 | ] 127 | $ do 128 | route idRoute 129 | compile $ 130 | makeItem "" 131 | >>= "templates/list.html" 132 | $$= ( listField 133 | "posts" 134 | (field "teaser" teaserBody <> postCtxWithTags tags) 135 | ( forM itemsForPage $ \ident -> 136 | loadSnapshot ident "teaser" 137 | >>= wordpressifyUrls 138 | >>= relativizeUrls 139 | ) 140 | <> ( if idx == 1 141 | then constField "isFirst" "true" 142 | else mempty 143 | ) 144 | <> ( if idx == 2 145 | then constField "isSecond" "true" 146 | else mempty 147 | ) 148 | <> ( if idx == maxIndex 149 | then constField "isLast" "true" 150 | else mempty 151 | ) 152 | <> constField "nextIndex" (show (succ idx)) 153 | <> constField "prevIndex" (show (pred idx)) 154 | <> defaultContext 155 | ) 156 | >>= loadForSite 157 | 158 | create ["archives/index.html"] $ do 159 | route idRoute 160 | compile $ 161 | makeItem "" 162 | >>= "templates/archives.html" 163 | $$= ( listField 164 | "posts" 165 | (postCtxWithTags tags) 166 | ( forM posts $ \post -> 167 | loadSnapshot post "teaser" 168 | >>= wordpressifyUrls 169 | >>= relativizeUrls 170 | ) 171 | <> listField 172 | "tags" 173 | postCtx 174 | ( return $ 175 | map (\x -> Item (fromFilePath (fst x)) (fst x)) $ 176 | tagsMap tags 177 | ) 178 | <> defaultContext 179 | ) 180 | >>= loadForSite 181 | 182 | pages <- getMatches "pages/*.org" 183 | match (fromList pages) $ do 184 | route $ metadataRoute (constRoute . getRouteFromMeta) 185 | compile $ 186 | postPandocCompiler pages 187 | >>= "templates/page.html" $$= defaultContext 188 | >>= loadForSite 189 | >>= wordpressifyUrls 190 | >>= relativizeUrls 191 | 192 | create ["atom.xml"] $ do 193 | route idRoute 194 | compile $ 195 | renderAtom 196 | (feedConfigurationFromSite site) 197 | ( postCtxWithTags tags 198 | <> feedContext siteRoot 199 | ) 200 | . take 10 201 | =<< recentFirst 202 | =<< traverse (`loadSnapshot` "content") posts 203 | 204 | create ["rss.xml"] $ do 205 | route idRoute 206 | compile 207 | ( renderRss 208 | (feedConfigurationFromSite site) 209 | ( postCtxWithTags tags 210 | <> feedContext siteRoot 211 | ) 212 | . take 10 213 | =<< recentFirst 214 | =<< traverse (`loadSnapshot` "content") posts 215 | ) 216 | 217 | create ["robots.txt"] $ do 218 | route idRoute 219 | compile $ do 220 | makeItem ("" :: String) 221 | >>= "templates/robots.txt" $$= (siteCtx site <> defaultContext) 222 | 223 | create ["sitemap.xml"] $ do 224 | route idRoute 225 | compile $ do 226 | pos <- recentFirst =<< traverse load posts 227 | pas <- loadAll "pages/*.org" 228 | makeItem ("" :: String) 229 | >>= "templates/sitemap.xml" 230 | $$= ( listField 231 | "entries" 232 | postCtx 233 | (return $ pos ++ pas) 234 | <> siteCtx site 235 | <> defaultContext 236 | ) 237 | where 238 | loadForSite = 239 | "templates/meta.html" 240 | $$= (siteCtx site <> defaultContext) 241 | >=> wordpressifyUrls 242 | >=> relativizeUrls 243 | 244 | postCtx :: Context String 245 | postCtx = 246 | mconcat 247 | [ dateField "date" "%B %e, %Y", 248 | dateField "year" "%Y", 249 | dateField "mon" "%m", 250 | dateField "month" "%B", 251 | dateField "day_" "%d", 252 | dateField "day" "%e", 253 | wpIdentField "ident", 254 | wpUrlField "url", 255 | metadataField, 256 | siteCtx site, 257 | defaultContext 258 | ] 259 | 260 | postCtxWithTags :: Tags -> Context String 261 | postCtxWithTags tags = tagsField "tags" tags <> postCtx 262 | 263 | postPandocCompiler :: [Identifier] -> Compiler (Item String) 264 | postPandocCompiler entries = do 265 | ident <- getUnderlying 266 | pandocCompilerWithTransformM 267 | defaultHakyllReaderOptions 268 | ( defaultHakyllWriterOptions 269 | { P.writerTableOfContents = True, 270 | P.writerListings = True, 271 | P.writerTOCDepth = 2 272 | } 273 | ) 274 | (unsafeCompiler . fixPostLinks ident) 275 | where 276 | fixPostLinks :: Identifier -> P.Pandoc -> IO P.Pandoc 277 | fixPostLinks ident = everywhereM (mkM (fixPostLink ident)) 278 | 279 | fixPostLink :: Identifier -> P.Inline -> IO P.Inline 280 | -- Fixup Org-roam links that refer the document by its id. These must 281 | -- be resolved to the destination path. 282 | fixPostLink _ident l@(P.Link as title (T.unpack -> url, title')) 283 | | AllTextSubmatches [_, uuid] <- url =~ ("^id:(.+)$" :: String) = do 284 | -- Within the [Identifier] gives by entries, find one whose 285 | -- metadata id == uuid. 286 | findEntryByUuid entries uuid <&> \case 287 | Nothing -> l 288 | Just path -> 289 | P.Link 290 | as 291 | title 292 | (T.pack ("/" ++ path), title') 293 | -- Fixup image links. 294 | fixPostLink ident (P.Image as title (T.unpack -> url, title')) 295 | | AllTextSubmatches [_, target] <- 296 | url 297 | =~ ( "^\\./(" 298 | ++ dropExtension (takeBaseName (toFilePath ident)) 299 | ++ "/.*)$" :: 300 | String 301 | ) = 302 | pure $ 303 | P.Image 304 | as 305 | title 306 | (T.pack ("/" ++ target), title') 307 | fixPostLink _ x = return x 308 | 309 | {------------------------------------------------------------------------} 310 | -- Main code 311 | 312 | mapMaybeM :: (Applicative m) => (a -> m (Maybe b)) -> [a] -> m [b] 313 | mapMaybeM f = foldr g (pure []) 314 | where 315 | g = liftA2 (maybe id (:)) . f 316 | 317 | ($$=) :: Identifier -> Context a -> Item a -> Compiler (Item String) 318 | ($$=) = loadAndApplyTemplate 319 | 320 | yuiCompressor :: Compiler (Item String) 321 | yuiCompressor = do 322 | path <- getResourceFilePath 323 | makeItem $ unsafePerformIO $ readProcess "yuicompressor" [path] "" 324 | 325 | {------------------------------------------------------------------------} 326 | -- Site configuration 327 | 328 | data SiteConfiguration = SiteConfiguration 329 | { siteTitle :: String, -- Title of the site 330 | siteDescription :: String, -- Description of the site 331 | siteAuthorName :: String, -- Name of the site author 332 | siteAuthorEmail :: String, -- Email of the site author 333 | siteRoot :: String, -- Root URI of the site 334 | siteName :: String, -- If the site at foo.com, then foo 335 | siteDeploy :: String, -- Deploy command, replace %s with name 336 | siteKeywords :: String, -- Site keywords 337 | siteCopyright :: String, -- Site copyright 338 | siteAnalytics :: String, -- Google Analytics Id 339 | siteDisqus :: String -- Disqus domainname 340 | } 341 | 342 | instance FromJSON SiteConfiguration where 343 | parseJSON (Object v) = 344 | SiteConfiguration 345 | <$> v .: "title" 346 | <*> v .: "description" 347 | <*> v .: "authorName" 348 | <*> v .: "authorEmail" 349 | <*> v .: "root" 350 | <*> v .: "name" 351 | <*> v .: "deploy" 352 | <*> v .: "keywords" 353 | <*> v .: "copyright" 354 | <*> v .: "analytics" 355 | <*> v .: "disqus" 356 | parseJSON invalid = typeMismatch "SiteConfiguration" invalid 357 | 358 | readSiteConfiguration :: FilePath -> IO SiteConfiguration 359 | readSiteConfiguration file = do 360 | eres <- decodeFileEither file 361 | case eres of 362 | Left err -> 363 | error $ 364 | "Could not open or parse " 365 | ++ file 366 | ++ " file: " 367 | ++ show err 368 | Right conf -> pure conf 369 | 370 | feedConfigurationFromSite :: SiteConfiguration -> FeedConfiguration 371 | feedConfigurationFromSite SiteConfiguration {..} = 372 | FeedConfiguration 373 | { feedTitle = siteTitle, 374 | feedDescription = siteDescription, 375 | feedAuthorName = siteAuthorName, 376 | feedAuthorEmail = siteAuthorEmail, 377 | feedRoot = siteRoot 378 | } 379 | 380 | siteCtx :: SiteConfiguration -> Context String 381 | siteCtx SiteConfiguration {..} = 382 | mconcat 383 | [ constField "title" siteTitle, 384 | constField "description" siteDescription, 385 | constField "authorName" siteAuthorName, 386 | constField "authorEmail" siteAuthorEmail, 387 | constField "root" siteRoot, 388 | constField "name" siteName, 389 | constField "deploy" siteDeploy, 390 | constField "keywords" siteKeywords, 391 | constField "copyright" siteCopyright, 392 | constField "analytics" siteAnalytics, 393 | constField "disqus" siteDisqus 394 | ] 395 | 396 | {------------------------------------------------------------------------} 397 | -- Content normalization 398 | 399 | teaserBody :: Item String -> Compiler String 400 | teaserBody = 401 | return . extractTeaser . maxLengthTeaser . compactTeaser . itemBody 402 | where 403 | extractTeaser [] = [] 404 | extractTeaser xs@(x : xr) 405 | | "" `isPrefixOf` xs = [] 406 | | otherwise = x : extractTeaser xr 407 | 408 | maxLengthTeaser s 409 | | isNothing (findIndex (isPrefixOf "") (tails s)) = 410 | unwords (take 60 (words s)) 411 | | otherwise = s 412 | 413 | compactTeaser = 414 | replaceAll "