{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | Zettel store datastructure
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

-- | Load all zettel files
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
    -- Extensions are computed and applied during rendering, not here.
    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