{- | This module defines helper functions for loading templates from a list of
   directories, optionally using @fsnotify@ for watching and reloading on file
   changes. There is also a helper for loading templates at compile-time via the
   @file-embed@ package.
-}
module Ondim.Loading
  ( loadTemplates,
    loadTemplatesDynamic,
    loadTemplatesEmbed,

    -- * \"Advanced\" usage

    --

    -- | There are default 'LoadConfig's inside each target's respective
    -- modules, but you can also use the definitions below to customize them if
    -- you wish.
    LoadConfig (..),
    LoadFn,
    loadFnSimple,
    TemplateLoadingException (..),
  ) where

import Control.Exception (throw)
import Data.Map ((!))
import Ondim
  ( NamespaceItem (TemplateData),
    OndimNode,
    OndimState (expansions),
    delete,
    insert,
  )
import Ondim.Internal.Basic (fileSite)
import Relude.Extra (minimumOn1, toPairs)
import System.FilePath (splitDirectories, (</>))
import System.FilePattern (FilePattern, matchMany)
import System.UnionMount
  ( Change,
    FileAction (Delete, Refresh),
    Logger,
    unionMount,
  )

-- | Some template loading (impure) exception.
newtype TemplateLoadingException = TemplateLoadingException String
  deriving (TemplateLoadingException -> TemplateLoadingException -> Bool
(TemplateLoadingException -> TemplateLoadingException -> Bool)
-> (TemplateLoadingException -> TemplateLoadingException -> Bool)
-> Eq TemplateLoadingException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TemplateLoadingException -> TemplateLoadingException -> Bool
== :: TemplateLoadingException -> TemplateLoadingException -> Bool
$c/= :: TemplateLoadingException -> TemplateLoadingException -> Bool
/= :: TemplateLoadingException -> TemplateLoadingException -> Bool
Eq, Int -> TemplateLoadingException -> ShowS
[TemplateLoadingException] -> ShowS
TemplateLoadingException -> [Char]
(Int -> TemplateLoadingException -> ShowS)
-> (TemplateLoadingException -> [Char])
-> ([TemplateLoadingException] -> ShowS)
-> Show TemplateLoadingException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TemplateLoadingException -> ShowS
showsPrec :: Int -> TemplateLoadingException -> ShowS
$cshow :: TemplateLoadingException -> [Char]
show :: TemplateLoadingException -> [Char]
$cshowList :: [TemplateLoadingException] -> ShowS
showList :: [TemplateLoadingException] -> ShowS
Show)
  deriving anyclass (Show TemplateLoadingException
Typeable TemplateLoadingException
(Typeable TemplateLoadingException,
 Show TemplateLoadingException) =>
(TemplateLoadingException -> SomeException)
-> (SomeException -> Maybe TemplateLoadingException)
-> (TemplateLoadingException -> [Char])
-> (TemplateLoadingException -> Bool)
-> Exception TemplateLoadingException
SomeException -> Maybe TemplateLoadingException
TemplateLoadingException -> Bool
TemplateLoadingException -> [Char]
TemplateLoadingException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> [Char])
-> (e -> Bool)
-> Exception e
$ctoException :: TemplateLoadingException -> SomeException
toException :: TemplateLoadingException -> SomeException
$cfromException :: SomeException -> Maybe TemplateLoadingException
fromException :: SomeException -> Maybe TemplateLoadingException
$cdisplayException :: TemplateLoadingException -> [Char]
displayException :: TemplateLoadingException -> [Char]
$cbacktraceDesired :: TemplateLoadingException -> Bool
backtraceDesired :: TemplateLoadingException -> Bool
Exception)

-- | A recipe to create templates from file contents.
type LoadFn n =
  -- | Filepath
  FilePath ->
  -- | File contents
  LByteString ->
  -- | Resulting state data
  NamespaceItem n

-- | Default way to load a template. In most cases you should use this recipe.
loadFnSimple :: (OndimNode a) => (FilePath -> LByteString -> Either String a) -> LoadFn n
loadFnSimple :: forall a n.
OndimNode a =>
([Char] -> LByteString -> Either [Char] a) -> LoadFn n
loadFnSimple [Char] -> LByteString -> Either [Char] a
fn [Char]
fp LByteString
bs = DefinitionSite -> a -> NamespaceItem n
forall a s. OndimNode a => DefinitionSite -> a -> NamespaceItem s
TemplateData DefinitionSite
site (a -> NamespaceItem n) -> a -> NamespaceItem n
forall a b. (a -> b) -> a -> b
$ ([Char] -> a) -> (a -> a) -> Either [Char] a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> a
forall {c}. [Char] -> c
throw' a -> a
forall a. a -> a
id (Either [Char] a -> a) -> Either [Char] a -> a
forall a b. (a -> b) -> a -> b
$ [Char] -> LByteString -> Either [Char] a
fn [Char]
fp LByteString
bs
  where
    site :: DefinitionSite
site = [Char] -> DefinitionSite
fileSite [Char]
fp
    throw' :: [Char] -> c
throw' = TemplateLoadingException -> c
forall a e. (HasCallStack, Exception e) => e -> a
throw (TemplateLoadingException -> c)
-> ([Char] -> TemplateLoadingException) -> [Char] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> TemplateLoadingException
TemplateLoadingException

fpToIdentifier :: FilePath -> Text
fpToIdentifier :: [Char] -> Text
fpToIdentifier = [Char] -> Text
forall a. ToText a => a -> Text
toText ([Char] -> Text) -> ShowS -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"." ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
splitDirectories

loadFnToUpdate :: LoadFn n -> FilePath -> Text -> LByteString -> OndimState n -> OndimState n
loadFnToUpdate :: forall n.
LoadFn n
-> [Char] -> Text -> LByteString -> OndimState n -> OndimState n
loadFnToUpdate LoadFn n
fn [Char]
fp Text
name LByteString
bs OndimState n
s =
  OndimState n
s {expansions = insert name res (expansions s)}
  where
    res :: NamespaceItem n
res = LoadFn n
fn [Char]
fp LByteString
bs

-- | Configuration for loading templates of a specific type.
data LoadConfig n = LoadConfig
  { -- | Glob patterns to search for files.
    forall n. LoadConfig n -> [[Char]]
patterns :: [FilePattern],
    -- | Recipe to load the templates.
    forall n. LoadConfig n -> LoadFn n
loadFn :: LoadFn n,
    -- | Initial state. You can use this to set some default expansions or
    -- templates that may be overshadowed by file templates.
    forall n. LoadConfig n -> OndimState n
initialState :: OndimState n
  }

{- | Load templates from a list of directories in descending order of priority,
   and return the inital state and a watcher action that takes a handler to
   update the state when templates get updated on disk.
-}
loadTemplatesDynamic ::
  forall n.
  -- | Loading configurations
  [LoadConfig n] ->
  -- | Places to look for templates and their (optional) mount point,
  -- in descending order of priority.
  [(FilePath, Maybe FilePath)] ->
  -- | Logger
  Logger ->
  IO (OndimState n, (OndimState n -> IO ()) -> IO ())
loadTemplatesDynamic :: forall n.
[LoadConfig n]
-> [([Char], Maybe [Char])]
-> Logger
-> IO (OndimState n, (OndimState n -> IO ()) -> IO ())
loadTemplatesDynamic [LoadConfig n]
cfgs [([Char], Maybe [Char])]
places Logger
logger =
  let sources :: Set ((Int, [Char]), ([Char], Maybe [Char]))
sources = [Item (Set ((Int, [Char]), ([Char], Maybe [Char])))]
-> Set ((Int, [Char]), ([Char], Maybe [Char]))
forall l. IsList l => [Item l] -> l
fromList ([(Int, [Char])]
-> [([Char], Maybe [Char])]
-> [((Int, [Char]), ([Char], Maybe [Char]))]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int] -> [[Char]] -> [(Int, [Char])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] (([Char], Maybe [Char]) -> [Char]
forall a b. (a, b) -> a
fst (([Char], Maybe [Char]) -> [Char])
-> [([Char], Maybe [Char])] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([Char], Maybe [Char])]
places)) [([Char], Maybe [Char])]
places)
      cfgMap :: Map Int (LoadFn n)
cfgMap = [Item (Map Int (LoadFn n))] -> Map Int (LoadFn n)
forall l. IsList l => [Item l] -> l
fromList ([Item (Map Int (LoadFn n))] -> Map Int (LoadFn n))
-> [Item (Map Int (LoadFn n))] -> Map Int (LoadFn n)
forall a b. (a -> b) -> a -> b
$ [(Int
i, LoadFn n
f) | (Int
i, LoadConfig n -> LoadFn n
forall n. LoadConfig n -> LoadFn n
loadFn -> LoadFn n
f) <- [Int] -> [LoadConfig n] -> [(Int, LoadConfig n)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [LoadConfig n]
cfgs]
      patts :: [(Int, [Char])]
patts = [(Int
i, [Char]
p) | (Int
i, LoadConfig n -> [[Char]]
forall n. LoadConfig n -> [[Char]]
patterns -> [[Char]]
ps) <- [Int] -> [LoadConfig n] -> [(Int, LoadConfig n)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [LoadConfig n]
cfgs, [Char]
p <- [[Char]]
ps]
      exclude :: [a]
exclude = []
      initial :: OndimState n
initial = (LoadConfig n -> OndimState n) -> [LoadConfig n] -> OndimState n
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' LoadConfig n -> OndimState n
forall n. LoadConfig n -> OndimState n
initialState [LoadConfig n]
cfgs
      handler :: Change (Int, FilePath) Int -> IO (OndimState n -> OndimState n)
      handler :: Change (Int, [Char]) Int -> IO (OndimState n -> OndimState n)
handler Change (Int, [Char]) Int
chg =
        Endo (OndimState n) -> OndimState n -> OndimState n
forall a. Endo a -> a -> a
appEndo (Endo (OndimState n) -> OndimState n -> OndimState n)
-> ([[OndimState n -> OndimState n]] -> Endo (OndimState n))
-> [[OndimState n -> OndimState n]]
-> OndimState n
-> OndimState n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Endo (OndimState n)] -> Endo (OndimState n)
forall a. Monoid a => [a] -> a
mconcat ([Endo (OndimState n)] -> Endo (OndimState n))
-> ([[OndimState n -> OndimState n]] -> [Endo (OndimState n)])
-> [[OndimState n -> OndimState n]]
-> Endo (OndimState n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OndimState n -> OndimState n] -> [Endo (OndimState n)]
forall a b. Coercible a b => a -> b
coerce ([OndimState n -> OndimState n] -> [Endo (OndimState n)])
-> ([[OndimState n -> OndimState n]]
    -> [OndimState n -> OndimState n])
-> [[OndimState n -> OndimState n]]
-> [Endo (OndimState n)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[OndimState n -> OndimState n]] -> [OndimState n -> OndimState n]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
          ([[OndimState n -> OndimState n]] -> OndimState n -> OndimState n)
-> IO [[OndimState n -> OndimState n]]
-> IO (OndimState n -> OndimState n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Map [Char] (FileAction (NonEmpty ((Int, [Char]), [Char]))))]
-> ((Int,
     Map [Char] (FileAction (NonEmpty ((Int, [Char]), [Char]))))
    -> IO [OndimState n -> OndimState n])
-> IO [[OndimState n -> OndimState n]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Change (Int, [Char]) Int
-> [(Int,
     Map [Char] (FileAction (NonEmpty ((Int, [Char]), [Char]))))]
forall t a b. (IsList t, Item t ~ (a, b)) => t -> [(a, b)]
toPairs Change (Int, [Char]) Int
chg) \(Int
i, Map [Char] (FileAction (NonEmpty ((Int, [Char]), [Char])))
chg') ->
            [([Char], FileAction (NonEmpty ((Int, [Char]), [Char])))]
-> (([Char], FileAction (NonEmpty ((Int, [Char]), [Char])))
    -> IO (OndimState n -> OndimState n))
-> IO [OndimState n -> OndimState n]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map [Char] (FileAction (NonEmpty ((Int, [Char]), [Char])))
-> [([Char], FileAction (NonEmpty ((Int, [Char]), [Char])))]
forall t a b. (IsList t, Item t ~ (a, b)) => t -> [(a, b)]
toPairs Map [Char] (FileAction (NonEmpty ((Int, [Char]), [Char])))
chg') \([Char]
file, FileAction (NonEmpty ((Int, [Char]), [Char]))
fa) ->
              let name :: Text
name = [Char] -> Text
fpToIdentifier [Char]
file
               in case FileAction (NonEmpty ((Int, [Char]), [Char]))
fa of
                    Refresh RefreshAction
_ NonEmpty ((Int, [Char]), [Char])
ls ->
                      let dir :: [Char]
dir = (Int, [Char]) -> [Char]
forall a b. (a, b) -> b
snd ((Int, [Char]) -> [Char]) -> (Int, [Char]) -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Int, [Char]) -> Int) -> NonEmpty (Int, [Char]) -> (Int, [Char])
forall b a. Ord b => (a -> b) -> NonEmpty a -> a
forall (f :: * -> *) b a.
(Foldable1 f, Ord b) =>
(a -> b) -> f a -> a
minimumOn1 (Int, [Char]) -> Int
forall a b. (a, b) -> a
fst (((Int, [Char]), [Char]) -> (Int, [Char])
forall a b. (a, b) -> a
fst (((Int, [Char]), [Char]) -> (Int, [Char]))
-> NonEmpty ((Int, [Char]), [Char]) -> NonEmpty (Int, [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty ((Int, [Char]), [Char])
ls)
                          fp :: [Char]
fp = [Char]
dir [Char] -> ShowS
</> [Char]
file
                       in [Char] -> IO LByteString
forall (m :: * -> *). MonadIO m => [Char] -> m LByteString
readFileLBS [Char]
fp IO LByteString
-> (LByteString -> OndimState n -> OndimState n)
-> IO (OndimState n -> OndimState n)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> LoadFn n
-> [Char] -> Text -> LByteString -> OndimState n -> OndimState n
forall n.
LoadFn n
-> [Char] -> Text -> LByteString -> OndimState n -> OndimState n
loadFnToUpdate (Map Int (LoadFn n)
cfgMap Map Int (LoadFn n) -> Int -> LoadFn n
forall k a. Ord k => Map k a -> k -> a
! Int
i) [Char]
fp Text
name
                    FileAction (NonEmpty ((Int, [Char]), [Char]))
Delete -> (OndimState n -> OndimState n) -> IO (OndimState n -> OndimState n)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure \OndimState n
s -> OndimState n
s {expansions = delete name (expansions s)} OndimState n -> OndimState n -> OndimState n
forall a. Semigroup a => a -> a -> a
<> OndimState n
initial
   in Set ((Int, [Char]), ([Char], Maybe [Char]))
-> [(Int, [Char])]
-> [[Char]]
-> OndimState n
-> Logger
-> (Change (Int, [Char]) Int -> IO (OndimState n -> OndimState n))
-> IO (OndimState n, (OndimState n -> IO ()) -> IO ())
forall source tag model.
(Ord source, Ord tag) =>
Set (source, ([Char], Maybe [Char]))
-> [(tag, [Char])]
-> [[Char]]
-> model
-> Logger
-> (Change source tag -> IO (model -> model))
-> IO (model, (model -> IO ()) -> IO ())
unionMount Set ((Int, [Char]), ([Char], Maybe [Char]))
sources [(Int, [Char])]
patts [[Char]]
forall a. [a]
exclude OndimState n
initial Logger
logger Change (Int, [Char]) Int -> IO (OndimState n -> OndimState n)
handler

-- | Load templates from a list of directories in descending order of priority.
loadTemplates :: [LoadConfig n] -> [(FilePath, Maybe FilePath)] -> Logger -> IO (OndimState n)
loadTemplates :: forall n.
[LoadConfig n]
-> [([Char], Maybe [Char])] -> Logger -> IO (OndimState n)
loadTemplates [LoadConfig n]
cfgs [([Char], Maybe [Char])]
dirs Logger
logger = (OndimState n, (OndimState n -> IO ()) -> IO ()) -> OndimState n
forall a b. (a, b) -> a
fst ((OndimState n, (OndimState n -> IO ()) -> IO ()) -> OndimState n)
-> IO (OndimState n, (OndimState n -> IO ()) -> IO ())
-> IO (OndimState n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LoadConfig n]
-> [([Char], Maybe [Char])]
-> Logger
-> IO (OndimState n, (OndimState n -> IO ()) -> IO ())
forall n.
[LoadConfig n]
-> [([Char], Maybe [Char])]
-> Logger
-> IO (OndimState n, (OndimState n -> IO ()) -> IO ())
loadTemplatesDynamic [LoadConfig n]
cfgs [([Char], Maybe [Char])]
dirs Logger
logger

{- | Load templates in pure code from a list of filepaths and bytestrings. Meant
   to be used with the @file-embed@ package.
-}
loadTemplatesEmbed :: String -> [LoadConfig n] -> [(FilePath, ByteString)] -> OndimState n
loadTemplatesEmbed :: forall n.
[Char] -> [LoadConfig n] -> [([Char], ByteString)] -> OndimState n
loadTemplatesEmbed [Char]
prefix [LoadConfig n]
cfgs [([Char], ByteString)]
files = ((LoadFn n, (LByteString, [Char]), [[Char]])
 -> OndimState n -> OndimState n)
-> OndimState n
-> [(LoadFn n, (LByteString, [Char]), [[Char]])]
-> OndimState n
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (LoadFn n, (LByteString, [Char]), [[Char]])
-> OndimState n -> OndimState n
go ((LoadConfig n -> OndimState n) -> [LoadConfig n] -> OndimState n
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' LoadConfig n -> OndimState n
forall n. LoadConfig n -> OndimState n
initialState [LoadConfig n]
cfgs) [(LoadFn n, (LByteString, [Char]), [[Char]])]
res
  where
    patts :: [(LoadFn n, [Char])]
patts = [(LoadConfig n -> LoadFn n
forall n. LoadConfig n -> LoadFn n
loadFn LoadConfig n
c, [Char]
p) | LoadConfig n
c <- [LoadConfig n]
cfgs, [Char]
p <- LoadConfig n -> [[Char]]
forall n. LoadConfig n -> [[Char]]
patterns LoadConfig n
c]
    fdata :: [((LByteString, [Char]), [Char])]
fdata = [((ByteString -> LByteString
forall l s. LazyStrict l s => s -> l
toLazy ByteString
bs, [Char]
fp), [Char]
fp) | ([Char]
fp, ByteString
bs) <- [([Char], ByteString)]
files]
    res :: [(LoadFn n, (LByteString, [Char]), [[Char]])]
res = [(LoadFn n, [Char])]
-> [((LByteString, [Char]), [Char])]
-> [(LoadFn n, (LByteString, [Char]), [[Char]])]
forall a b. [(a, [Char])] -> [(b, [Char])] -> [(a, b, [[Char]])]
matchMany [(LoadFn n, [Char])]
patts [((LByteString, [Char]), [Char])]
fdata
    go :: (LoadFn n, (LByteString, [Char]), [[Char]])
-> OndimState n -> OndimState n
go (LoadFn n
fn, (LByteString
bs, [Char]
fp), [[Char]]
_) = LoadFn n
-> [Char] -> Text -> LByteString -> OndimState n -> OndimState n
forall n.
LoadFn n
-> [Char] -> Text -> LByteString -> OndimState n -> OndimState n
loadFnToUpdate LoadFn n
fn ([Char]
prefix [Char] -> ShowS
</> [Char]
fp) ([Char] -> Text
fpToIdentifier [Char]
fp) LByteString
bs