{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | Main module for using neuron as a library, instead of as a CLI tool.
module Neuron.Zettelkasten
  ( -- * CLI
    App (..),
    NewCommand (..),
    commandParser,
    run,
    runWith,

    -- * Rib site generation
    generateSite,

    -- * Etc
    newZettelFile,
  )
where

import qualified Data.Aeson.Text as Aeson
import qualified Data.Map.Strict as Map
import Development.Shake (Action)
import qualified Neuron.Version as Version
import qualified Neuron.Zettelkasten.Graph as Z
import qualified Neuron.Zettelkasten.ID as Z
import qualified Neuron.Zettelkasten.Link.Action as Z
import qualified Neuron.Zettelkasten.Query as Z
import qualified Neuron.Zettelkasten.Route as Z
import qualified Neuron.Zettelkasten.Store as Z
import Options.Applicative
import Path
import Path.IO
import Relude
import qualified Rib
import qualified Rib.App
import qualified System.Directory as Directory
import System.FilePath (addTrailingPathSeparator, dropTrailingPathSeparator)
import qualified System.Posix.Env as Env
import System.Posix.Process
import System.Which
import qualified Text.URI as URI

neuronSearchScript :: FilePath
neuronSearchScript :: FilePath
neuronSearchScript = $(staticWhich "neuron-search")

data App
  = App
      { App -> FilePath
notesDir :: FilePath,
        App -> Command
cmd :: Command
      }
  deriving (App -> App -> Bool
(App -> App -> Bool) -> (App -> App -> Bool) -> Eq App
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: App -> App -> Bool
$c/= :: App -> App -> Bool
== :: App -> App -> Bool
$c== :: App -> App -> Bool
Eq, Int -> App -> ShowS
[App] -> ShowS
App -> FilePath
(Int -> App -> ShowS)
-> (App -> FilePath) -> ([App] -> ShowS) -> Show App
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [App] -> ShowS
$cshowList :: [App] -> ShowS
show :: App -> FilePath
$cshow :: App -> FilePath
showsPrec :: Int -> App -> ShowS
$cshowsPrec :: Int -> App -> ShowS
Show)

data NewCommand = NewCommand {NewCommand -> Text
title :: Text, NewCommand -> Bool
edit :: Bool}
  deriving (NewCommand -> NewCommand -> Bool
(NewCommand -> NewCommand -> Bool)
-> (NewCommand -> NewCommand -> Bool) -> Eq NewCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewCommand -> NewCommand -> Bool
$c/= :: NewCommand -> NewCommand -> Bool
== :: NewCommand -> NewCommand -> Bool
$c== :: NewCommand -> NewCommand -> Bool
Eq, Int -> NewCommand -> ShowS
[NewCommand] -> ShowS
NewCommand -> FilePath
(Int -> NewCommand -> ShowS)
-> (NewCommand -> FilePath)
-> ([NewCommand] -> ShowS)
-> Show NewCommand
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NewCommand] -> ShowS
$cshowList :: [NewCommand] -> ShowS
show :: NewCommand -> FilePath
$cshow :: NewCommand -> FilePath
showsPrec :: Int -> NewCommand -> ShowS
$cshowsPrec :: Int -> NewCommand -> ShowS
Show)

data Command
  = -- | Create a new zettel file
    New NewCommand
  | -- | Search a zettel by title
    Search
  | -- | Run a query against the Zettelkasten
    Query [Z.Query]
  | -- | Delegate to Rib's command parser
    Rib Rib.App.Command
  deriving (Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq, Int -> Command -> ShowS
[Command] -> ShowS
Command -> FilePath
(Int -> Command -> ShowS)
-> (Command -> FilePath) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> FilePath
$cshow :: Command -> FilePath
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show)

-- | optparse-applicative parser for neuron CLI
commandParser :: Parser App
commandParser :: Parser App
commandParser =
  FilePath -> Command -> App
App
    (FilePath -> Command -> App)
-> Parser FilePath -> Parser (Command -> App)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM FilePath -> Mod ArgumentFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument (ShowS -> ReadM FilePath -> ReadM FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
addTrailingPathSeparator ReadM FilePath
forall s. IsString s => ReadM s
str) (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "NOTESDIR")
    Parser (Command -> App) -> Parser Command -> Parser App
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
cmdParser
  where
    cmdParser :: Parser Command
cmdParser =
      Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
hsubparser (Mod CommandFields Command -> Parser Command)
-> Mod CommandFields Command -> Parser Command
forall a b. (a -> b) -> a -> b
$
        [Mod CommandFields Command] -> Mod CommandFields Command
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "new" (ParserInfo Command -> Mod CommandFields Command)
-> ParserInfo Command -> Mod CommandFields Command
forall a b. (a -> b) -> a -> b
$ Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
newCommand (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc "Create a new zettel",
            FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "search" (ParserInfo Command -> Mod CommandFields Command)
-> ParserInfo Command -> Mod CommandFields Command
forall a b. (a -> b) -> a -> b
$ Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
searchCommand (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc "Search zettels and print the matching filepath",
            FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "query" (ParserInfo Command -> Mod CommandFields Command)
-> ParserInfo Command -> Mod CommandFields Command
forall a b. (a -> b) -> a -> b
$ Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
queryCommand (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc "Run a query against the zettelkasten",
            FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "rib" (ParserInfo Command -> Mod CommandFields Command)
-> ParserInfo Command -> Mod CommandFields Command
forall a b. (a -> b) -> a -> b
$ (Command -> Command) -> ParserInfo Command -> ParserInfo Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Command -> Command
Rib (ParserInfo Command -> ParserInfo Command)
-> ParserInfo Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
Rib.App.commandParser (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc "Run a rib command"
          ]
    newCommand :: Parser Command
newCommand = do
      Bool
edit <- Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "edit" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'e' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help "Open the newly-created file in $EDITOR")
      Text
title <- ReadM Text -> Mod ArgumentFields Text -> Parser Text
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Text
forall s. IsString s => ReadM s
str (FilePath -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "TITLE" Mod ArgumentFields Text
-> Mod ArgumentFields Text -> Mod ArgumentFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help "Title of the new Zettel")
      return (NewCommand -> Command
New NewCommand :: Text -> Bool -> NewCommand
NewCommand {..})
    queryCommand :: Parser Command
queryCommand =
      ([Query] -> Command) -> Parser [Query] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Query] -> Command
Query (Parser [Query] -> Parser Command)
-> Parser [Query] -> Parser Command
forall a b. (a -> b) -> a -> b
$
        (Parser Query -> Parser [Query]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Text -> Query
Z.ByTag (Text -> Query) -> Parser Text -> Parser Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Text -> Mod OptionFields Text -> Parser Text
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Text
forall s. IsString s => ReadM s
str (FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "tag" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 't')))
          Parser [Query] -> Parser [Query] -> Parser [Query]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (URI -> [Query]
Z.queryFromUri (URI -> [Query]) -> (Text -> URI) -> Text -> [Query]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> URI
mkURIMust (Text -> [Query]) -> Parser Text -> Parser [Query]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Text -> Mod OptionFields Text -> Parser Text
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Text
forall s. IsString s => ReadM s
str (FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "uri" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'u'))
    searchCommand :: Parser Command
searchCommand =
      Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Search
    mkURIMust :: Text -> URI
mkURIMust =
      (SomeException -> URI)
-> (URI -> URI) -> Either SomeException URI -> URI
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> URI
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> URI) -> (SomeException -> Text) -> SomeException -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text)
-> (SomeException -> FilePath) -> SomeException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> FilePath
forall e. Exception e => e -> FilePath
displayException) URI -> URI
forall a. a -> a
id (Either SomeException URI -> URI)
-> (Text -> Either SomeException URI) -> Text -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either SomeException URI
forall (m :: * -> *). MonadThrow m => Text -> m URI
URI.mkURI

run :: Action () -> IO ()
run :: Action () -> IO ()
run act :: Action ()
act =
  Action () -> App -> IO ()
runWith Action ()
act (App -> IO ()) -> IO App -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParserInfo App -> IO App
forall a. ParserInfo a -> IO a
execParser ParserInfo App
opts
  where
    opts :: ParserInfo App
opts =
      Parser App -> InfoMod App -> ParserInfo App
forall a. Parser a -> InfoMod a -> ParserInfo a
info
        (Parser (App -> App)
forall a. Parser (a -> a)
versionOption Parser (App -> App) -> Parser App -> Parser App
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser App
commandParser Parser App -> Parser (App -> App) -> Parser App
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (App -> App)
forall a. Parser (a -> a)
helper)
        (InfoMod App
forall a. InfoMod a
fullDesc InfoMod App -> InfoMod App -> InfoMod App
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod App
forall a. FilePath -> InfoMod a
progDesc "Zettelkasten based on Rib")
    versionOption :: Parser (a -> a)
versionOption =
      FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
        (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
Version.neuronVersionFull)
        (FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. FilePath -> Mod f a
help "Show version")

runWith :: Action () -> App -> IO ()
runWith :: Action () -> App -> IO ()
runWith ribAction :: Action ()
ribAction App {..} = do
  FilePath
notesDirAbs <- FilePath -> IO FilePath
Directory.makeAbsolute FilePath
notesDir
  Path Abs Dir
inputDir <- FilePath -> IO (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir FilePath
notesDirAbs
  Path Abs Dir
outputDir <- Path Abs Dir -> FilePath -> IO (Path Abs Dir)
directoryAside Path Abs Dir
inputDir ".output"
  case Command
cmd of
    New newCommand :: NewCommand
newCommand ->
      Path Abs Dir -> NewCommand -> IO ()
forall b. Path b Dir -> NewCommand -> IO ()
newZettelFile Path Abs Dir
inputDir NewCommand
newCommand
    Search ->
      FilePath -> [FilePath] -> IO ()
execScript FilePath
neuronSearchScript [FilePath
notesDir]
    Query queries :: [Query]
queries -> do
      Path Abs Dir -> Path Abs Dir -> Action () -> IO ()
forall path b t.
(AnyPath path, AnyPath (Path b t),
 RelPath (Path b t) ~ Path Rel Dir, RelPath path ~ Path Rel Dir) =>
Path b t -> path -> Action () -> IO ()
runRibOneOffShake Path Abs Dir
inputDir Path Abs Dir
outputDir (Action () -> IO ()) -> Action () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        ZettelStore
store <- [Path Rel File] -> Action ZettelStore
Z.mkZettelStore ([Path Rel File] -> Action ZettelStore)
-> Action [Path Rel File] -> Action ZettelStore
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Path Rel File]
-> (Path Rel File -> Action (Path Rel File))
-> Action [Path Rel File]
forall a.
[Path Rel File] -> (Path Rel File -> Action a) -> Action [a]
Rib.forEvery [[relfile|*.md|]] Path Rel File -> Action (Path Rel File)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        let matches :: [Match]
matches = ZettelStore -> [Query] -> [Match]
Z.runQuery ZettelStore
store [Query]
queries
        LText -> Action ()
forall (m :: * -> *). MonadIO m => LText -> m ()
putLTextLn (LText -> Action ()) -> LText -> Action ()
forall a b. (a -> b) -> a -> b
$ [Match] -> LText
forall a. ToJSON a => a -> LText
Aeson.encodeToLazyText ([Match] -> LText) -> [Match] -> LText
forall a b. (a -> b) -> a -> b
$ [Match]
matches
    Rib ribCmd :: Command
ribCmd ->
      Path Abs Dir -> Path Abs Dir -> Command -> Action () -> IO ()
forall path b t.
(AnyPath path, AnyPath (Path b t),
 RelPath (Path b t) ~ Path Rel Dir, RelPath path ~ Path Rel Dir) =>
Path b t -> path -> Command -> Action () -> IO ()
runRib Path Abs Dir
inputDir Path Abs Dir
outputDir Command
ribCmd Action ()
ribAction
  where
    execScript :: FilePath -> [FilePath] -> IO ()
execScript scriptPath :: FilePath
scriptPath args :: [FilePath]
args =
      -- We must use the low-level execvp (via the unix package's `executeFile`)
      -- here, such that the new process replaces the current one. fzf won't work
      -- otherwise.
      IO Any -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Any -> IO ()) -> IO Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO Any
forall a.
FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO a
executeFile FilePath
scriptPath Bool
False [FilePath]
args Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
    -- Run an one-off shake action through rib
    runRibOneOffShake :: Path b t -> path -> Action () -> IO ()
runRibOneOffShake inputDir :: Path b t
inputDir outputDir :: path
outputDir =
      Path b t -> path -> Command -> Action () -> IO ()
forall path b t.
(AnyPath path, AnyPath (Path b t),
 RelPath (Path b t) ~ Path Rel Dir, RelPath path ~ Path Rel Dir) =>
Path b t -> path -> Command -> Action () -> IO ()
runRib Path b t
inputDir path
outputDir Command
Rib.App.OneOff
    runRib :: Path b t -> path -> Command -> Action () -> IO ()
runRib inputDir :: Path b t
inputDir outputDir :: path
outputDir ribCmd :: Command
ribCmd act :: Action ()
act =
      -- CD to the parent of notes directory, because Rib API takes only
      -- relative path
      Path b Dir -> IO () -> IO ()
forall (m :: * -> *) b a.
(MonadIO m, MonadMask m) =>
Path b Dir -> m a -> m a
withCurrentDir (Path b t -> Path b Dir
forall b t. Path b t -> Path b Dir
parent Path b t
inputDir) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Path Rel Dir
inputDirRel <- Path b t -> IO (RelPath (Path b t))
forall path (m :: * -> *).
(AnyPath path, MonadIO m) =>
path -> m (RelPath path)
makeRelativeToCurrentDir Path b t
inputDir
        Path Rel Dir
outputDirRel <- path -> IO (RelPath path)
forall path (m :: * -> *).
(AnyPath path, MonadIO m) =>
path -> m (RelPath path)
makeRelativeToCurrentDir path
outputDir
        Path Rel Dir -> Path Rel Dir -> Action () -> Command -> IO ()
Rib.App.runWith Path Rel Dir
inputDirRel Path Rel Dir
outputDirRel Action ()
act Command
ribCmd
    directoryAside :: Path Abs Dir -> String -> IO (Path Abs Dir)
    directoryAside :: Path Abs Dir -> FilePath -> IO (Path Abs Dir)
directoryAside fp :: Path Abs Dir
fp suffix :: FilePath
suffix = do
      let baseName :: FilePath
baseName = ShowS
dropTrailingPathSeparator ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Path Rel Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Rel Dir -> FilePath) -> Path Rel Dir -> FilePath
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
dirname Path Abs Dir
fp
      Path Rel Dir
newDir <- FilePath -> IO (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir (FilePath -> IO (Path Rel Dir)) -> FilePath -> IO (Path Rel Dir)
forall a b. (a -> b) -> a -> b
$ FilePath
baseName FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
suffix
      pure $ Path Abs Dir -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs Dir
fp Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
newDir

-- | Generate the Zettelkasten site
generateSite ::
  (Z.Route Z.ZettelStore Z.ZettelGraph () -> (Z.ZettelStore, Z.ZettelGraph) -> Action ()) ->
  [Path Rel File] ->
  Action (Z.ZettelStore, Z.ZettelGraph)
generateSite :: (Route ZettelStore ZettelGraph ()
 -> (ZettelStore, ZettelGraph) -> Action ())
-> [Path Rel File] -> Action (ZettelStore, ZettelGraph)
generateSite writeHtmlRoute' :: Route ZettelStore ZettelGraph ()
-> (ZettelStore, ZettelGraph) -> Action ()
writeHtmlRoute' zettelsPat :: [Path Rel File]
zettelsPat = do
  ZettelStore
zettelStore <- [Path Rel File] -> Action ZettelStore
Z.mkZettelStore ([Path Rel File] -> Action ZettelStore)
-> Action [Path Rel File] -> Action ZettelStore
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Path Rel File]
-> (Path Rel File -> Action (Path Rel File))
-> Action [Path Rel File]
forall a.
[Path Rel File] -> (Path Rel File -> Action a) -> Action [a]
Rib.forEvery [Path Rel File]
zettelsPat Path Rel File -> Action (Path Rel File)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  let zettelGraph :: ZettelGraph
zettelGraph = ZettelStore -> ZettelGraph
Z.mkZettelGraph ZettelStore
zettelStore
  let writeHtmlRoute :: Route ZettelStore ZettelGraph () -> Action ()
writeHtmlRoute r :: Route ZettelStore ZettelGraph ()
r = Route ZettelStore ZettelGraph ()
-> (ZettelStore, ZettelGraph) -> Action ()
writeHtmlRoute' Route ZettelStore ZettelGraph ()
r (ZettelStore
zettelStore, ZettelGraph
zettelGraph)
  -- Generate HTML for every zettel
  (Route ZettelStore ZettelGraph () -> Action ()
writeHtmlRoute (Route ZettelStore ZettelGraph () -> Action ())
-> (ZettelID -> Route ZettelStore ZettelGraph ())
-> ZettelID
-> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZettelID -> Route ZettelStore ZettelGraph ()
Z.Route_Zettel) (ZettelID -> Action ()) -> [ZettelID] -> Action ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
`mapM_` ZettelStore -> [ZettelID]
forall k a. Map k a -> [k]
Map.keys ZettelStore
zettelStore
  -- Generate the z-index
  Route ZettelStore ZettelGraph () -> Action ()
writeHtmlRoute Route ZettelStore ZettelGraph ()
Z.Route_ZIndex
  -- Write index.html, unless a index.md zettel exists
  Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Zettel -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Zettel -> Bool) -> Maybe Zettel -> Bool
forall a b. (a -> b) -> a -> b
$ ZettelID -> ZettelStore -> Maybe Zettel
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> ZettelID
Z.parseZettelID "index") ZettelStore
zettelStore) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$
    Route ZettelStore ZettelGraph () -> Action ()
writeHtmlRoute Route ZettelStore ZettelGraph ()
Z.Route_IndexRedirect
  pure (ZettelStore
zettelStore, ZettelGraph
zettelGraph)

-- | Create a new zettel file and open it in editor if requested
--
-- As well as print the path to the created file.
newZettelFile :: Path b Dir -> NewCommand -> IO ()
newZettelFile :: Path b Dir -> NewCommand -> IO ()
newZettelFile inputDir :: Path b Dir
inputDir NewCommand {..} = do
  -- TODO: refactor this function
  ZettelID
zId <- Path b Dir -> IO ZettelID
forall b. Path b Dir -> IO ZettelID
Z.zettelNextIdForToday Path b Dir
inputDir
  Path Rel File
zettelFileName <- FilePath -> IO (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile (FilePath -> IO (Path Rel File)) -> FilePath -> IO (Path Rel File)
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ ZettelID -> Text
Z.zettelIDSourceFileName ZettelID
zId
  let srcPath :: Path b File
srcPath = Path b Dir
inputDir Path b Dir -> Path Rel File -> Path b File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
zettelFileName
  Path b File -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path b File
srcPath IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    True ->
      FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "File already exists: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Path b File -> FilePath
forall b a. (Show a, IsString b) => a -> b
show Path b File
srcPath
    False -> do
      FilePath -> FilePath -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> FilePath -> m ()
writeFile (Path b File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path b File
srcPath) (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "---\ntitle: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
title FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> "\n---\n\n"
      let path :: FilePath
path = Path b File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path b File
srcPath
      FilePath -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
putStrLn FilePath
path
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
edit (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        FilePath -> IO (Maybe FilePath)
getEnvNonEmpty "EDITOR" IO (Maybe FilePath) -> (Maybe FilePath -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Nothing -> do
            FilePath -> IO ()
forall (m :: * -> *) a. MonadIO m => FilePath -> m a
die "\nCan't open file; you must set the EDITOR environment variable"
          Just editor :: FilePath
editor -> do
            FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO ()
forall a.
FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO a
executeFile FilePath
editor Bool
True [FilePath
path] Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
  where
    getEnvNonEmpty :: FilePath -> IO (Maybe FilePath)
getEnvNonEmpty name :: FilePath
name =
      FilePath -> IO (Maybe FilePath)
Env.getEnv FilePath
name IO (Maybe FilePath)
-> (Maybe FilePath -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Nothing -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
        Just "" -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
        Just v :: FilePath
v -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
v