{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Neuron.Zettelkasten.Meta
  ( Meta (..),
    getMeta,
  )
where

import Data.Aeson
import Relude
import Text.MMark (MMark, projectYaml)

-- | YAML metadata in a zettel markdown file
data Meta
  = Meta
      { Meta -> Text
title :: Text,
        Meta -> Maybe [Text]
tags :: Maybe [Text]
      }
  deriving (Meta -> Meta -> Bool
(Meta -> Meta -> Bool) -> (Meta -> Meta -> Bool) -> Eq Meta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Meta -> Meta -> Bool
$c/= :: Meta -> Meta -> Bool
== :: Meta -> Meta -> Bool
$c== :: Meta -> Meta -> Bool
Eq, Int -> Meta -> ShowS
[Meta] -> ShowS
Meta -> String
(Int -> Meta -> ShowS)
-> (Meta -> String) -> ([Meta] -> ShowS) -> Show Meta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Meta] -> ShowS
$cshowList :: [Meta] -> ShowS
show :: Meta -> String
$cshow :: Meta -> String
showsPrec :: Int -> Meta -> ShowS
$cshowsPrec :: Int -> Meta -> ShowS
Show, (forall x. Meta -> Rep Meta x)
-> (forall x. Rep Meta x -> Meta) -> Generic Meta
forall x. Rep Meta x -> Meta
forall x. Meta -> Rep Meta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Meta x -> Meta
$cfrom :: forall x. Meta -> Rep Meta x
Generic, Value -> Parser [Meta]
Value -> Parser Meta
(Value -> Parser Meta) -> (Value -> Parser [Meta]) -> FromJSON Meta
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Meta]
$cparseJSONList :: Value -> Parser [Meta]
parseJSON :: Value -> Parser Meta
$cparseJSON :: Value -> Parser Meta
FromJSON)

getMeta :: MMark -> Maybe Meta
getMeta :: MMark -> Maybe Meta
getMeta src :: MMark
src = do
  Value
val <- MMark -> Maybe Value
projectYaml MMark
src
  case Value -> Result Meta
forall a. FromJSON a => Value -> Result a
fromJSON Value
val of
    Error e :: String
e -> Text -> Maybe Meta
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> Maybe Meta) -> Text -> Maybe Meta
forall a b. (a -> b) -> a -> b
$ "JSON error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
e
    Success v :: Meta
v -> Meta -> Maybe Meta
forall (f :: * -> *) a. Applicative f => a -> f a
pure Meta
v