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) (FilePath -> FilePath) -> FilePath -> FilePath
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) (FilePath -> FilePath) -> FilePath -> FilePath
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 -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
      FilePath
"**/*"
  FileType SourceExt
R.HeistTpl ->
    forall a (ext :: FileType a). HasExt @a ext => FilePath -> FilePath
R.withExt @_ @'R.HeistTpl (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
      FilePath
"**/*"
  FileType SourceExt
R.AnyExt ->
    FilePath
"**"

filePatterns :: [(R.FileType R.SourceExt, FilePattern)]
filePatterns :: [(FileType SourceExt, FilePath)]
filePatterns =
  (FileType SourceExt -> FileType SourceExt
forall a. a -> a
id (FileType SourceExt -> FileType SourceExt)
-> (FileType SourceExt -> FilePath)
-> FileType SourceExt
-> (FileType SourceExt, FilePath)
forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& HasCallStack => FileType SourceExt -> FilePath
FileType SourceExt -> FilePath
filePattern)
    (FileType SourceExt -> (FileType SourceExt, FilePath))
-> [FileType SourceExt] -> [(FileType SourceExt, FilePath)]
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
"-/**"
  ]