{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE UndecidableInstances #-}
module Ema.Route.Lib.Extra.PandocRoute (
PandocRoute (..),
mkPandocRoute,
Model (..),
Arg (..),
lookupPandocRoute,
PandocHtml (..),
PandocError (..),
) where
import Control.Exception (throw, throwIO)
import Control.Monad.Logger (
MonadLogger,
MonadLoggerIO,
logInfoNS,
)
import Data.Default (Default (..))
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.SOP (I (I), NP (..))
import Data.Set qualified as Set
import Ema
import Ema.CLI qualified
import Ema.Route.Generic.TH
import Ema.Route.Lib.Extra.SlugRoute
import Generics.SOP qualified as SOP
import System.FilePath ((</>))
import System.UnionMount qualified as UnionMount
import Text.Pandoc (Pandoc, ReaderOptions, runIO)
import Text.Pandoc qualified as Pandoc
import Text.Pandoc.Sources (ToSources)
import UnliftIO (MonadUnliftIO)
newtype PandocRoute = PandocRoute {PandocRoute -> SlugRoute Pandoc
unPandocRoute :: SlugRoute Pandoc}
deriving stock (PandocRoute -> PandocRoute -> Bool
(PandocRoute -> PandocRoute -> Bool)
-> (PandocRoute -> PandocRoute -> Bool) -> Eq PandocRoute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PandocRoute -> PandocRoute -> Bool
$c/= :: PandocRoute -> PandocRoute -> Bool
== :: PandocRoute -> PandocRoute -> Bool
$c== :: PandocRoute -> PandocRoute -> Bool
Eq, Eq PandocRoute
Eq PandocRoute
-> (PandocRoute -> PandocRoute -> Ordering)
-> (PandocRoute -> PandocRoute -> Bool)
-> (PandocRoute -> PandocRoute -> Bool)
-> (PandocRoute -> PandocRoute -> Bool)
-> (PandocRoute -> PandocRoute -> Bool)
-> (PandocRoute -> PandocRoute -> PandocRoute)
-> (PandocRoute -> PandocRoute -> PandocRoute)
-> Ord PandocRoute
PandocRoute -> PandocRoute -> Bool
PandocRoute -> PandocRoute -> Ordering
PandocRoute -> PandocRoute -> PandocRoute
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PandocRoute -> PandocRoute -> PandocRoute
$cmin :: PandocRoute -> PandocRoute -> PandocRoute
max :: PandocRoute -> PandocRoute -> PandocRoute
$cmax :: PandocRoute -> PandocRoute -> PandocRoute
>= :: PandocRoute -> PandocRoute -> Bool
$c>= :: PandocRoute -> PandocRoute -> Bool
> :: PandocRoute -> PandocRoute -> Bool
$c> :: PandocRoute -> PandocRoute -> Bool
<= :: PandocRoute -> PandocRoute -> Bool
$c<= :: PandocRoute -> PandocRoute -> Bool
< :: PandocRoute -> PandocRoute -> Bool
$c< :: PandocRoute -> PandocRoute -> Bool
compare :: PandocRoute -> PandocRoute -> Ordering
$ccompare :: PandocRoute -> PandocRoute -> Ordering
$cp1Ord :: Eq PandocRoute
Ord, Int -> PandocRoute -> ShowS
[PandocRoute] -> ShowS
PandocRoute -> String
(Int -> PandocRoute -> ShowS)
-> (PandocRoute -> String)
-> ([PandocRoute] -> ShowS)
-> Show PandocRoute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PandocRoute] -> ShowS
$cshowList :: [PandocRoute] -> ShowS
show :: PandocRoute -> String
$cshow :: PandocRoute -> String
showsPrec :: Int -> PandocRoute -> ShowS
$cshowsPrec :: Int -> PandocRoute -> ShowS
Show, (forall x. PandocRoute -> Rep PandocRoute x)
-> (forall x. Rep PandocRoute x -> PandocRoute)
-> Generic PandocRoute
forall x. Rep PandocRoute x -> PandocRoute
forall x. PandocRoute -> Rep PandocRoute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PandocRoute x -> PandocRoute
$cfrom :: forall x. PandocRoute -> Rep PandocRoute x
Generic)
deriving anyclass (All @[Type] (SListI @Type) (Code PandocRoute)
All @[Type] (SListI @Type) (Code PandocRoute)
-> (PandocRoute -> Rep PandocRoute)
-> (Rep PandocRoute -> PandocRoute)
-> Generic PandocRoute
Rep PandocRoute -> PandocRoute
PandocRoute -> Rep PandocRoute
forall a.
All @[Type] (SListI @Type) (Code a)
-> (a -> Rep a) -> (Rep a -> a) -> Generic a
to :: Rep PandocRoute -> PandocRoute
$cto :: Rep PandocRoute -> PandocRoute
from :: PandocRoute -> Rep PandocRoute
$cfrom :: PandocRoute -> Rep PandocRoute
$cp1Generic :: All @[Type] (SListI @Type) (Code PandocRoute)
SOP.Generic, Generic PandocRoute
Generic PandocRoute
-> (forall (proxy :: Type -> Type).
proxy PandocRoute -> DatatypeInfo (Code PandocRoute))
-> HasDatatypeInfo PandocRoute
forall a.
Generic a
-> (forall (proxy :: Type -> Type).
proxy a -> DatatypeInfo (Code a))
-> HasDatatypeInfo a
forall (proxy :: Type -> Type).
proxy PandocRoute -> DatatypeInfo (Code PandocRoute)
datatypeInfo :: proxy PandocRoute -> DatatypeInfo (Code PandocRoute)
$cdatatypeInfo :: forall (proxy :: Type -> Type).
proxy PandocRoute -> DatatypeInfo (Code PandocRoute)
$cp1HasDatatypeInfo :: Generic PandocRoute
SOP.HasDatatypeInfo)
deriving
(HasSubRoutes @Type PandocRoute
forall {k} (r :: k). HasSubRoutes @k r
HasSubRoutes, RouteModel PandocRoute -> [PandocRoute]
RouteModel PandocRoute -> Prism_ String PandocRoute
(RouteModel PandocRoute -> Prism_ String PandocRoute)
-> (RouteModel PandocRoute -> [PandocRoute]) -> IsRoute PandocRoute
forall r.
(RouteModel r -> Prism_ String r)
-> (RouteModel r -> [r]) -> IsRoute r
routeUniverse :: RouteModel PandocRoute -> [PandocRoute]
$crouteUniverse :: RouteModel PandocRoute -> [PandocRoute]
routePrism :: RouteModel PandocRoute -> Prism_ String PandocRoute
$croutePrism :: RouteModel PandocRoute -> Prism_ String PandocRoute
IsRoute)
via ( GenericRoute
PandocRoute
'[ WithModel Model
, WithSubRoutes
'[ SlugRoute Pandoc
]
]
)
instance HasSubModels PandocRoute where
subModels :: RouteModel PandocRoute
-> NP @Type I (MultiModel (SubRoutes @Type PandocRoute))
subModels RouteModel PandocRoute
m = Map (SlugRoute Pandoc) Pandoc -> I (Map (SlugRoute Pandoc) Pandoc)
forall a. a -> I a
I ((PandocRoute -> SlugRoute Pandoc)
-> Map PandocRoute Pandoc -> Map (SlugRoute Pandoc) Pandoc
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys PandocRoute -> SlugRoute Pandoc
unPandocRoute (Map PandocRoute Pandoc -> Map (SlugRoute Pandoc) Pandoc)
-> Map PandocRoute Pandoc -> Map (SlugRoute Pandoc) Pandoc
forall a b. (a -> b) -> a -> b
$ Model -> Map PandocRoute Pandoc
modelPandocs RouteModel PandocRoute
Model
m) I (Map (SlugRoute Pandoc) Pandoc)
-> NP @Type I ('[] @Type)
-> NP
@Type I ((':) @Type (Map (SlugRoute Pandoc) Pandoc) ('[] @Type))
forall {k} (a :: k -> Type) (x :: k) (xs :: [k]).
a x -> NP @k a xs -> NP @k a ((':) @k x xs)
:* NP @Type I ('[] @Type)
forall {k} (a :: k -> Type). NP @k a ('[] @k)
Nil
instance IsString PandocRoute where
fromString :: String -> PandocRoute
fromString String
fp = PandocRoute
-> ((String, PandocRoute) -> PandocRoute)
-> Maybe (String, PandocRoute)
-> PandocRoute
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> PandocRoute
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> PandocRoute) -> Text -> PandocRoute
forall a b. (a -> b) -> a -> b
$ Text
"Bad path: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
fp) (String, PandocRoute) -> PandocRoute
forall a b. (a, b) -> b
snd (Maybe (String, PandocRoute) -> PandocRoute)
-> Maybe (String, PandocRoute) -> PandocRoute
forall a b. (a -> b) -> a -> b
$ String -> Maybe (String, PandocRoute)
mkPandocRoute String
fp
mkPandocRoute :: FilePath -> Maybe (String, PandocRoute)
mkPandocRoute :: String -> Maybe (String, PandocRoute)
mkPandocRoute String
fp = do
(String
ext, SlugRoute Pandoc
r) <- String -> Maybe (String, SlugRoute Pandoc)
forall a. String -> Maybe (String, SlugRoute a)
mkSlugRoute String
fp
(String, PandocRoute) -> Maybe (String, PandocRoute)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (String
ext, SlugRoute Pandoc -> PandocRoute
PandocRoute SlugRoute Pandoc
r)
data Model = Model
{ Model -> Arg
modelArg :: Arg
, Model -> Map PandocRoute Pandoc
modelPandocs :: Map PandocRoute Pandoc
}
deriving stock ((forall x. Model -> Rep Model x)
-> (forall x. Rep Model x -> Model) -> Generic Model
forall x. Rep Model x -> Model
forall x. Model -> Rep Model x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Model x -> Model
$cfrom :: forall x. Model -> Rep Model x
Generic)
lookupPandocRoute :: Model -> PandocRoute -> Maybe (Pandoc, Pandoc -> PandocHtml)
lookupPandocRoute :: Model -> PandocRoute -> Maybe (Pandoc, Pandoc -> PandocHtml)
lookupPandocRoute Model
model PandocRoute
r = do
Pandoc
pandoc <- PandocRoute -> Map PandocRoute Pandoc -> Maybe Pandoc
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PandocRoute
r (Map PandocRoute Pandoc -> Maybe Pandoc)
-> Map PandocRoute Pandoc -> Maybe Pandoc
forall a b. (a -> b) -> a -> b
$ Model -> Map PandocRoute Pandoc
modelPandocs Model
model
let render :: Pandoc -> PandocHtml
render = Text -> PandocHtml
PandocHtml (Text -> PandocHtml) -> (Pandoc -> Text) -> Pandoc -> PandocHtml
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => WriterOptions -> Pandoc -> Text
WriterOptions -> Pandoc -> Text
renderHtml (Arg -> WriterOptions
argWriterOpts (Arg -> WriterOptions) -> Arg -> WriterOptions
forall a b. (a -> b) -> a -> b
$ Model -> Arg
modelArg Model
model)
(Pandoc, Pandoc -> PandocHtml)
-> Maybe (Pandoc, Pandoc -> PandocHtml)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Pandoc
pandoc, Pandoc -> PandocHtml
render)
where
renderHtml :: HasCallStack => Pandoc.WriterOptions -> Pandoc -> Text
renderHtml :: WriterOptions -> Pandoc -> Text
renderHtml WriterOptions
writerSettings Pandoc
pandoc =
(PandocError -> Text)
-> (Text -> Text) -> Either PandocError Text -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (PandocError -> Text
forall a e. Exception e => e -> a
throw (PandocError -> Text)
-> (PandocError -> PandocError) -> PandocError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PandocError
PandocError_RenderError (Text -> PandocError)
-> (PandocError -> Text) -> PandocError -> PandocError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocError -> Text
forall b a. (Show a, IsString b) => a -> b
show) Text -> Text
forall a. a -> a
id (Either PandocError Text -> Text)
-> Either PandocError Text -> Text
forall a b. (a -> b) -> a -> b
$
PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
Pandoc.runPure (PandocPure Text -> Either PandocError Text)
-> PandocPure Text -> Either PandocError Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Pandoc -> PandocPure Text
forall (m :: Type -> Type).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
Pandoc.writeHtml5String WriterOptions
writerSettings Pandoc
pandoc
data Arg = Arg
{
Arg -> String
argBaseDir :: FilePath
,
Arg -> Set String
argFormats :: Set String
, Arg -> ReaderOptions
argReaderOpts :: Pandoc.ReaderOptions
, Arg -> WriterOptions
argWriterOpts :: Pandoc.WriterOptions
}
deriving stock ((forall x. Arg -> Rep Arg x)
-> (forall x. Rep Arg x -> Arg) -> Generic Arg
forall x. Rep Arg x -> Arg
forall x. Arg -> Rep Arg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Arg x -> Arg
$cfrom :: forall x. Arg -> Rep Arg x
Generic)
instance Default Arg where
def :: Arg
def = String -> Set String -> ReaderOptions -> WriterOptions -> Arg
Arg String
"." Set String
formats ReaderOptions
defaultReaderOpts WriterOptions
defaultWriterOpts
where
formats :: Set String
formats = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String]
knownPandocFormats
defaultReaderOpts :: ReaderOptions
defaultReaderOpts = ReaderOptions
forall a. Default a => a
def {readerExtensions :: Extensions
Pandoc.readerExtensions = Extensions
exts}
defaultWriterOpts :: WriterOptions
defaultWriterOpts = WriterOptions
forall a. Default a => a
def {writerExtensions :: Extensions
Pandoc.writerExtensions = Extensions
exts}
exts :: Pandoc.Extensions
exts :: Extensions
exts =
Extensions
Pandoc.pandocExtensions Extensions -> Extensions -> Extensions
forall a. Semigroup a => a -> a -> a
<> [Extension] -> Extensions
Pandoc.extensionsFromList [Extension
Pandoc.Ext_attributes]
instance EmaSite PandocRoute where
type SiteArg PandocRoute = Arg
type SiteOutput PandocRoute = (Pandoc, Pandoc -> PandocHtml)
siteInput :: Some @Type Action
-> SiteArg PandocRoute -> m (Dynamic m (RouteModel PandocRoute))
siteInput Some @Type Action
_ SiteArg PandocRoute
arg = do
(Map PandocRoute Pandoc -> Model)
-> Dynamic m (Map PandocRoute Pandoc) -> Dynamic m Model
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Arg -> Map PandocRoute Pandoc -> Model
Model SiteArg PandocRoute
Arg
arg) (Dynamic m (Map PandocRoute Pandoc) -> Dynamic m Model)
-> m (Dynamic m (Map PandocRoute Pandoc)) -> m (Dynamic m Model)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> Set String
-> ReaderOptions
-> m (Dynamic m (Map PandocRoute Pandoc))
forall (m :: Type -> Type).
(MonadIO m, MonadUnliftIO m, MonadLogger m, MonadLoggerIO m) =>
String
-> Set String
-> ReaderOptions
-> m (Dynamic m (Map PandocRoute Pandoc))
pandocFilesDyn (Arg -> String
argBaseDir SiteArg PandocRoute
Arg
arg) (Arg -> Set String
argFormats SiteArg PandocRoute
Arg
arg) (Arg -> ReaderOptions
argReaderOpts SiteArg PandocRoute
Arg
arg)
siteOutput :: Prism' String PandocRoute
-> RouteModel PandocRoute
-> PandocRoute
-> m (SiteOutput PandocRoute)
siteOutput Prism' String PandocRoute
_rp RouteModel PandocRoute
model PandocRoute
r = do
m (Pandoc, Pandoc -> PandocHtml)
-> ((Pandoc, Pandoc -> PandocHtml)
-> m (Pandoc, Pandoc -> PandocHtml))
-> Maybe (Pandoc, Pandoc -> PandocHtml)
-> m (Pandoc, Pandoc -> PandocHtml)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO (Pandoc, Pandoc -> PandocHtml)
-> m (Pandoc, Pandoc -> PandocHtml)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Pandoc, Pandoc -> PandocHtml)
-> m (Pandoc, Pandoc -> PandocHtml))
-> IO (Pandoc, Pandoc -> PandocHtml)
-> m (Pandoc, Pandoc -> PandocHtml)
forall a b. (a -> b) -> a -> b
$ PandocError -> IO (Pandoc, Pandoc -> PandocHtml)
forall e a. Exception e => e -> IO a
throwIO (PandocError -> IO (Pandoc, Pandoc -> PandocHtml))
-> PandocError -> IO (Pandoc, Pandoc -> PandocHtml)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocError_Missing (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ PandocRoute -> Text
forall b a. (Show a, IsString b) => a -> b
show PandocRoute
r) (Pandoc, Pandoc -> PandocHtml) -> m (Pandoc, Pandoc -> PandocHtml)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe (Pandoc, Pandoc -> PandocHtml)
-> m (Pandoc, Pandoc -> PandocHtml))
-> Maybe (Pandoc, Pandoc -> PandocHtml)
-> m (Pandoc, Pandoc -> PandocHtml)
forall a b. (a -> b) -> a -> b
$ Model -> PandocRoute -> Maybe (Pandoc, Pandoc -> PandocHtml)
lookupPandocRoute RouteModel PandocRoute
Model
model PandocRoute
r
pandocFilesDyn ::
forall m.
(MonadIO m, MonadUnliftIO m, MonadLogger m, MonadLoggerIO m) =>
FilePath ->
Set String ->
ReaderOptions ->
m (Dynamic m (Map PandocRoute Pandoc))
pandocFilesDyn :: String
-> Set String
-> ReaderOptions
-> m (Dynamic m (Map PandocRoute Pandoc))
pandocFilesDyn String
baseDir Set String
formats ReaderOptions
readerOpts = do
let pats :: [((), String)]
pats =
Set String -> [String]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList Set String
formats [String] -> (String -> ((), String)) -> [((), String)]
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \String
ext ->
((), String
"**/*" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
ext)
ignorePats :: [String]
ignorePats = [String
".*"]
model0 :: Map PandocRoute Pandoc
model0 = Map PandocRoute Pandoc
forall a. Monoid a => a
mempty
(Map PandocRoute Pandoc, (Map PandocRoute Pandoc -> m ()) -> m ())
-> Dynamic m (Map PandocRoute Pandoc)
forall (m :: Type -> Type) a.
(a, (a -> m ()) -> m ()) -> Dynamic m a
Dynamic ((Map PandocRoute Pandoc, (Map PandocRoute Pandoc -> m ()) -> m ())
-> Dynamic m (Map PandocRoute Pandoc))
-> m (Map PandocRoute Pandoc,
(Map PandocRoute Pandoc -> m ()) -> m ())
-> m (Dynamic m (Map PandocRoute Pandoc))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> [((), String)]
-> [String]
-> Map PandocRoute Pandoc
-> (()
-> String
-> FileAction ()
-> m (Map PandocRoute Pandoc -> Map PandocRoute Pandoc))
-> m (Map PandocRoute Pandoc,
(Map PandocRoute Pandoc -> m ()) -> m ())
forall model (m :: Type -> Type) b.
(MonadIO m, MonadUnliftIO m, MonadLogger m, Show b, Ord b) =>
String
-> [(b, String)]
-> [String]
-> model
-> (b -> String -> FileAction () -> m (model -> model))
-> m (model, (model -> m ()) -> m ())
UnionMount.mount String
baseDir [((), String)]
pats [String]
ignorePats Map PandocRoute Pandoc
model0 ((String
-> FileAction ()
-> m (Map PandocRoute Pandoc -> Map PandocRoute Pandoc))
-> ()
-> String
-> FileAction ()
-> m (Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
forall a b. a -> b -> a
const String
-> FileAction ()
-> m (Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
(MonadIO m, MonadLogger m, MonadLoggerIO m) =>
String
-> FileAction ()
-> m (Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
handleUpdate)
where
handleUpdate ::
(MonadIO m, MonadLogger m, MonadLoggerIO m) =>
FilePath ->
UnionMount.FileAction () ->
m (Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
handleUpdate :: String
-> FileAction ()
-> m (Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
handleUpdate String
fp = \case
UnionMount.Refresh RefreshAction
_ ()
_ -> do
Maybe (PandocRoute, Pandoc)
mData <- String -> m (Maybe (PandocRoute, Pandoc))
(MonadIO m, MonadLogger m, MonadLoggerIO m) =>
String -> m (Maybe (PandocRoute, Pandoc))
readSource String
fp
(Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
-> m (Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
-> m (Map PandocRoute Pandoc -> Map PandocRoute Pandoc))
-> (Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
-> m (Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
forall a b. (a -> b) -> a -> b
$ (Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
-> ((PandocRoute, Pandoc)
-> Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
-> Maybe (PandocRoute, Pandoc)
-> Map PandocRoute Pandoc
-> Map PandocRoute Pandoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map PandocRoute Pandoc -> Map PandocRoute Pandoc
forall a. a -> a
id ((PandocRoute
-> Pandoc -> Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
-> (PandocRoute, Pandoc)
-> Map PandocRoute Pandoc
-> Map PandocRoute Pandoc
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PandocRoute
-> Pandoc -> Map PandocRoute Pandoc -> Map PandocRoute Pandoc
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert) Maybe (PandocRoute, Pandoc)
mData
FileAction ()
UnionMount.Delete ->
(Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
-> m (Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
-> m (Map PandocRoute Pandoc -> Map PandocRoute Pandoc))
-> (Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
-> m (Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
forall a b. (a -> b) -> a -> b
$ (Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
-> ((String, PandocRoute)
-> Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
-> Maybe (String, PandocRoute)
-> Map PandocRoute Pandoc
-> Map PandocRoute Pandoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map PandocRoute Pandoc -> Map PandocRoute Pandoc
forall a. a -> a
id (PandocRoute -> Map PandocRoute Pandoc -> Map PandocRoute Pandoc
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (PandocRoute -> Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
-> ((String, PandocRoute) -> PandocRoute)
-> (String, PandocRoute)
-> Map PandocRoute Pandoc
-> Map PandocRoute Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, PandocRoute) -> PandocRoute
forall a b. (a, b) -> b
snd) (Maybe (String, PandocRoute)
-> Map PandocRoute Pandoc -> Map PandocRoute Pandoc)
-> Maybe (String, PandocRoute)
-> Map PandocRoute Pandoc
-> Map PandocRoute Pandoc
forall a b. (a -> b) -> a -> b
$ String -> Maybe (String, PandocRoute)
mkPandocRoute String
fp
readSource :: (MonadIO m, MonadLogger m, MonadLoggerIO m) => FilePath -> m (Maybe (PandocRoute, Pandoc))
readSource :: String -> m (Maybe (PandocRoute, Pandoc))
readSource String
fp = MaybeT m (PandocRoute, Pandoc) -> m (Maybe (PandocRoute, Pandoc))
forall (m :: Type -> Type) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m (PandocRoute, Pandoc) -> m (Maybe (PandocRoute, Pandoc)))
-> MaybeT m (PandocRoute, Pandoc)
-> m (Maybe (PandocRoute, Pandoc))
forall a b. (a -> b) -> a -> b
$ do
(String
ext, PandocRoute
r :: PandocRoute) <- Maybe (String, PandocRoute) -> MaybeT m (String, PandocRoute)
forall (m :: Type -> Type) a.
Applicative m =>
Maybe a -> MaybeT m a
hoistMaybe (String -> Maybe (String, PandocRoute)
mkPandocRoute String
fp)
Bool -> MaybeT m ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Bool -> MaybeT m ()) -> Bool -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ String
ext String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
formats
Text -> MaybeT m ()
forall (m :: Type -> Type). MonadLogger m => Text -> m ()
log (Text -> MaybeT m ()) -> Text -> MaybeT m ()
forall a b. (a -> b) -> a -> b
$ Text
"Reading " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
fp
Text
s :: Text <- (ByteString -> Text) -> MaybeT m ByteString -> MaybeT m Text
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (MaybeT m ByteString -> MaybeT m Text)
-> MaybeT m ByteString -> MaybeT m Text
forall a b. (a -> b) -> a -> b
$ String -> MaybeT m ByteString
forall (m :: Type -> Type). MonadIO m => String -> m ByteString
readFileBS (String -> MaybeT m ByteString) -> String -> MaybeT m ByteString
forall a b. (a -> b) -> a -> b
$ String
baseDir String -> ShowS
</> String
fp
IO (Either PandocError Pandoc)
-> MaybeT m (Either PandocError Pandoc)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (PandocIO Pandoc -> IO (Either PandocError Pandoc)
forall a. PandocIO a -> IO (Either PandocError a)
runIO (PandocIO Pandoc -> IO (Either PandocError Pandoc))
-> PandocIO Pandoc -> IO (Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ ReaderOptions -> String -> Text -> PandocIO Pandoc
forall (m :: Type -> Type) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> String -> a -> m Pandoc
readPandocSource ReaderOptions
readerOpts String
ext Text
s) MaybeT m (Either PandocError Pandoc)
-> (Either PandocError Pandoc -> MaybeT m (PandocRoute, Pandoc))
-> MaybeT m (PandocRoute, Pandoc)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left PandocError
err -> Text -> Text -> MaybeT m (PandocRoute, Pandoc)
forall (m :: Type -> Type) a.
(MonadLoggerIO m, MonadFail m) =>
Text -> Text -> m a
Ema.CLI.crash Text
"PandocRoute" (Text -> MaybeT m (PandocRoute, Pandoc))
-> Text -> MaybeT m (PandocRoute, Pandoc)
forall a b. (a -> b) -> a -> b
$ PandocError -> Text
forall b a. (Show a, IsString b) => a -> b
show PandocError
err
Right Pandoc
doc -> do
(PandocRoute, Pandoc) -> MaybeT m (PandocRoute, Pandoc)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (PandocRoute
r, Pandoc
doc)
log :: MonadLogger m => Text -> m ()
log :: Text -> m ()
log = Text -> Text -> m ()
forall (m :: Type -> Type). MonadLogger m => Text -> Text -> m ()
logInfoNS Text
"PandocRoute"
data PandocError
= PandocError_Missing Text
| PandocError_RenderError Text
deriving stock (PandocError -> PandocError -> Bool
(PandocError -> PandocError -> Bool)
-> (PandocError -> PandocError -> Bool) -> Eq PandocError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PandocError -> PandocError -> Bool
$c/= :: PandocError -> PandocError -> Bool
== :: PandocError -> PandocError -> Bool
$c== :: PandocError -> PandocError -> Bool
Eq, Int -> PandocError -> ShowS
[PandocError] -> ShowS
PandocError -> String
(Int -> PandocError -> ShowS)
-> (PandocError -> String)
-> ([PandocError] -> ShowS)
-> Show PandocError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PandocError] -> ShowS
$cshowList :: [PandocError] -> ShowS
show :: PandocError -> String
$cshow :: PandocError -> String
showsPrec :: Int -> PandocError -> ShowS
$cshowsPrec :: Int -> PandocError -> ShowS
Show)
deriving anyclass (Show PandocError
Typeable @Type PandocError
Typeable @Type PandocError
-> Show PandocError
-> (PandocError -> SomeException)
-> (SomeException -> Maybe PandocError)
-> (PandocError -> String)
-> Exception PandocError
SomeException -> Maybe PandocError
PandocError -> String
PandocError -> SomeException
forall e.
Typeable @Type e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: PandocError -> String
$cdisplayException :: PandocError -> String
fromException :: SomeException -> Maybe PandocError
$cfromException :: SomeException -> Maybe PandocError
toException :: PandocError -> SomeException
$ctoException :: PandocError -> SomeException
$cp2Exception :: Show PandocError
$cp1Exception :: Typeable @Type PandocError
Exception)
newtype PandocHtml = PandocHtml {PandocHtml -> Text
unPandocHtml :: Text}
deriving stock (PandocHtml -> PandocHtml -> Bool
(PandocHtml -> PandocHtml -> Bool)
-> (PandocHtml -> PandocHtml -> Bool) -> Eq PandocHtml
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PandocHtml -> PandocHtml -> Bool
$c/= :: PandocHtml -> PandocHtml -> Bool
== :: PandocHtml -> PandocHtml -> Bool
$c== :: PandocHtml -> PandocHtml -> Bool
Eq, (forall x. PandocHtml -> Rep PandocHtml x)
-> (forall x. Rep PandocHtml x -> PandocHtml) -> Generic PandocHtml
forall x. Rep PandocHtml x -> PandocHtml
forall x. PandocHtml -> Rep PandocHtml x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PandocHtml x -> PandocHtml
$cfrom :: forall x. PandocHtml -> Rep PandocHtml x
Generic)
knownPandocFormats :: [String]
knownPandocFormats :: [String]
knownPandocFormats = [String
".md", String
".org"]
formatFromExt :: String -> Text
formatFromExt :: String -> Text
formatFromExt = \case
String
".md" -> Text
"markdown"
String
".org" -> Text
"org"
String
ext -> UnsupportedPandocFormat -> Text
forall a e. Exception e => e -> a
throw (UnsupportedPandocFormat -> Text)
-> UnsupportedPandocFormat -> Text
forall a b. (a -> b) -> a -> b
$ String -> UnsupportedPandocFormat
UnsupportedPandocFormat String
ext
readPandocSource ::
forall m a.
(Pandoc.PandocMonad m, ToSources a) =>
ReaderOptions ->
[Char] ->
a ->
m Pandoc
readPandocSource :: ReaderOptions -> String -> a -> m Pandoc
readPandocSource ReaderOptions
readerOpts String
ext a
s =
case Text -> [(Text, Reader m)] -> Maybe (Reader m)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup (String -> Text
formatFromExt String
ext) [(Text, Reader m)]
forall (m :: Type -> Type). PandocMonad m => [(Text, Reader m)]
Pandoc.readers of
Just (Pandoc.TextReader forall a. ToSources a => ReaderOptions -> a -> m Pandoc
f) -> ReaderOptions -> a -> m Pandoc
forall a. ToSources a => ReaderOptions -> a -> m Pandoc
f ReaderOptions
readerOpts a
s
Maybe (Reader m)
_ -> UnsupportedPandocFormat -> m Pandoc
forall a e. Exception e => e -> a
throw (UnsupportedPandocFormat -> m Pandoc)
-> UnsupportedPandocFormat -> m Pandoc
forall a b. (a -> b) -> a -> b
$ String -> UnsupportedPandocFormat
UnsupportedPandocFormat String
ext
data UnsupportedPandocFormat = UnsupportedPandocFormat String
deriving stock (UnsupportedPandocFormat -> UnsupportedPandocFormat -> Bool
(UnsupportedPandocFormat -> UnsupportedPandocFormat -> Bool)
-> (UnsupportedPandocFormat -> UnsupportedPandocFormat -> Bool)
-> Eq UnsupportedPandocFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnsupportedPandocFormat -> UnsupportedPandocFormat -> Bool
$c/= :: UnsupportedPandocFormat -> UnsupportedPandocFormat -> Bool
== :: UnsupportedPandocFormat -> UnsupportedPandocFormat -> Bool
$c== :: UnsupportedPandocFormat -> UnsupportedPandocFormat -> Bool
Eq, Int -> UnsupportedPandocFormat -> ShowS
[UnsupportedPandocFormat] -> ShowS
UnsupportedPandocFormat -> String
(Int -> UnsupportedPandocFormat -> ShowS)
-> (UnsupportedPandocFormat -> String)
-> ([UnsupportedPandocFormat] -> ShowS)
-> Show UnsupportedPandocFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnsupportedPandocFormat] -> ShowS
$cshowList :: [UnsupportedPandocFormat] -> ShowS
show :: UnsupportedPandocFormat -> String
$cshow :: UnsupportedPandocFormat -> String
showsPrec :: Int -> UnsupportedPandocFormat -> ShowS
$cshowsPrec :: Int -> UnsupportedPandocFormat -> ShowS
Show)
deriving anyclass (Show UnsupportedPandocFormat
Typeable @Type UnsupportedPandocFormat
Typeable @Type UnsupportedPandocFormat
-> Show UnsupportedPandocFormat
-> (UnsupportedPandocFormat -> SomeException)
-> (SomeException -> Maybe UnsupportedPandocFormat)
-> (UnsupportedPandocFormat -> String)
-> Exception UnsupportedPandocFormat
SomeException -> Maybe UnsupportedPandocFormat
UnsupportedPandocFormat -> String
UnsupportedPandocFormat -> SomeException
forall e.
Typeable @Type e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: UnsupportedPandocFormat -> String
$cdisplayException :: UnsupportedPandocFormat -> String
fromException :: SomeException -> Maybe UnsupportedPandocFormat
$cfromException :: SomeException -> Maybe UnsupportedPandocFormat
toException :: UnsupportedPandocFormat -> SomeException
$ctoException :: UnsupportedPandocFormat -> SomeException
$cp2Exception :: Show UnsupportedPandocFormat
$cp1Exception :: Typeable @Type UnsupportedPandocFormat
Exception)