{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.Org.Shared
   Copyright   : Copyright (C) 2014-2019 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 Prelude
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"