{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Format
   Copyright   : © 2022-2024 Albert Krewinkel
   License     : GPL-2.0-or-later
   Maintainer  : Albert Krewinkel <albert+pandoc@tarleb.com>

Handling of format specifiers for input and output.
-}
module Text.Pandoc.Format
  ( FlavoredFormat (..)
  , ExtensionsConfig (..)
  , ExtensionsDiff (..)
  , diffExtensions
  , parseFlavoredFormat
  , applyExtensionsDiff
  , getExtensionsConfig
  , formatFromFilePaths
  ) where

import Control.Monad.Except (throwError)
import Data.Char (toLower)
import Data.Foldable (asum)
import qualified Data.List as L
import System.FilePath (splitExtension, takeExtension)
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Error (PandocError (..))
import Text.Pandoc.Extensions
  ( Extension (Ext_literate_haskell)
  , Extensions
  , disableExtensions
  , enableExtension
  , extensionsFromList
  , extensionsToList
  , getAllExtensions
  , getDefaultExtensions
  , showExtension
  , readExtension
  )
import Network.URI (URI (..), parseURI)
import Text.Pandoc.Parsing
import qualified Data.Text as T

-- | Format specifier with the format's name and the lists of extensions
-- to be enabled or disabled.
data FlavoredFormat = FlavoredFormat
  { FlavoredFormat -> Text
formatName     :: T.Text
  , FlavoredFormat -> ExtensionsDiff
formatExtsDiff :: ExtensionsDiff
  } deriving (Int -> FlavoredFormat -> ShowS
[FlavoredFormat] -> ShowS
FlavoredFormat -> [Char]
(Int -> FlavoredFormat -> ShowS)
-> (FlavoredFormat -> [Char])
-> ([FlavoredFormat] -> ShowS)
-> Show FlavoredFormat
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FlavoredFormat -> ShowS
showsPrec :: Int -> FlavoredFormat -> ShowS
$cshow :: FlavoredFormat -> [Char]
show :: FlavoredFormat -> [Char]
$cshowList :: [FlavoredFormat] -> ShowS
showList :: [FlavoredFormat] -> ShowS
Show)

-- | Changes to a set of extensions, i.e., list of extensions to be
-- enabled or disabled.
data ExtensionsDiff = ExtensionsDiff
  { ExtensionsDiff -> Extensions
extsToEnable  :: Extensions
  , ExtensionsDiff -> Extensions
extsToDisable :: Extensions
  } deriving (Int -> ExtensionsDiff -> ShowS
[ExtensionsDiff] -> ShowS
ExtensionsDiff -> [Char]
(Int -> ExtensionsDiff -> ShowS)
-> (ExtensionsDiff -> [Char])
-> ([ExtensionsDiff] -> ShowS)
-> Show ExtensionsDiff
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtensionsDiff -> ShowS
showsPrec :: Int -> ExtensionsDiff -> ShowS
$cshow :: ExtensionsDiff -> [Char]
show :: ExtensionsDiff -> [Char]
$cshowList :: [ExtensionsDiff] -> ShowS
showList :: [ExtensionsDiff] -> ShowS
Show)

instance Semigroup ExtensionsDiff where
  ExtensionsDiff Extensions
enA Extensions
disA <> :: ExtensionsDiff -> ExtensionsDiff -> ExtensionsDiff
<> ExtensionsDiff Extensions
enB Extensions
disB =
    Extensions -> Extensions -> ExtensionsDiff
ExtensionsDiff
    ((Extensions
enA Extensions -> Extensions -> Extensions
`disableExtensions` Extensions
disB) Extensions -> Extensions -> Extensions
forall a. Semigroup a => a -> a -> a
<> Extensions
enB)
    ((Extensions
disA Extensions -> Extensions -> Extensions
`disableExtensions` Extensions
enB) Extensions -> Extensions -> Extensions
forall a. Semigroup a => a -> a -> a
<> Extensions
disB)

instance Monoid ExtensionsDiff where
  mempty :: ExtensionsDiff
mempty = Extensions -> Extensions -> ExtensionsDiff
ExtensionsDiff Extensions
forall a. Monoid a => a
mempty Extensions
forall a. Monoid a => a
mempty
  mappend :: ExtensionsDiff -> ExtensionsDiff -> ExtensionsDiff
mappend = ExtensionsDiff -> ExtensionsDiff -> ExtensionsDiff
forall a. Semigroup a => a -> a -> a
(<>)

-- | Calculate the change set to get from one set of extensions to
-- another.
diffExtensions :: Extensions -> Extensions -> ExtensionsDiff
diffExtensions :: Extensions -> Extensions -> ExtensionsDiff
diffExtensions Extensions
def Extensions
actual = ExtensionsDiff
  { extsToEnable :: Extensions
extsToEnable = Extensions
actual Extensions -> Extensions -> Extensions
`disableExtensions` Extensions
def
  , extsToDisable :: Extensions
extsToDisable = Extensions
def Extensions -> Extensions -> Extensions
`disableExtensions` Extensions
actual
  }

-- | Describes the properties of a format.
data ExtensionsConfig = ExtensionsConfig
  { ExtensionsConfig -> Extensions
extsDefault   :: Extensions -- ^ Extensions enabled by default
  , ExtensionsConfig -> Extensions
extsSupported :: Extensions -- ^ Extensions that can be enabled or disabled.
  } deriving (Int -> ExtensionsConfig -> ShowS
[ExtensionsConfig] -> ShowS
ExtensionsConfig -> [Char]
(Int -> ExtensionsConfig -> ShowS)
-> (ExtensionsConfig -> [Char])
-> ([ExtensionsConfig] -> ShowS)
-> Show ExtensionsConfig
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtensionsConfig -> ShowS
showsPrec :: Int -> ExtensionsConfig -> ShowS
$cshow :: ExtensionsConfig -> [Char]
show :: ExtensionsConfig -> [Char]
$cshowList :: [ExtensionsConfig] -> ShowS
showList :: [ExtensionsConfig] -> ShowS
Show)

-- | Returns the extensions configuration of a format.
getExtensionsConfig :: T.Text -> ExtensionsConfig
getExtensionsConfig :: Text -> ExtensionsConfig
getExtensionsConfig Text
fmt = ExtensionsConfig
  { extsDefault :: Extensions
extsDefault = Text -> Extensions
getDefaultExtensions Text
fmt
  , extsSupported :: Extensions
extsSupported = Text -> Extensions
getAllExtensions Text
fmt
  }

instance Semigroup ExtensionsConfig where
  ExtensionsConfig Extensions
x1 Extensions
y1 <> :: ExtensionsConfig -> ExtensionsConfig -> ExtensionsConfig
<> ExtensionsConfig Extensions
x2 Extensions
y2 =
    Extensions -> Extensions -> ExtensionsConfig
ExtensionsConfig (Extensions
x1 Extensions -> Extensions -> Extensions
forall a. Semigroup a => a -> a -> a
<> Extensions
x2) (Extensions
y1 Extensions -> Extensions -> Extensions
forall a. Semigroup a => a -> a -> a
<> Extensions
y2)

instance Monoid ExtensionsConfig where
  mappend :: ExtensionsConfig -> ExtensionsConfig -> ExtensionsConfig
mappend = ExtensionsConfig -> ExtensionsConfig -> ExtensionsConfig
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: ExtensionsConfig
mempty = Extensions -> Extensions -> ExtensionsConfig
ExtensionsConfig Extensions
forall a. Monoid a => a
mempty Extensions
forall a. Monoid a => a
mempty

-- | Apply the extension changes in the format spec to the extensions
-- given in the format's extensions configuration. Throws an error in
-- case of an unknown or unsupported extension.
applyExtensionsDiff :: PandocMonad m
                    => ExtensionsConfig
                    -> FlavoredFormat
                    -> m Extensions
applyExtensionsDiff :: forall (m :: * -> *).
PandocMonad m =>
ExtensionsConfig -> FlavoredFormat -> m Extensions
applyExtensionsDiff ExtensionsConfig
extConf (FlavoredFormat Text
fname ExtensionsDiff
extsDiff) = do
  let extsInDiff :: Extensions
extsInDiff  = ExtensionsDiff -> Extensions
extsToEnable ExtensionsDiff
extsDiff Extensions -> Extensions -> Extensions
forall a. Semigroup a => a -> a -> a
<> ExtensionsDiff -> Extensions
extsToDisable ExtensionsDiff
extsDiff
  let unsupported :: Extensions
unsupported = Extensions
extsInDiff Extensions -> Extensions -> Extensions
`disableExtensions` (ExtensionsConfig -> Extensions
extsSupported ExtensionsConfig
extConf)
  case Extensions -> [Extension]
extensionsToList Extensions
unsupported of
    Extension
ext:[Extension]
_ -> PandocError -> m Extensions
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m Extensions) -> PandocError -> m Extensions
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocUnsupportedExtensionError
             (Extension -> Text
showExtension Extension
ext) Text
fname
    []    -> Extensions -> m Extensions
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ExtensionsConfig -> Extensions
extsDefault ExtensionsConfig
extConf Extensions -> Extensions -> Extensions
`disableExtensions`
                    ExtensionsDiff -> Extensions
extsToDisable ExtensionsDiff
extsDiff) Extensions -> Extensions -> Extensions
forall a. Semigroup a => a -> a -> a
<> ExtensionsDiff -> Extensions
extsToEnable ExtensionsDiff
extsDiff)

-- | Parse a format-specifying string into a markup format and the
-- change set to the format's extensions. Throws an error if the spec
-- cannot be parsed or contains an unknown extension.
parseFlavoredFormat :: PandocMonad m
                    => T.Text
                    -> m FlavoredFormat
parseFlavoredFormat :: forall (m :: * -> *). PandocMonad m => Text -> m FlavoredFormat
parseFlavoredFormat Text
spec =
  -- Paths like `latex-foo-bar.lua` or `latex-smart-citations.lua`
  -- should be parsed as the format name. The `-` (or `+`) in the
  -- filename would confuse the extensions parser, so, if `spec` looks
  -- like a filename, the file's basename is split off into the prefix.
  -- Only the remaining part is parsed, and the prefix is appended back
  -- to the format after parsing.
  case Parsec Text () (Text, ExtensionsDiff)
-> [Char] -> Text -> Either ParseError (Text, ExtensionsDiff)
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse (ParsecT Text () Identity ()
forall {s} {u}. ParsecT s u Identity ()
fixSourcePos ParsecT Text () Identity ()
-> Parsec Text () (Text, ExtensionsDiff)
-> Parsec Text () (Text, ExtensionsDiff)
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Text () (Text, ExtensionsDiff)
forall {u}. ParsecT Text u Identity (Text, ExtensionsDiff)
formatSpec) [Char]
"" Text
spec' of
    Right (Text
fname, ExtensionsDiff
extsDiff) -> FlavoredFormat -> m FlavoredFormat
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ExtensionsDiff -> FlavoredFormat
FlavoredFormat (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname) ExtensionsDiff
extsDiff)
    Left ParseError
err -> PandocError -> m FlavoredFormat
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m FlavoredFormat)
-> PandocError -> m FlavoredFormat
forall a b. (a -> b) -> a -> b
$ Text -> Text -> PandocError
PandocFormatError Text
spec ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> [Char]
forall a. Show a => a -> [Char]
show ParseError
err)
  where
    fixSourcePos :: ParsecT s u Identity ()
fixSourcePos = do
      pos <- ParsecT s u Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
      setPosition (incSourceColumn pos (T.length prefix))
    formatSpec :: ParsecT Text u Identity (Text, ExtensionsDiff)
formatSpec = do
      name <- ParsecT Text u Identity [Char]
forall {u}. ParsecT Text u Identity [Char]
parseFormatName
      extsDiff <- pExtensionsDiff
      return ( T.pack name, extsDiff )
    parseFormatName :: ParsecT Text u Identity [Char]
parseFormatName = ParsecT Text u Identity Char -> ParsecT Text u Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text u Identity Char -> ParsecT Text u Identity [Char])
-> ParsecT Text u Identity Char -> ParsecT Text u Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text u Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"-+"
    (Text
prefix, Text
spec') = case [Char] -> ([Char], [Char])
splitExtension (Text -> [Char]
T.unpack Text
spec) of
                        ([Char]
_, [Char]
"") -> (Text
"", Text -> Text
T.toLower Text
spec) -- no extension
                        ([Char]
p,[Char]
s)   -> ([Char] -> Text
T.pack [Char]
p, [Char] -> Text
T.pack [Char]
s)

pExtensionsDiff :: (UpdateSourcePos s Char, Stream s m Char)
                => ParsecT s u m ExtensionsDiff
pExtensionsDiff :: forall s (m :: * -> *) u.
(UpdateSourcePos s Char, Stream s m Char) =>
ParsecT s u m ExtensionsDiff
pExtensionsDiff = (ExtensionsDiff
 -> (ExtensionsDiff -> ExtensionsDiff) -> ExtensionsDiff)
-> ExtensionsDiff
-> [ExtensionsDiff -> ExtensionsDiff]
-> ExtensionsDiff
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (((ExtensionsDiff -> ExtensionsDiff)
 -> ExtensionsDiff -> ExtensionsDiff)
-> ExtensionsDiff
-> (ExtensionsDiff -> ExtensionsDiff)
-> ExtensionsDiff
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ExtensionsDiff -> ExtensionsDiff)
-> ExtensionsDiff -> ExtensionsDiff
forall a b. (a -> b) -> a -> b
($)) ExtensionsDiff
forall a. Monoid a => a
mempty ([ExtensionsDiff -> ExtensionsDiff] -> ExtensionsDiff)
-> ParsecT s u m [ExtensionsDiff -> ExtensionsDiff]
-> ParsecT s u m ExtensionsDiff
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m (ExtensionsDiff -> ExtensionsDiff)
-> ParsecT s u m [ExtensionsDiff -> ExtensionsDiff]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s u m (ExtensionsDiff -> ExtensionsDiff)
forall {u}. ParsecT s u m (ExtensionsDiff -> ExtensionsDiff)
extMod
  where
    extMod :: ParsecT s u m (ExtensionsDiff -> ExtensionsDiff)
extMod = do
      polarity <- [Char] -> ParsecT s u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"-+"
      name <- many $ noneOf "-+"
      let ext = [Char] -> Extension
readExtension [Char]
name
      return $ \ExtensionsDiff
extsDiff ->
        case Char
polarity of
          Char
'+' -> ExtensionsDiff
extsDiff{extsToEnable  = enableExtension ext $
                                          extsToEnable extsDiff}
          Char
_   -> ExtensionsDiff
extsDiff{extsToDisable = enableExtension ext $
                                          extsToDisable extsDiff}

-- | Determines default format based on file extensions; uses the format
-- of the first extension that's associated with a format.
--
-- Examples:
--
-- > formatFromFilePaths ["text.unknown", "no-extension"]
-- Nothing
--
-- > formatFromFilePaths ["my.md", "other.rst"]
-- Just "markdown"
formatFromFilePaths :: [FilePath] -> (Maybe FlavoredFormat)
formatFromFilePaths :: [[Char]] -> Maybe FlavoredFormat
formatFromFilePaths = [Maybe FlavoredFormat] -> Maybe FlavoredFormat
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe FlavoredFormat] -> Maybe FlavoredFormat)
-> ([[Char]] -> [Maybe FlavoredFormat])
-> [[Char]]
-> Maybe FlavoredFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Maybe FlavoredFormat)
-> [[Char]] -> [Maybe FlavoredFormat]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Maybe FlavoredFormat
formatFromFilePath

-- | Determines format based on file extension.
formatFromFilePath :: FilePath -> Maybe FlavoredFormat
formatFromFilePath :: [Char] -> Maybe FlavoredFormat
formatFromFilePath [Char]
x =
  case ShowS
takeExtension ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
fpath) of
    [Char]
".Rmd"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    [Char]
".adoc"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"asciidoc"
    [Char]
".asciidoc" -> Text -> Maybe FlavoredFormat
defFlavor Text
"asciidoc"
    [Char]
".bib"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"biblatex"
    [Char]
".context"  -> Text -> Maybe FlavoredFormat
defFlavor Text
"context"
    [Char]
".csv"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"csv"
    [Char]
".ctx"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"context"
    [Char]
".db"       -> Text -> Maybe FlavoredFormat
defFlavor Text
"docbook"
    [Char]
".dj"       -> Text -> Maybe FlavoredFormat
defFlavor Text
"djot"
    [Char]
".djvu"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"djvu" -- so we get an "unknown reader" error
    [Char]
".doc"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"doc"  -- so we get an "unknown reader" error
    [Char]
".docx"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"docx"
    [Char]
".dokuwiki" -> Text -> Maybe FlavoredFormat
defFlavor Text
"dokuwiki"
    [Char]
".epub"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"epub"
    [Char]
".fb2"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"fb2"
    [Char]
".htm"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"html"
    [Char]
".html"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"html"
    [Char]
".icml"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"icml"
    [Char]
".ipynb"    -> Text -> Maybe FlavoredFormat
defFlavor Text
"ipynb"
    [Char]
".json"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"json"
    [Char]
".latex"    -> Text -> Maybe FlavoredFormat
defFlavor Text
"latex"
    [Char]
".lhs"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown" Maybe FlavoredFormat -> Extension -> Maybe FlavoredFormat
`withExtension` Extension
Ext_literate_haskell
    [Char]
".ltx"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"latex"
    [Char]
".markdown" -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    [Char]
".markua"   -> Text -> Maybe FlavoredFormat
defFlavor Text
"markua"
    [Char]
".md"       -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    [Char]
".mdown"    -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    [Char]
".mdwn"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    [Char]
".mkd"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    [Char]
".mkdn"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    [Char]
".ms"       -> Text -> Maybe FlavoredFormat
defFlavor Text
"ms"
    [Char]
".muse"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"muse"
    [Char]
".native"   -> Text -> Maybe FlavoredFormat
defFlavor Text
"native"
    [Char]
".ods"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"ods"  -- so we get an "unknown reader" error
    [Char]
".odp"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"odp"  -- so we get an "unknown reader" error
    [Char]
".odf"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"odf"  -- so we get an "unknown reader" error
    [Char]
".odt"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"odt"
    [Char]
".opml"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"opml"
    [Char]
".org"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"org"
    [Char]
".pdf"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"pdf"  -- so we get an "unknown reader" error
    [Char]
".pl"       -> Text -> Maybe FlavoredFormat
defFlavor Text
"pod"
    [Char]
".pm"       -> Text -> Maybe FlavoredFormat
defFlavor Text
"pod"
    [Char]
".pod"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"pod"
    [Char]
".pptx"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"pptx"
    [Char]
".ris"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"ris"
    [Char]
".roff"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"ms"
    [Char]
".rst"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"rst"
    [Char]
".rtf"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"rtf"
    [Char]
".s5"       -> Text -> Maybe FlavoredFormat
defFlavor Text
"s5"
    [Char]
".t2t"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"t2t"
    [Char]
".tei"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"tei"
    [Char]
".tex"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"latex"
    [Char]
".texi"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"texinfo"
    [Char]
".texinfo"  -> Text -> Maybe FlavoredFormat
defFlavor Text
"texinfo"
    [Char]
".text"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    [Char]
".textile"  -> Text -> Maybe FlavoredFormat
defFlavor Text
"textile"
    [Char]
".tsv"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"tsv"
    [Char]
".txt"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    [Char]
".typ"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"typst"
    [Char]
".wiki"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"mediawiki"
    [Char]
".xhtml"    -> Text -> Maybe FlavoredFormat
defFlavor Text
"html"
    [Char]
".xls"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"xls"   -- so we get an "unknown reader" error
    [Char]
".xlsx"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"xlsx"  -- so we get an "unknown reader" error
    [Char]
".xml"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"xml"
    [Char]
".zip"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"zip"  -- so we get an "unknown reader" error
    [Char
'.',Char
y]     | Char
y Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'1'..Char
'9'] -> Text -> Maybe FlavoredFormat
defFlavor Text
"man"
    [Char]
_           -> Maybe FlavoredFormat
forall a. Maybe a
Nothing
 where
  defFlavor :: Text -> Maybe FlavoredFormat
defFlavor Text
f = FlavoredFormat -> Maybe FlavoredFormat
forall a. a -> Maybe a
Just (Text -> ExtensionsDiff -> FlavoredFormat
FlavoredFormat Text
f ExtensionsDiff
forall a. Monoid a => a
mempty)
  withExtension :: Maybe FlavoredFormat -> Extension -> Maybe FlavoredFormat
withExtension Maybe FlavoredFormat
Nothing Extension
_ = Maybe FlavoredFormat
forall a. Maybe a
Nothing
  withExtension (Just (FlavoredFormat Text
f ExtensionsDiff
ed)) Extension
ext = FlavoredFormat -> Maybe FlavoredFormat
forall a. a -> Maybe a
Just (FlavoredFormat -> Maybe FlavoredFormat)
-> FlavoredFormat -> Maybe FlavoredFormat
forall a b. (a -> b) -> a -> b
$
    Text -> ExtensionsDiff -> FlavoredFormat
FlavoredFormat Text
f (ExtensionsDiff
ed ExtensionsDiff -> ExtensionsDiff -> ExtensionsDiff
forall a. Semigroup a => a -> a -> a
<> Extensions -> Extensions -> ExtensionsDiff
ExtensionsDiff ([Extension] -> Extensions
extensionsFromList [Extension
ext]) Extensions
forall a. Monoid a => a
mempty)
  fpath :: [Char]
fpath = case [Char] -> Maybe URI
parseURI [Char]
x of
            Maybe URI
Nothing -> [Char]
x
            Just URI{ uriPath :: URI -> [Char]
uriPath = [Char]
"" } -> [Char]
"index.html"
            Just URI{ uriPath :: URI -> [Char]
uriPath = [Char]
"/" } -> [Char]
"index.html"
            Just URI{ uriPath :: URI -> [Char]
uriPath = [Char]
up } -> [Char]
up