{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Format
   Copyright   : © 2022-2024 Albert Krewinkel
   License     : GPL-2.0-or-later
   Maintainer  : Albert Krewinkel <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 Data.List (foldl')
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 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 -> String
(Int -> FlavoredFormat -> ShowS)
-> (FlavoredFormat -> String)
-> ([FlavoredFormat] -> ShowS)
-> Show FlavoredFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FlavoredFormat -> ShowS
showsPrec :: Int -> FlavoredFormat -> ShowS
$cshow :: FlavoredFormat -> String
show :: FlavoredFormat -> String
$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 -> String
(Int -> ExtensionsDiff -> ShowS)
-> (ExtensionsDiff -> String)
-> ([ExtensionsDiff] -> ShowS)
-> Show ExtensionsDiff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtensionsDiff -> ShowS
showsPrec :: Int -> ExtensionsDiff -> ShowS
$cshow :: ExtensionsDiff -> String
show :: ExtensionsDiff -> String
$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 -> String
(Int -> ExtensionsConfig -> ShowS)
-> (ExtensionsConfig -> String)
-> ([ExtensionsConfig] -> ShowS)
-> Show ExtensionsConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtensionsConfig -> ShowS
showsPrec :: Int -> ExtensionsConfig -> ShowS
$cshow :: ExtensionsConfig -> String
show :: ExtensionsConfig -> String
$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)
-> String -> Text -> Either ParseError (Text, ExtensionsDiff)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> 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) String
"" 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 (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err)
  where
    fixSourcePos :: ParsecT s u Identity ()
fixSourcePos = do
      SourcePos
pos <- ParsecT s u Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
      SourcePos -> ParsecT s u Identity ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (SourcePos -> Int -> SourcePos
incSourceColumn SourcePos
pos (Text -> Int
T.length Text
prefix))
    formatSpec :: ParsecT Text u Identity (Text, ExtensionsDiff)
formatSpec = do
      String
name <- ParsecT Text u Identity String
forall {u}. ParsecT Text u Identity String
parseFormatName
      ExtensionsDiff
extsDiff <- ParsecT Text u Identity ExtensionsDiff
forall s (m :: * -> *) u.
(UpdateSourcePos s Char, Stream s m Char) =>
ParsecT s u m ExtensionsDiff
pExtensionsDiff
      (Text, ExtensionsDiff)
-> ParsecT Text u Identity (Text, ExtensionsDiff)
forall a. a -> ParsecT Text u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ( String -> Text
T.pack String
name, ExtensionsDiff
extsDiff )
    parseFormatName :: ParsecT Text u Identity String
parseFormatName = ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text u Identity Char -> ParsecT Text u Identity String)
-> ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text u Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m Char
noneOf String
"-+"
    (Text
prefix, Text
spec') = case String -> (String, String)
splitExtension (Text -> String
T.unpack Text
spec) of
                        (String
_, String
"") -> (Text
"", Text -> Text
T.toLower Text
spec) -- no extension
                        (String
p,String
s)   -> (String -> Text
T.pack String
p, String -> Text
T.pack String
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
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
      Char
polarity <- String -> ParsecT s u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m Char
oneOf String
"-+"
      String
name <- ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s u m Char -> ParsecT s u m String)
-> ParsecT s u m Char -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT s u m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m Char
noneOf String
"-+"
      let ext :: Extension
ext = String -> Extension
readExtension String
name
      (ExtensionsDiff -> ExtensionsDiff)
-> ParsecT s u m (ExtensionsDiff -> ExtensionsDiff)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ExtensionsDiff -> ExtensionsDiff)
 -> ParsecT s u m (ExtensionsDiff -> ExtensionsDiff))
-> (ExtensionsDiff -> ExtensionsDiff)
-> ParsecT s u m (ExtensionsDiff -> ExtensionsDiff)
forall a b. (a -> b) -> a -> b
$ \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 :: [String] -> 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)
-> ([String] -> [Maybe FlavoredFormat])
-> [String]
-> Maybe FlavoredFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe FlavoredFormat)
-> [String] -> [Maybe FlavoredFormat]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe FlavoredFormat
formatFromFilePath

-- | Determines format based on file extension.
formatFromFilePath :: FilePath -> Maybe FlavoredFormat
formatFromFilePath :: String -> Maybe FlavoredFormat
formatFromFilePath String
x =
  case ShowS
takeExtension ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x) of
    String
".Rmd"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    String
".adoc"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"asciidoc"
    String
".asciidoc" -> Text -> Maybe FlavoredFormat
defFlavor Text
"asciidoc"
    String
".bib"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"biblatex"
    String
".context"  -> Text -> Maybe FlavoredFormat
defFlavor Text
"context"
    String
".csv"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"csv"
    String
".ctx"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"context"
    String
".db"       -> Text -> Maybe FlavoredFormat
defFlavor Text
"docbook"
    String
".dj"       -> Text -> Maybe FlavoredFormat
defFlavor Text
"djot"
    String
".doc"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"doc"  -- so we get an "unknown reader" error
    String
".docx"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"docx"
    String
".dokuwiki" -> Text -> Maybe FlavoredFormat
defFlavor Text
"dokuwiki"
    String
".epub"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"epub"
    String
".fb2"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"fb2"
    String
".htm"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"html"
    String
".html"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"html"
    String
".icml"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"icml"
    String
".ipynb"    -> Text -> Maybe FlavoredFormat
defFlavor Text
"ipynb"
    String
".json"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"json"
    String
".latex"    -> Text -> Maybe FlavoredFormat
defFlavor Text
"latex"
    String
".lhs"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown" Maybe FlavoredFormat -> Extension -> Maybe FlavoredFormat
`withExtension` Extension
Ext_literate_haskell
    String
".ltx"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"latex"
    String
".markdown" -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    String
".markua"   -> Text -> Maybe FlavoredFormat
defFlavor Text
"markua"
    String
".md"       -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    String
".mdown"    -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    String
".mdwn"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    String
".mkd"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    String
".mkdn"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    String
".ms"       -> Text -> Maybe FlavoredFormat
defFlavor Text
"ms"
    String
".muse"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"muse"
    String
".native"   -> Text -> Maybe FlavoredFormat
defFlavor Text
"native"
    String
".odt"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"odt"
    String
".opml"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"opml"
    String
".org"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"org"
    String
".pdf"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"pdf"  -- so we get an "unknown reader" error
    String
".pptx"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"pptx"
    String
".ris"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"ris"
    String
".roff"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"ms"
    String
".rst"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"rst"
    String
".rtf"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"rtf"
    String
".s5"       -> Text -> Maybe FlavoredFormat
defFlavor Text
"s5"
    String
".t2t"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"t2t"
    String
".tei"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"tei"
    String
".tex"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"latex"
    String
".texi"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"texinfo"
    String
".texinfo"  -> Text -> Maybe FlavoredFormat
defFlavor Text
"texinfo"
    String
".text"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    String
".textile"  -> Text -> Maybe FlavoredFormat
defFlavor Text
"textile"
    String
".tsv"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"tsv"
    String
".typ"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"typst"
    String
".txt"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"markdown"
    String
".typ"      -> Text -> Maybe FlavoredFormat
defFlavor Text
"typst"
    String
".wiki"     -> Text -> Maybe FlavoredFormat
defFlavor Text
"mediawiki"
    String
".xhtml"    -> Text -> Maybe FlavoredFormat
defFlavor Text
"html"
    [Char
'.',Char
y]     | Char
y Char -> String -> 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"
    String
_           -> 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)