{-# 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 (Query -> Query -> Bool
(Query -> Query -> Bool) -> (Query -> Query -> Bool) -> Eq Query
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Query -> Query -> Bool
$c/= :: Query -> Query -> Bool
== :: Query -> Query -> Bool
$c== :: Query -> Query -> Bool
Eq, Int -> Query -> ShowS
[Query] -> ShowS
Query -> String
(Int -> Query -> ShowS)
-> (Query -> String) -> ([Query] -> ShowS) -> Show Query
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Query] -> ShowS
$cshowList :: [Query] -> ShowS
show :: Query -> String
$cshow :: Query -> String
showsPrec :: Int -> Query -> ShowS
$cshowsPrec :: Int -> Query -> ShowS
Show)

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

-- TODO: Use generic deriving use field label modifier.
instance ToJSON Match where
  toJSON :: Match -> Value
toJSON Match {..} =
    [Pair] -> Value
object
      [ "id" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ZettelID -> Value
forall a. ToJSON a => a -> Value
toJSON ZettelID
matchID,
        "title" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
matchTitle,
        "tags" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
matchTags
      ]

matchQuery :: Match -> Query -> Bool
matchQuery :: Match -> Query -> Bool
matchQuery Match {..} = \case
  ByTag tag :: Text
tag -> Text
tag Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Text]
matchTags

extractMatch :: Zettel -> Maybe Match
extractMatch :: Zettel -> Maybe Match
extractMatch Zettel {..} = do
  Meta.Meta {..} <- MMark -> Maybe Meta
Meta.getMeta MMark
zettelContent
  Match -> Maybe Match
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Match :: ZettelID -> Text -> [Text] -> Match
Match
      { matchID :: ZettelID
matchID = ZettelID
zettelID,
        matchTitle :: Text
matchTitle = Text
zettelTitle,
        matchTags :: [Text]
matchTags = [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Text]
tags
      }

runQuery :: ZettelStore -> [Query] -> [Match]
runQuery :: ZettelStore -> [Query] -> [Match]
runQuery store :: ZettelStore
store queries :: [Query]
queries =
  ((Match -> Bool) -> [Match] -> [Match])
-> [Match] -> (Match -> Bool) -> [Match]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Match -> Bool) -> [Match] -> [Match]
forall a. (a -> Bool) -> [a] -> [a]
filter [Match]
database ((Match -> Bool) -> [Match]) -> (Match -> Bool) -> [Match]
forall a b. (a -> b) -> a -> b
$ \match :: Match
match -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ Match -> Query -> Bool
matchQuery Match
match (Query -> Bool) -> [Query] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Query]
queries
  where
    database :: [Match]
database = [Maybe Match] -> [Match]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Match] -> [Match]) -> [Maybe Match] -> [Match]
forall a b. (a -> b) -> a -> b
$ Zettel -> Maybe Match
extractMatch (Zettel -> Maybe Match) -> [Zettel] -> [Maybe Match]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZettelStore -> [Zettel]
forall k a. Map k a -> [a]
Map.elems ZettelStore
store