{-# language ViewPatterns #-}
{-# language RankNTypes #-}
{-# language RecordWildCards #-}
{-# language NamedFieldPuns #-}
{-# language OverloadedStrings #-}
module SitePipe.Files
(
resourceLoader
, writeWith
, writeTemplate
, textWriter
, 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
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)
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
writeTemplate :: (ToJSON a)
=> FilePath
-> [a]
-> 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
writeWith :: (ToJSON a)
=> (a -> SiteM String)
-> [a]
-> 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
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
textWriter :: (ToJSON a)
=> [a]
-> 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
copyFiles :: [GlobPattern] -> SiteM [Value]
copyFiles :: [GlobPattern] -> SiteM [Value]
copyFiles = (GlobPattern -> GlobPattern) -> [GlobPattern] -> SiteM [Value]
copyFilesWith GlobPattern -> GlobPattern
forall a. a -> a
id
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]
resourceLoader :: (String -> IO String)
-> [GlobPattern]
-> SiteM [Value]
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
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
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))
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