module Emanote.Source.Pattern where

import Emanote.Route qualified as R
import Relude
import System.FilePattern (FilePattern)

filePattern :: HasCallStack => R.FileType R.SourceExt -> FilePath
filePattern :: HasCallStack => FileType SourceExt -> FilePath
filePattern = \case
  R.LMLType LML
R.Md ->
    forall a (ext :: FileType a). HasExt @a ext => FilePath -> FilePath
R.withExt @_ @('R.LMLType 'R.Md) forall a b. (a -> b) -> a -> b
$
      FilePath
"**/*"
  R.LMLType LML
R.Org ->
    forall a (ext :: FileType a). HasExt @a ext => FilePath -> FilePath
R.withExt @_ @('R.LMLType 'R.Org) forall a b. (a -> b) -> a -> b
$
      FilePath
"**/*"
  FileType SourceExt
R.Yaml ->
    forall a (ext :: FileType a). HasExt @a ext => FilePath -> FilePath
R.withExt @_ @('R.Yaml) FilePath
"**/*"
  FileType SourceExt
R.HeistTpl ->
    forall a (ext :: FileType a). HasExt @a ext => FilePath -> FilePath
R.withExt @_ @('R.HeistTpl) forall a b. (a -> b) -> a -> b
$
      FilePath
"**/*"
  FileType SourceExt
R.AnyExt ->
    FilePath
"**"

filePatterns :: [(R.FileType R.SourceExt, FilePattern)]
filePatterns :: [(FileType SourceExt, FilePath)]
filePatterns =
  (forall a. a -> a
id forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& HasCallStack => FileType SourceExt -> FilePath
filePattern)
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [ LML -> FileType SourceExt
R.LMLType LML
R.Md
        , LML -> FileType SourceExt
R.LMLType LML
R.Org
        , FileType SourceExt
R.Yaml
        , FileType SourceExt
R.HeistTpl
        , FileType SourceExt
R.AnyExt
        ]

ignorePatterns :: [FilePattern]
ignorePatterns :: [FilePath]
ignorePatterns =
  [ -- Ignore all dotfile directories (eg: .git, .vscode)
    FilePath
"**/.*/**"
  , -- Ignore vi/vim/neovim writebackup files (see ":help writebackup")
    FilePath
"**/*~"
  , -- /Top-level ./-/ directory is reserved by Emanote
    FilePath
"-/**"
  , -- Special files that are not meant to be rendered
    -- NOTE: We must hardcode this only because there is no user-controllable
    -- `.emanoteignore` setting yet.{-# ANN annotation #-}
    --
    -- Any top-level Nix flake files
    FilePath
"flake.nix"
  , FilePath
"flake.lock"
  ]