    {-# LANGUAGE OverloadedStrings #-}
    {- |
       Module      : Text.Pandoc.Readers.Org.Shared
       Copyright   : Copyright (C) 2014-2020 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 Data.Char (isAlphaNum)
    import Data.Text (Text)
    import qualified Data.Text as T
    import System.FilePath (isValid, takeExtension)
    import Text.Pandoc.Shared (elemText)

    -- | Check whether the given string looks like the path to of URL of an image.
    isImageFilename :: Text -> Bool
    isImageFilename :: Text -> Bool
    isImageFilename fp :: 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
    fp) FilePath -> [FilePath] -> 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 (\x :: Text
    x -> (Text
    x Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> "://") Text -> Text -> Bool
    `T.isPrefixOf` Text
    fp) [Text]
    protocols

       imageExtensions :: [FilePath]
    imageExtensions = [ ".jpeg", ".jpg", ".png", ".gif", ".svg" ]
       protocols :: [Text]
    protocols = [ "file", "http", "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 s :: Text
    s
      | Just _ <- Text -> Text -> Maybe Text
    T.stripPrefix "/" Text
    s      = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ "file://" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    s -- absolute path
      | Just _ <- Text -> Text -> Maybe Text
    T.stripPrefix "./" Text
    s     = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    s                -- relative path
      | Just _ <- Text -> Text -> Maybe Text
    T.stripPrefix "../" Text
    s    = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    s                -- relative path
      -- Relative path or URL (file schema)
      | Just s' :: Text
    s' <- Text -> Text -> Maybe Text
    T.stripPrefix "file:" Text
    s = Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ if "//" Text -> Text -> Bool
    `T.isPrefixOf` Text
    s' then Text
    s else Text
    s'
      | Bool
    otherwise                          = if Text -> Bool
    isUrl Text
    s then Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    s else Maybe Text
    forall a. Maybe a
    Nothing
      where
        isUrl :: Text -> Bool
        isUrl :: Text -> Bool
    isUrl cs :: Text
    cs =
          let (scheme :: Text
    scheme, path :: Text
    path) = (Char -> Bool) -> Text -> (Text, Text)
    T.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == ':') Text
    cs
          in (Char -> Bool) -> Text -> Bool
    T.all (\c :: Char
    c -> Char -> Bool
    isAlphaNum Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Text -> Bool
    `elemText` ".-") 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 lang :: Text
    lang =
      let transLang :: Text
    transLang = Text -> Text
    translateLang Text
    lang
      in if Text
    transLang Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    lang
         then []
         else [("org-language", 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 cs :: Text
    cs =
      case Text
    cs of
        "C"          -> "c"
        "C++"        -> "cpp"
        "emacs-lisp" -> "commonlisp" -- emacs lisp is not supported
        "js"         -> "javascript"
        "lisp"       -> "commonlisp"
        "R"          -> "r"
        "sh"         -> "bash"
        "sqlite"     -> "sql"
        _            -> 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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["code", "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 "exports"