{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.Org.Shared
   Copyright   : Copyright (C) 2014-2023 Albert Krewinkel
   License     : GNU GPL, version 2 or above

   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

Utility functions used in other Pandoc Org modules.
-}
module Text.Pandoc.Readers.Org.Shared
  ( cleanLinkText
  , isImageFilename
  , originalLang
  , translateLang
  , exportsCode
  ) where

import Control.Applicative ((<|>))
import Data.Char (isAlphaNum)
import Data.Text (Text)
import qualified Data.Text as T
import System.FilePath (isValid, takeExtension)
import qualified System.FilePath.Posix as Posix
import qualified System.FilePath.Windows as Windows

-- | Check whether the given string looks like the path to of URL of an image.
isImageFilename :: Text -> Bool
isImageFilename :: Text -> Bool
isImageFilename Text
fp = Bool
hasImageExtension Bool -> Bool -> Bool
&& (FilePath -> Bool
isValid (Text -> FilePath
T.unpack Text
fp) Bool -> Bool -> Bool
|| Bool
isKnownProtocolUri)
 where
   hasImageExtension :: Bool
hasImageExtension = FilePath -> FilePath
takeExtension (Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower Text
fp)
                       FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
imageExtensions
   isKnownProtocolUri :: Bool
isKnownProtocolUri = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Text
x -> (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"://") Text -> Text -> Bool
`T.isPrefixOf` Text
fp) [Text]
protocols

   imageExtensions :: [FilePath]
imageExtensions = [ FilePath
".jpeg", FilePath
".jpg", FilePath
".png", FilePath
".gif", FilePath
".svg", FilePath
".webp", FilePath
".jxl" ]
   protocols :: [Text]
protocols = [ Text
"file", Text
"http", Text
"https" ]

-- | Cleanup and canonicalize a string describing a link.  Return @Nothing@ if
-- the string does not appear to be a link.
cleanLinkText :: Text -> Maybe Text
cleanLinkText :: Text -> Maybe Text
cleanLinkText Text
s
  | Just Text
f <- Text -> Maybe Text
toFileSchema Text
s           = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
f                -- absolute path
  | Just Text
_ <- Text -> Text -> Maybe Text
T.stripPrefix Text
"./" Text
s     = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s                -- relative path
  | Just Text
_ <- Text -> Text -> Maybe Text
T.stripPrefix Text
"../" Text
s    = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s                -- relative path
  -- Relative path or URL (file schema)
  | Just Text
s' <- Text -> Text -> Maybe Text
T.stripPrefix Text
"file:" Text
s = if Text
"//" Text -> Text -> Bool
`T.isPrefixOf` Text
s'
                                         then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
                                         else  Text -> Maybe Text
toFileSchema Text
s' Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s'
  | Text -> Bool
isUrl Text
s                            = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
  | Bool
otherwise                          = Maybe Text
forall a. Maybe a
Nothing
  where
    toFileSchema :: Text -> Maybe Text
    toFileSchema :: Text -> Maybe Text
toFileSchema Text
t
      | FilePath -> Bool
Windows.isAbsolute (Text -> FilePath
T.unpack Text
t) = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"file:///" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)
      | FilePath -> Bool
Posix.isAbsolute (Text -> FilePath
T.unpack Text
t)   = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"file://" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)
      | Bool
otherwise                       = Maybe Text
forall a. Maybe a
Nothing
    isUrl :: Text -> Bool
    isUrl :: Text -> Bool
isUrl Text
cs =
      let (Text
scheme, Text
path) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
cs
      in (Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Text
".-") Text
scheme
         Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
path)

-- | Creates an key-value pair marking the original language name specified for
-- a piece of source code.

-- | Creates an key-value attributes marking the original language name
-- specified for a piece of source code.
originalLang :: Text -> [(Text, Text)]
originalLang :: Text -> [(Text, Text)]
originalLang Text
lang =
  let transLang :: Text
transLang = Text -> Text
translateLang Text
lang
  in [(Text
"org-language", Text
lang) | Text
transLang Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
lang]

-- | Translate from Org-mode's programming language identifiers to those used
-- by Pandoc.  This is useful to allow for proper syntax highlighting in
-- Pandoc output.
translateLang :: Text -> Text
translateLang :: Text -> Text
translateLang Text
cs =
  case Text
cs of
    Text
"C"          -> Text
"c"
    Text
"C++"        -> Text
"cpp"
    Text
"emacs-lisp" -> Text
"commonlisp" -- emacs lisp is not supported
    Text
"js"         -> Text
"javascript"
    Text
"lisp"       -> Text
"commonlisp"
    Text
"R"          -> Text
"r"
    Text
"sh"         -> Text
"bash"
    Text
"sqlite"     -> Text
"sql"
    Text
_            -> Text
cs

exportsCode :: [(Text, Text)] -> Bool
exportsCode :: [(Text, Text)] -> Bool
exportsCode = Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"code", Text
"both"]) (Maybe Text -> Bool)
-> ([(Text, Text)] -> Maybe Text) -> [(Text, Text)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"exports"