Include YAML frontmatter in the Stork index

srid · Dec 10, 2022 · 4811585 · 4811585
1 parent d2a6423
commit 4811585
Show file tree

Hide file tree

Showing 2 changed files with 35 additions and 8 deletions.
diff --git a/src/Emanote/Model/Stork.hs b/src/Emanote/Model/Stork.hs
@@ -6,7 +6,11 @@ where
 import Control.Monad.Logger (MonadLoggerIO)
 import Data.IxSet.Typed qualified as Ix
 import Emanote.Model.Note qualified as N
-import Emanote.Model.Stork.Index (File (File), Input (Input), readOrBuildStorkIndex)
+import Emanote.Model.Stork.Index
+  ( File (File),
+    Input (Input),
+    readOrBuildStorkIndex,
+  )
 import Emanote.Model.Title qualified as Tit
 import Emanote.Model.Type (Model)
 import Emanote.Model.Type qualified as M
@@ -19,7 +23,7 @@ import System.FilePath ((</>))
 
 renderStorkIndex :: (MonadIO m, MonadLoggerIO m) => Model -> m LByteString
 renderStorkIndex model = do
-  readOrBuildStorkIndex (model ^. M.modelStorkIndex) (Input $ storkFiles model)
+  readOrBuildStorkIndex (model ^. M.modelStorkIndex) (Input (storkFiles model) "Ignore")
 
 storkFiles :: Model -> [File]
 storkFiles model =

diff --git a/src/Emanote/Model/Stork/Index.hs b/src/Emanote/Model/Stork/Index.hs
@@ -13,13 +13,25 @@ where
 
 import Control.Monad.Logger (MonadLoggerIO)
 import Data.Text qualified as T
-import Data.Time (NominalDiffTime, diffUTCTime, getCurrentTime)
+import Data.Time
+  ( NominalDiffTime,
+    diffUTCTime,
+    getCurrentTime,
+  )
 import Emanote.Prelude (log, logD, logW)
 import Numeric (showGFloat)
 import Relude
 import System.Process.ByteString (readProcessWithExitCode)
 import System.Which (staticWhich)
-import Toml (TomlCodec, encode, list, string, text, (.=))
+import Toml
+  ( TomlCodec,
+    encode,
+    list,
+    string,
+    table,
+    text,
+    (.=),
+  )
 
 -- | In-memory Stork index tracked in a @TVar@
 newtype IndexVar = IndexVar (TVar (Maybe LByteString))
@@ -59,7 +71,7 @@ storkBin = $(staticWhich "stork")
 
 runStork :: MonadIO m => Input -> m LByteString
 runStork input = do
-  let storkToml = handleTomlandBug $ Toml.encode inputCodec input
+  let storkToml = handleTomlandBug $ Toml.encode storkInputCodec (StorkInput input)
   (_, !index, _) <-
     liftIO $
       readProcessWithExitCode
@@ -79,11 +91,16 @@ runStork input = do
       -- title (but why would they?)
       T.replace "\\\\U" "\\U"
 
-newtype Input = Input
-  { inputFiles :: [File]
+data Input = Input
+  { inputFiles :: [File],
+    inputFrontmatterHandling :: Text
   }
   deriving stock (Eq, Show)
 
+newtype StorkInput = StorkInput
+  { globalInput :: Input
+  }
+
 data File = File
   { filePath :: FilePath,
     fileUrl :: Text,
@@ -98,7 +115,13 @@ fileCodec =
     <*> Toml.text "url" .= fileUrl
     <*> Toml.text "title" .= fileTitle
 
+storkInputCodec :: TomlCodec StorkInput
+storkInputCodec =
+  StorkInput
+    <$> Toml.table inputCodec "input" .= globalInput
+
 inputCodec :: TomlCodec Input
 inputCodec =
   Input
-    <$> Toml.list fileCodec "input.files" .= inputFiles
+    <$> Toml.list fileCodec "files" .= inputFiles
+    <*> Toml.text "frontmatter_handling" .= inputFrontmatterHandling