{-# language ViewPatterns #-}
{-# language RankNTypes #-}
{-# language RecordWildCards #-}
{-# language NamedFieldPuns #-}
{-# language OverloadedStrings #-}
module SitePipe.Files
  (
  -- * Loaders
  resourceLoader

  -- * Writers
  , writeWith
  , writeTemplate
  , textWriter

  -- * Loader/Writers
  , copyFiles
  , copyFilesWith
  ) where

import Data.String
import Control.Monad.Catch
import Data.Foldable
import SitePipe.Templating
import SitePipe.Types
import qualified System.FilePath.Glob as G
import Data.Aeson as A
import Data.Aeson.Lens
import Data.Aeson.Types
import Control.Lens
import Text.Mustache
import System.Directory
import System.FilePath.Posix
import Control.Monad.Reader
import qualified Data.Text as T
import Data.Text.Lens
import SitePipe.Parse
import SitePipe.Utilities
import Shelly hiding ((</>), FilePath, relPath)
import Data.String.Utils
import Data.Bool

-- | Given a filepath globbing pattern relative to your sources root
-- this returns a list of absolute filepaths of matching files.
-- Standard globbing rules apply.
--
-- * "posts/*.md": matches any markdown files in the posts directory of your source folder.
-- * "**/*.txt": matches all text files recursively in your source folder.
srcGlob :: GlobPattern -> SiteM [FilePath]
srcGlob :: GlobPattern -> SiteM [GlobPattern]
srcGlob pattern :: GlobPattern
pattern@(Char
'/':GlobPattern
_) = SitePipeError -> SiteM [GlobPattern]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SitePipeError -> SiteM [GlobPattern])
-> SitePipeError -> SiteM [GlobPattern]
forall a b. (a -> b) -> a -> b
$ GlobPattern -> SitePipeError
SitePipeError (GlobPattern
"glob pattern " GlobPattern -> GlobPattern -> GlobPattern
forall a. [a] -> [a] -> [a]
++ GlobPattern
pattern GlobPattern -> GlobPattern -> GlobPattern
forall a. [a] -> [a] -> [a]
++ GlobPattern
" must be a relative path")
srcGlob GlobPattern
pattern = do
  GlobPattern
srcD <- (Settings -> GlobPattern)
-> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Settings -> GlobPattern
srcDir
  IO [GlobPattern] -> SiteM [GlobPattern]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [GlobPattern] -> SiteM [GlobPattern])
-> IO [GlobPattern] -> SiteM [GlobPattern]
forall a b. (a -> b) -> a -> b
$ GlobPattern -> IO [GlobPattern]
G.glob (GlobPattern
srcD GlobPattern -> GlobPattern -> GlobPattern
</> GlobPattern
pattern)

-- | Loads a Mustache template given a relative filepath.
loadTemplate :: FilePath -> SiteM Template
loadTemplate :: GlobPattern -> SiteM Template
loadTemplate GlobPattern
filePath = do
  GlobPattern
srcD <- (Settings -> GlobPattern)
-> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Settings -> GlobPattern
srcDir
  Either ParseError Template
mTemplate <- IO (Either ParseError Template)
-> ReaderT
     Settings (WriterT [GlobPattern] IO) (Either ParseError Template)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ParseError Template)
 -> ReaderT
      Settings (WriterT [GlobPattern] IO) (Either ParseError Template))
-> IO (Either ParseError Template)
-> ReaderT
     Settings (WriterT [GlobPattern] IO) (Either ParseError Template)
forall a b. (a -> b) -> a -> b
$ [GlobPattern] -> GlobPattern -> IO (Either ParseError Template)
automaticCompile [GlobPattern
srcD] GlobPattern
filePath
  case Either ParseError Template
mTemplate of
    Left ParseError
err -> SitePipeError -> SiteM Template
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SitePipeError -> SiteM Template)
-> SitePipeError -> SiteM Template
forall a b. (a -> b) -> a -> b
$ ParseError -> SitePipeError
TemplateParseErr ParseError
err
    Right Template
template -> Template -> SiteM Template
forall (m :: * -> *) a. Monad m => a -> m a
return Template
template

-- | Given a path to a mustache template file (relative to your source directory);
-- this writes a list of resources to the output directory by applying each one to the template.
writeTemplate :: (ToJSON a)
                 => FilePath -- ^ Path to template (relative to site dir)
                 -> [a]  -- ^ List of resources to write
                 -> SiteM ()
writeTemplate :: GlobPattern -> [a] -> SiteM ()
writeTemplate GlobPattern
templatePath [a]
resources = do
  Template
template <- GlobPattern -> SiteM Template
loadTemplate GlobPattern
templatePath
  (a -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern)
-> [a] -> SiteM ()
forall a.
ToJSON a =>
(a -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern)
-> [a] -> SiteM ()
writeWith (Template
-> a -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern
forall env.
ToJSON env =>
Template
-> env -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern
renderTemplate Template
template) [a]
resources

-- | Write a list of resources using the given processing function from a resource
-- to a string.
writeWith :: (ToJSON a)
          => (a -> SiteM String) -- ^ A function which renders a resource to a string.
          -> [a] -- ^ List of resources to write
          -> SiteM ()
writeWith :: (a -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern)
-> [a] -> SiteM ()
writeWith a -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern
resourceRenderer [a]
resources =
  (a -> SiteM ()) -> [a] -> SiteM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((a -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern)
-> a -> SiteM ()
forall a.
ToJSON a =>
(a -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern)
-> a -> SiteM ()
writeOneWith a -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern
resourceRenderer) [a]
resources

-- | Write a single resource to file using the given processing function.
writeOneWith :: (ToJSON a) => (a -> SiteM String) -> a -> SiteM ()
writeOneWith :: (a -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern)
-> a -> SiteM ()
writeOneWith a -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern
renderer a
obj = do
  GlobPattern
outD <- (Settings -> GlobPattern)
-> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Settings -> GlobPattern
outputDir
  GlobPattern
renderedContent <- a -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern
renderer a
obj
  let outFile :: GlobPattern
outFile = GlobPattern
outD GlobPattern -> GlobPattern -> GlobPattern
</> (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
obj Value -> Getting GlobPattern Value GlobPattern -> GlobPattern
forall s a. s -> Getting a s a -> a
^. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"url" ((Value -> Const GlobPattern Value)
 -> Value -> Const GlobPattern Value)
-> Getting GlobPattern Value GlobPattern
-> Getting GlobPattern Value GlobPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const GlobPattern Text)
-> Value -> Const GlobPattern Value
forall t. AsPrimitive t => Prism' t Text
_String ((Text -> Const GlobPattern Text)
 -> Value -> Const GlobPattern Value)
-> ((GlobPattern -> Const GlobPattern GlobPattern)
    -> Text -> Const GlobPattern Text)
-> Getting GlobPattern Value GlobPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobPattern -> Const GlobPattern GlobPattern)
-> Text -> Const GlobPattern Text
forall t. IsText t => Iso' t GlobPattern
unpacked ((GlobPattern -> Const GlobPattern GlobPattern)
 -> Text -> Const GlobPattern Text)
-> ((GlobPattern -> Const GlobPattern GlobPattern)
    -> GlobPattern -> Const GlobPattern GlobPattern)
-> (GlobPattern -> Const GlobPattern GlobPattern)
-> Text
-> Const GlobPattern Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobPattern -> GlobPattern)
-> (GlobPattern -> Const GlobPattern GlobPattern)
-> GlobPattern
-> Const GlobPattern GlobPattern
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((Char -> Bool) -> GlobPattern -> GlobPattern
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/')))
  IO () -> SiteM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SiteM ())
-> (GlobPattern -> IO ()) -> GlobPattern -> SiteM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> GlobPattern -> IO ()
createDirectoryIfMissing Bool
True (GlobPattern -> SiteM ()) -> GlobPattern -> SiteM ()
forall a b. (a -> b) -> a -> b
$ GlobPattern -> GlobPattern
takeDirectory GlobPattern
outFile
  IO () -> SiteM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SiteM ())
-> (GlobPattern -> IO ()) -> GlobPattern -> SiteM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobPattern -> IO ()
putStrLn (GlobPattern -> SiteM ()) -> GlobPattern -> SiteM ()
forall a b. (a -> b) -> a -> b
$ GlobPattern
"Writing " GlobPattern -> GlobPattern -> GlobPattern
forall a. [a] -> [a] -> [a]
++ GlobPattern
outFile
  IO () -> SiteM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SiteM ()) -> IO () -> SiteM ()
forall a b. (a -> b) -> a -> b
$ GlobPattern -> GlobPattern -> IO ()
writeFile GlobPattern
outFile GlobPattern
renderedContent

-- | Writes the content of the given resources without using a template.
textWriter :: (ToJSON a)
           => [a] -- ^ List of resources to write
           -> SiteM ()
textWriter :: [a] -> SiteM ()
textWriter [a]
resources =
  (a -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern)
-> [a] -> SiteM ()
forall a.
ToJSON a =>
(a -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern)
-> [a] -> SiteM ()
writeWith (GlobPattern
-> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobPattern
 -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern)
-> (a -> GlobPattern)
-> a
-> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting GlobPattern Value GlobPattern -> Value -> GlobPattern
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"content" ((Value -> Const GlobPattern Value)
 -> Value -> Const GlobPattern Value)
-> Getting GlobPattern Value GlobPattern
-> Getting GlobPattern Value GlobPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const GlobPattern Text)
-> Value -> Const GlobPattern Value
forall t. AsPrimitive t => Prism' t Text
_String ((Text -> Const GlobPattern Text)
 -> Value -> Const GlobPattern Value)
-> ((GlobPattern -> Const GlobPattern GlobPattern)
    -> Text -> Const GlobPattern Text)
-> Getting GlobPattern Value GlobPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobPattern -> Const GlobPattern GlobPattern)
-> Text -> Const GlobPattern Text
forall t. IsText t => Iso' t GlobPattern
unpacked) (Value -> GlobPattern) -> (a -> Value) -> a -> GlobPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON) [a]
resources

-- | Given a list of file or directory globs (see 'srcGlob')
-- we copy matching files and directories as-is from the source directory
-- to the output directory maintaining their relative filepath.
--
-- For convenience this also returns a list of the files copied as
-- 'Value's with  "src" and "url" keys
-- which represent the source path and the url.of the copied file respectively.
copyFiles :: [GlobPattern] -> SiteM [Value]
copyFiles :: [GlobPattern] -> SiteM [Value]
copyFiles = (GlobPattern -> GlobPattern) -> [GlobPattern] -> SiteM [Value]
copyFilesWith GlobPattern -> GlobPattern
forall a. a -> a
id

-- | Runs 'copyFiles' but using a filepath transforming function to determine
-- the output filepath. The filepath transformation accepts and should return
-- a relative path.
--
-- See 'copyFiles' for more information.
copyFilesWith :: (FilePath -> FilePath) -> [GlobPattern] -> SiteM [Value]
copyFilesWith :: (GlobPattern -> GlobPattern) -> [GlobPattern] -> SiteM [Value]
copyFilesWith GlobPattern -> GlobPattern
transformPath [GlobPattern]
patterns = do
  Settings{GlobPattern
Value
globalContext :: Settings -> Value
globalContext :: Value
outputDir :: GlobPattern
srcDir :: GlobPattern
outputDir :: Settings -> GlobPattern
srcDir :: Settings -> GlobPattern
..} <- ReaderT Settings (WriterT [GlobPattern] IO) Settings
forall r (m :: * -> *). MonadReader r m => m r
ask
  [GlobPattern]
srcFilenames <- [[GlobPattern]] -> [GlobPattern]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[GlobPattern]] -> [GlobPattern])
-> ReaderT Settings (WriterT [GlobPattern] IO) [[GlobPattern]]
-> SiteM [GlobPattern]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GlobPattern -> SiteM [GlobPattern])
-> [GlobPattern]
-> ReaderT Settings (WriterT [GlobPattern] IO) [[GlobPattern]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse GlobPattern -> SiteM [GlobPattern]
srcGlob [GlobPattern]
patterns
  let outputPaths :: [GlobPattern]
outputPaths = GlobPattern -> GlobPattern
normalise (GlobPattern -> GlobPattern)
-> (GlobPattern -> GlobPattern) -> GlobPattern -> GlobPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobPattern -> GlobPattern
transformPath (GlobPattern -> GlobPattern)
-> (GlobPattern -> GlobPattern) -> GlobPattern -> GlobPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobPattern -> GlobPattern -> GlobPattern
makeRelative GlobPattern
srcDir (GlobPattern -> GlobPattern) -> [GlobPattern] -> [GlobPattern]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GlobPattern]
srcFilenames
      outputURLs :: [GlobPattern]
outputURLs = (GlobPattern
"/" GlobPattern -> GlobPattern -> GlobPattern
</>) (GlobPattern -> GlobPattern) -> [GlobPattern] -> [GlobPattern]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GlobPattern]
outputPaths
      destFilenames :: [GlobPattern]
destFilenames = (GlobPattern
outputDir GlobPattern -> GlobPattern -> GlobPattern
</>) (GlobPattern -> GlobPattern) -> [GlobPattern] -> [GlobPattern]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GlobPattern]
outputPaths
  Sh () -> SiteM ()
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (Sh () -> SiteM ()) -> Sh () -> SiteM ()
forall a b. (a -> b) -> a -> b
$ do
    let getDir :: GlobPattern -> GlobPattern
getDir GlobPattern
pth = (GlobPattern -> GlobPattern)
-> (GlobPattern -> GlobPattern)
-> Bool
-> GlobPattern
-> GlobPattern
forall a. a -> a -> Bool -> a
bool (GlobPattern -> GlobPattern
takeDirectory) (GlobPattern -> GlobPattern
takeDirectory (GlobPattern -> GlobPattern)
-> (GlobPattern -> GlobPattern) -> GlobPattern -> GlobPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobPattern -> GlobPattern
takeDirectory) (GlobPattern -> GlobPattern -> Bool
forall a. Eq a => [a] -> [a] -> Bool
endswith GlobPattern
"/" GlobPattern
pth) (GlobPattern -> GlobPattern) -> GlobPattern -> GlobPattern
forall a b. (a -> b) -> a -> b
$ GlobPattern
pth
    (GlobPattern -> Sh ()) -> [GlobPattern] -> Sh ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (GlobPattern -> Sh ()
mkdir_p (GlobPattern -> Sh ())
-> (GlobPattern -> GlobPattern) -> GlobPattern -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobPattern -> GlobPattern
forall a. IsString a => GlobPattern -> a
fromString (GlobPattern -> GlobPattern)
-> (GlobPattern -> GlobPattern) -> GlobPattern -> GlobPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobPattern -> GlobPattern
getDir) [GlobPattern]
destFilenames
    ((GlobPattern, GlobPattern) -> Sh ())
-> [(GlobPattern, GlobPattern)] -> Sh ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (GlobPattern, GlobPattern) -> Sh ()
copy ([GlobPattern] -> [GlobPattern] -> [(GlobPattern, GlobPattern)]
forall a b. [a] -> [b] -> [(a, b)]
zip [GlobPattern]
srcFilenames [GlobPattern]
destFilenames)
  [Value] -> SiteM [Value]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Value] -> SiteM [Value])
-> ([(GlobPattern, GlobPattern)] -> [Value])
-> [(GlobPattern, GlobPattern)]
-> SiteM [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GlobPattern, GlobPattern) -> Value)
-> [(GlobPattern, GlobPattern)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GlobPattern -> GlobPattern -> Value)
-> (GlobPattern, GlobPattern) -> Value
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry GlobPattern -> GlobPattern -> Value
forall v v. (ToJSON v, ToJSON v) => v -> v -> Value
mkFileValue) ([(GlobPattern, GlobPattern)] -> SiteM [Value])
-> [(GlobPattern, GlobPattern)] -> SiteM [Value]
forall a b. (a -> b) -> a -> b
$ [GlobPattern] -> [GlobPattern] -> [(GlobPattern, GlobPattern)]
forall a b. [a] -> [b] -> [(a, b)]
zip [GlobPattern]
srcFilenames [GlobPattern]
outputURLs
    where
      copy :: (GlobPattern, GlobPattern) -> Sh ()
copy (GlobPattern
src, GlobPattern
dest) = do
        Text -> Sh ()
echo (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"Copying ",  GlobPattern -> Text
T.pack GlobPattern
src, Text
" to ", GlobPattern -> Text
T.pack GlobPattern
dest]
        GlobPattern -> GlobPattern -> Sh ()
cp_r (GlobPattern -> GlobPattern
forall a. IsString a => GlobPattern -> a
fromString GlobPattern
src) (GlobPattern -> GlobPattern
forall a. IsString a => GlobPattern -> a
fromString GlobPattern
dest)

      mkFileValue :: v -> v -> Value
mkFileValue v
src v
url = [Pair] -> Value
A.object [Text
"src" Text -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= v
src, Text
"url" Text -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
A..= v
url]

-- | Given a resource reader (see "SitePipe.Readers")
-- this function finds all files matching any of the provided list
-- of fileglobs (according to 'srcGlob') and returns a list of loaded resources
-- as Aeson 'Value's.
resourceLoader :: (String -> IO String) -- ^ A reader which processes file contents
               -> [GlobPattern] -- ^ File glob; relative to the @site@ directory
               -> SiteM [Value] -- ^ Returns a list of Aeson objects
resourceLoader :: (GlobPattern -> IO GlobPattern) -> [GlobPattern] -> SiteM [Value]
resourceLoader = (GlobPattern -> IO GlobPattern) -> [GlobPattern] -> SiteM [Value]
forall a.
FromJSON a =>
(GlobPattern -> IO GlobPattern) -> [GlobPattern] -> SiteM [a]
resourceLoaderGen

-- | A more generic version of 'resourceLoader' which returns any type with a
-- 'FromJSON' instance. It also handles and displays any conversion errors.
resourceLoaderGen :: (FromJSON a) => (String -> IO String) -> [GlobPattern] -> SiteM [a]
resourceLoaderGen :: (GlobPattern -> IO GlobPattern) -> [GlobPattern] -> SiteM [a]
resourceLoaderGen GlobPattern -> IO GlobPattern
fileReader [GlobPattern]
patterns = do
  [GlobPattern]
filenames <- [[GlobPattern]] -> [GlobPattern]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[GlobPattern]] -> [GlobPattern])
-> ReaderT Settings (WriterT [GlobPattern] IO) [[GlobPattern]]
-> SiteM [GlobPattern]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GlobPattern -> SiteM [GlobPattern])
-> [GlobPattern]
-> ReaderT Settings (WriterT [GlobPattern] IO) [[GlobPattern]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse GlobPattern -> SiteM [GlobPattern]
srcGlob [GlobPattern]
patterns
  (GlobPattern -> ReaderT Settings (WriterT [GlobPattern] IO) a)
-> [GlobPattern] -> SiteM [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((GlobPattern -> IO GlobPattern)
-> GlobPattern -> ReaderT Settings (WriterT [GlobPattern] IO) a
forall a.
FromJSON a =>
(GlobPattern -> IO GlobPattern) -> GlobPattern -> SiteM a
loadWith GlobPattern -> IO GlobPattern
fileReader) [GlobPattern]
filenames

-- | loads a file from filepath and applies a given filreader.
loadWith :: (FromJSON a) => (String -> IO String) -> FilePath -> SiteM a
loadWith :: (GlobPattern -> IO GlobPattern) -> GlobPattern -> SiteM a
loadWith GlobPattern -> IO GlobPattern
fileReader GlobPattern
filepath = do
  Settings{GlobPattern
srcDir :: GlobPattern
srcDir :: Settings -> GlobPattern
srcDir} <- ReaderT Settings (WriterT [GlobPattern] IO) Settings
forall r (m :: * -> *). MonadReader r m => m r
ask
  let relPath :: GlobPattern
relPath = GlobPattern -> GlobPattern -> GlobPattern
makeRelative GlobPattern
srcDir GlobPattern
filepath
  GlobPattern
file <- IO GlobPattern
-> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GlobPattern
 -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern)
-> IO GlobPattern
-> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern
forall a b. (a -> b) -> a -> b
$ GlobPattern -> IO GlobPattern
readFile GlobPattern
filepath
  (Value
meta, GlobPattern
source) <- GlobPattern
-> GlobPattern
-> ReaderT Settings (WriterT [GlobPattern] IO) (Value, GlobPattern)
forall (m :: * -> *).
MonadThrow m =>
GlobPattern -> GlobPattern -> m (Value, GlobPattern)
processSource GlobPattern
filepath GlobPattern
file
  GlobPattern
content <- IO GlobPattern
-> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GlobPattern
 -> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern)
-> IO GlobPattern
-> ReaderT Settings (WriterT [GlobPattern] IO) GlobPattern
forall a b. (a -> b) -> a -> b
$ GlobPattern -> IO GlobPattern
fileReader GlobPattern
source
  Value -> SiteM a
forall (m :: * -> *) a. (MonadThrow m, FromJSON a) => Value -> m a
valueToResource (GlobPattern -> GlobPattern -> Value -> Value
forall s. AsValue s => GlobPattern -> GlobPattern -> s -> s
addMeta GlobPattern
relPath GlobPattern
content Value
meta)
    where
      addMeta :: GlobPattern -> GlobPattern -> s -> s
addMeta GlobPattern
relPath GlobPattern
content s
meta =
        s
meta
        s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (HashMap Text Value -> Identity (HashMap Text Value))
-> s -> Identity s
forall t. AsValue t => Prism' t (HashMap Text Value)
_Object ((HashMap Text Value -> Identity (HashMap Text Value))
 -> s -> Identity s)
-> ((Maybe Value -> Identity (Maybe Value))
    -> HashMap Text Value -> Identity (HashMap Text Value))
-> (Maybe Value -> Identity (Maybe Value))
-> s
-> Identity s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text Value)
-> Lens'
     (HashMap Text Value) (Maybe (IxValue (HashMap Text Value)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (HashMap Text Value)
"filepath" ((Maybe Value -> Identity (Maybe Value)) -> s -> Identity s)
-> Value -> s -> s
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
String (GlobPattern -> Text
T.pack GlobPattern
relPath)
        s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (HashMap Text Value -> Identity (HashMap Text Value))
-> s -> Identity s
forall t. AsValue t => Prism' t (HashMap Text Value)
_Object ((HashMap Text Value -> Identity (HashMap Text Value))
 -> s -> Identity s)
-> ((Maybe Value -> Identity (Maybe Value))
    -> HashMap Text Value -> Identity (HashMap Text Value))
-> (Maybe Value -> Identity (Maybe Value))
-> s
-> Identity s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text Value)
-> Lens'
     (HashMap Text Value) (Maybe (IxValue (HashMap Text Value)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (HashMap Text Value)
"content" ((Maybe Value -> Identity (Maybe Value)) -> s -> Identity s)
-> Value -> s -> s
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
String (GlobPattern -> Text
T.pack GlobPattern
content)
        s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (HashMap Text Value -> Identity (HashMap Text Value))
-> s -> Identity s
forall t. AsValue t => Prism' t (HashMap Text Value)
_Object ((HashMap Text Value -> Identity (HashMap Text Value))
 -> s -> Identity s)
-> ((Maybe Value -> Identity (Maybe Value))
    -> HashMap Text Value -> Identity (HashMap Text Value))
-> (Maybe Value -> Identity (Maybe Value))
-> s
-> Identity s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text Value)
-> Lens'
     (HashMap Text Value) (Maybe (IxValue (HashMap Text Value)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (HashMap Text Value)
"url" ((Maybe Value -> Identity (Maybe Value)) -> s -> Identity s)
-> Value -> s -> s
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Text -> Value
String (Text -> Value) -> (GlobPattern -> Text) -> GlobPattern -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobPattern -> Text
T.pack (GlobPattern -> Text)
-> (GlobPattern -> GlobPattern) -> GlobPattern -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobPattern -> GlobPattern -> GlobPattern
setExt GlobPattern
"html" (GlobPattern -> Value) -> GlobPattern -> Value
forall a b. (a -> b) -> a -> b
$ (GlobPattern
"/" GlobPattern -> GlobPattern -> GlobPattern
</> GlobPattern
relPath))

-- | Converts a 'Value' to a generic resource implementing 'FromJSON', handling any errors.
valueToResource :: (MonadThrow m, FromJSON a) => Value -> m a
valueToResource :: Value -> m a
valueToResource Value
obj =
  case (Value -> Parser a) -> Value -> Either GlobPattern a
forall a b. (a -> Parser b) -> a -> Either GlobPattern b
parseEither Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj of
    Left GlobPattern
err -> SitePipeError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (GlobPattern -> GlobPattern -> SitePipeError
JSONErr GlobPattern
name GlobPattern
err)
    Right a
result -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
  where
    name :: GlobPattern
name = Value
obj Value -> Getting GlobPattern Value GlobPattern -> GlobPattern
forall s a. s -> Getting a s a -> a
^. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"filepath" ((Value -> Const GlobPattern Value)
 -> Value -> Const GlobPattern Value)
-> Getting GlobPattern Value GlobPattern
-> Getting GlobPattern Value GlobPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const GlobPattern Text)
-> Value -> Const GlobPattern Value
forall t. AsPrimitive t => Prism' t Text
_String ((Text -> Const GlobPattern Text)
 -> Value -> Const GlobPattern Value)
-> ((GlobPattern -> Const GlobPattern GlobPattern)
    -> Text -> Const GlobPattern Text)
-> Getting GlobPattern Value GlobPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobPattern -> Const GlobPattern GlobPattern)
-> Text -> Const GlobPattern Text
forall t. IsText t => Iso' t GlobPattern
unpacked