{-# LANGUAGE TemplateHaskell #-}
module Shakebook.Data where
import Control.Comonad.Env as E
import Control.Lens hiding ((:<))
import Data.Aeson as A
import Data.Aeson.Lens
import Data.Aeson.With
import Development.Shake.Plus
import Path.Extensions
import RIO hiding (Lens', lens, view)
import qualified RIO.Text as T
import Shakebook.Pandoc
import Text.Pandoc
newtype PathDisplay a t = PathDisplay (Path a t)
instance Display (PathDisplay a t) where
display (PathDisplay f) = displayBytesUtf8 . fromString . toFilePath $ f
newtype WithinDisplay a t = WithinDisplay (Within a t)
instance Display (WithinDisplay a (Path b t)) where
display (WithinDisplay (WithinT (EnvT e (Identity a)))) = display (PathDisplay e) <> "[" <> display (PathDisplay a) <> "]"
instance Display [WithinDisplay a (Path b t)] where
display [] = ""
display (x : xs) = display x <> " : " <> display xs
viewContent :: Value -> Text
viewContent = view (key "content" . _String)
withContent :: Text -> Value -> Value
withContent = withStringField "content"
viewSrcPath :: Value -> Text
viewSrcPath = view (key "src-path" . _String)
withSrcPath :: Text -> Value -> Value
withSrcPath = withStringField "src-path"
viewBaseUrl :: Value -> Text
viewBaseUrl = view (key "base-url" . _String)
withBaseUrl :: Text -> Value -> Value
withBaseUrl = withStringField "base-url"
viewFullUrl :: Value -> Text
viewFullUrl = view (key "full-url" . _String)
withFullUrl :: Text -> Value -> Value
withFullUrl = withStringField "full-url"
viewImage :: Value -> Text
viewImage = view (key "image" . _String)
viewUrl :: Value -> Text
viewUrl = view (key "url" . _String)
withUrl :: Text -> Value -> Value
withUrl = withStringField "url"
toGroundedUrl :: Path Rel File -> Text
toGroundedUrl = T.pack . toFilePath . ($(mkAbsDir "/") </>)
generateSupposedUrl :: MonadThrow m => Path Rel File -> m Text
generateSupposedUrl srcPath = toGroundedUrl <$> withHtmlExtension srcPath
loadMarkdownAsJSON :: (MonadAction m, MonadThrow m)
=> ReaderOptions
-> WriterOptions
-> Within Rel (Path Rel File)
-> m Value
loadMarkdownAsJSON ropts wopts srcPath = do
pdoc@(Pandoc meta _) <- readMDFileWithin ropts srcPath
meta' <- flattenMeta (writeHtml5String wopts) meta
outText <- runPandocA $ writeHtml5String wopts pdoc
supposedUrl <- generateSupposedUrl (extract srcPath)
return $ withContent outText
. withSrcPath (T.pack . toFilePath $ extract srcPath)
. withUrl supposedUrl $ meta'