{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Neuron.Zettelkasten.Store where
import qualified Data.Map.Strict as Map
import Development.Shake (Action)
import Neuron.Zettelkasten.ID
import qualified Neuron.Zettelkasten.Meta as Meta
import Neuron.Zettelkasten.Type
import Path
import Relude
import qualified Rib.Parser.MMark as RibMMark
type ZettelStore = Map ZettelID Zettel
mkZettelStore :: [Path Rel File] -> Action ZettelStore
mkZettelStore :: [Path Rel File] -> Action ZettelStore
mkZettelStore files :: [Path Rel File]
files = do
[Zettel]
zettels <- [Path Rel File]
-> (Path Rel File -> Action Zettel) -> Action [Zettel]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Path Rel File]
files ((Path Rel File -> Action Zettel) -> Action [Zettel])
-> (Path Rel File -> Action Zettel) -> Action [Zettel]
forall a b. (a -> b) -> a -> b
$ \file :: Path Rel File
file -> do
let mmarkExts :: [a]
mmarkExts = []
MMark
doc <- [Extension] -> Path Rel File -> Action MMark
RibMMark.parseWith [Extension]
forall a. [a]
mmarkExts Path Rel File
file
let zid :: ZettelID
zid = Path Rel File -> ZettelID
mkZettelID Path Rel File
file
meta :: Maybe Meta
meta = MMark -> Maybe Meta
Meta.getMeta MMark
doc
title :: Text
title = Text -> (Meta -> Text) -> Maybe Meta -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ("No title for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Path Rel File -> Text
forall b a. (Show a, IsString b) => a -> b
show Path Rel File
file) Meta -> Text
Meta.title Maybe Meta
meta
zettel :: Zettel
zettel = ZettelID -> Text -> MMark -> Zettel
Zettel ZettelID
zid Text
title MMark
doc
Zettel -> Action Zettel
forall (f :: * -> *) a. Applicative f => a -> f a
pure Zettel
zettel
ZettelStore -> Action ZettelStore
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ZettelStore -> Action ZettelStore)
-> ZettelStore -> Action ZettelStore
forall a b. (a -> b) -> a -> b
$ [(ZettelID, Zettel)] -> ZettelStore
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ZettelID, Zettel)] -> ZettelStore)
-> [(ZettelID, Zettel)] -> ZettelStore
forall a b. (a -> b) -> a -> b
$ [Zettel]
zettels [Zettel] -> (Zettel -> (ZettelID, Zettel)) -> [(ZettelID, Zettel)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Zettel -> ZettelID
zettelID (Zettel -> ZettelID)
-> (Zettel -> Zettel) -> Zettel -> (ZettelID, Zettel)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Zettel -> Zettel
forall a. a -> a
id
lookupStore :: ZettelID -> ZettelStore -> Zettel
lookupStore :: ZettelID -> ZettelStore -> Zettel
lookupStore zid :: ZettelID
zid = Zettel -> Maybe Zettel -> Zettel
forall a. a -> Maybe a -> a
fromMaybe (Text -> Zettel
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Zettel) -> Text -> Zettel
forall a b. (a -> b) -> a -> b
$ "No such zettel: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ZettelID -> Text
unZettelID ZettelID
zid) (Maybe Zettel -> Zettel)
-> (ZettelStore -> Maybe Zettel) -> ZettelStore -> Zettel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZettelID -> ZettelStore -> Maybe Zettel
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ZettelID
zid