packages feed

neuron-0.2.0.0: src/Neuron/Zettelkasten/Query.hs

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

-- | Queries to the Zettel store
module Neuron.Zettelkasten.Query where

import Data.Aeson
import qualified Data.Map.Strict as Map
import Neuron.Zettelkasten.ID
import qualified Neuron.Zettelkasten.Meta as Meta
import Neuron.Zettelkasten.Store
import Neuron.Zettelkasten.Type
import Relude

-- TODO: Support querying connections, a la:
--   LinksTo ZettelID
--   LinksFrom ZettelID
data Query
  = ByTag Text
  deriving (Eq, Show)

data Match
  = Match
      { matchID :: ZettelID,
        matchTitle :: Text,
        matchTags :: [Text]
      }

-- TODO: Use generic deriving use field label modifier.
instance ToJSON Match where
  toJSON Match {..} =
    object
      [ "id" .= toJSON matchID,
        "title" .= matchTitle,
        "tags" .= matchTags
      ]

matchQuery :: Match -> Query -> Bool
matchQuery Match {..} = \case
  ByTag tag -> tag `elem` matchTags

extractMatch :: Zettel -> Maybe Match
extractMatch Zettel {..} = do
  Meta.Meta {..} <- Meta.getMeta zettelContent
  pure
    Match
      { matchID = zettelID,
        matchTitle = zettelTitle,
        matchTags = fromMaybe [] tags
      }

runQuery :: ZettelStore -> [Query] -> [Match]
runQuery store queries =
  flip filter database $ \match -> and $ matchQuery match <$> queries
  where
    database = catMaybes $ extractMatch <$> Map.elems store