    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE OverloadedStrings #-}
    module Commonmark.Extensions.RebaseRelativePaths
      ( rebaseRelativePathsSpec )
    where
    import Commonmark.Types
    import Commonmark.Syntax
    import Commonmark.Inlines
    import Data.Char (isAscii)
    import Data.Text (Text)
    import qualified Data.Text as T
    import Data.Maybe (fromMaybe)
    import Text.Parsec (getPosition)
    import System.FilePath
    import qualified System.FilePath.Windows as Windows
    import qualified System.FilePath.Posix as Posix
    import Network.URI (URI (uriScheme), parseURI, escapeURIString)
    import qualified Data.Set as Set

    rebaseRelativePathsSpec
      :: forall m bl il . (Monad m , IsInline il , IsBlock il bl)
      => SyntaxSpec m il bl
    rebaseRelativePathsSpec :: forall (m :: * -> *) bl il.
    (Monad m, IsInline il, IsBlock il bl) =>
    SyntaxSpec m il bl
    rebaseRelativePathsSpec =
      SyntaxSpec m il bl
    forall (m :: * -> *) il bl.
    (Monad m, IsBlock il bl, IsInline il) =>
    SyntaxSpec m il bl
    defaultSyntaxSpec {
         syntaxBracketedSpecs = [rebasedImageSpec, rebasedLinkSpec] }

     where

      rebasedImageSpec :: BracketedSpec il
      rebasedImageSpec :: BracketedSpec il
    rebasedImageSpec =BracketedSpec
                { bracketedName :: Text
    bracketedName = Text
    "Image"
                , bracketedNests :: Bool
    bracketedNests = Bool
    True
                , bracketedPrefix :: Maybe Char
    bracketedPrefix = Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    '!'
                , bracketedSuffixEnd :: Maybe Char
    bracketedSuffixEnd = Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    ')'
                , bracketedSuffix :: ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
    bracketedSuffix = ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
    forall {c} {u}.
    IsInline c =>
    ReferenceMap -> Text -> ParsecT [Tok] u Identity (c -> c)
    newImageSuffix
                }

      rebasedLinkSpec :: BracketedSpec il
      rebasedLinkSpec :: BracketedSpec il
    rebasedLinkSpec = BracketedSpec
               { bracketedName :: Text
    bracketedName = Text
    "Link"
               , bracketedNests :: Bool
    bracketedNests = Bool
    False  -- links don't nest inside links
               , bracketedPrefix :: Maybe Char
    bracketedPrefix = Maybe Char
    forall a. Maybe a
    Nothing
               , bracketedSuffixEnd :: Maybe Char
    bracketedSuffixEnd = Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    ')'
               , bracketedSuffix :: ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
    bracketedSuffix = ReferenceMap -> Text -> Parsec [Tok] () (il -> il)
    forall {c} {u}.
    IsInline c =>
    ReferenceMap -> Text -> ParsecT [Tok] u Identity (c -> c)
    newLinkSuffix
               }

      newImageSuffix :: ReferenceMap -> Text -> ParsecT [Tok] u Identity (c -> c)
    newImageSuffix ReferenceMap
    rm Text
    key = do
        pos <- ParsecT [Tok] u Identity SourcePos
    forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
    getPosition
        LinkInfo target title attrs mbpos <- pLink rm key
        let pos' = SourcePos -> Maybe SourcePos -> SourcePos
    forall a. a -> Maybe a -> a
    fromMaybe SourcePos
    pos Maybe SourcePos
    mbpos
        return $! addAttributes attrs . image (rebasePath pos' target) title

      newLinkSuffix :: ReferenceMap -> Text -> ParsecT [Tok] u Identity (c -> c)
    newLinkSuffix ReferenceMap
    rm Text
    key = do
        pos <- ParsecT [Tok] u Identity SourcePos
    forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
    getPosition
        LinkInfo target title attrs mbpos <- pLink rm key
        let pos' = SourcePos -> Maybe SourcePos -> SourcePos
    forall a. a -> Maybe a -> a
    fromMaybe SourcePos
    pos Maybe SourcePos
    mbpos
        return $! addAttributes attrs . link (rebasePath pos' target) title

    -- | Rebase a relative path, by adding the (relative) directory
    -- of the containing source position.  Absolute links and URLs
    -- are untouched.
    rebasePath :: SourcePos -> Text -> Text
    rebasePath :: SourcePos -> Text -> Text
    rebasePath SourcePos
    pos Text
    path = do
      let fp :: FilePath
    fp = SourcePos -> FilePath
    sourceName SourcePos
    pos
          isFragment :: Bool
    isFragment = Int -> Text -> Text
    T.take Int
    1 Text
    path Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "#"
          path' :: FilePath
    path' = Text -> FilePath
    T.unpack Text
    path
          isAbsolutePath :: Bool
    isAbsolutePath = FilePath -> Bool
    Posix.isAbsolute FilePath
    path' Bool -> Bool -> Bool
    || FilePath -> Bool
    Windows.isAbsolute FilePath
    path'
       in if Text -> Bool
    T.null Text
    path Bool -> Bool -> Bool
    || Bool
    isFragment Bool -> Bool -> Bool
    || Bool
    isAbsolutePath Bool -> Bool -> Bool
    || Text -> Bool
    isURI Text
    path
             then Text
    path
             else
               case FilePath -> FilePath
    takeDirectory FilePath
    fp of
                 FilePath
    ""  -> Text
    path
                 FilePath
    "." -> Text
    path
                 FilePath
    d   -> FilePath -> Text
    T.pack FilePath
    d Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "/" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    path

    -- | Schemes from http://www.iana.org/assignments/uri-schemes.html plus
    -- the unofficial schemes doi, javascript, isbn, pmid.
    schemes :: Set.Set T.Text
    schemes :: Set Text
    schemes = [Text] -> Set Text
    forall a. Ord a => [a] -> Set a
    Set.fromList
      -- Official IANA schemes
      [ Text
    "aaa", Text
    "aaas", Text
    "about", Text
    "acap", Text
    "acct", Text
    "acr", Text
    "adiumxtra", Text
    "afp", Text
    "afs"
      , Text
    "aim", Text
    "appdata", Text
    "apt", Text
    "attachment", Text
    "aw", Text
    "barion", Text
    "beshare", Text
    "bitcoin"
      , Text
    "blob", Text
    "bolo", Text
    "browserext", Text
    "callto", Text
    "cap", Text
    "chrome", Text
    "chrome-extension"
      , Text
    "cid", Text
    "coap", Text
    "coaps", Text
    "com-eventbrite-attendee", Text
    "content", Text
    "crid", Text
    "cvs"
      , Text
    "data", Text
    "dav", Text
    "dict", Text
    "dis", Text
    "dlna-playcontainer", Text
    "dlna-playsingle"
      , Text
    "dns", Text
    "dntp", Text
    "dtn", Text
    "dvb", Text
    "ed2k", Text
    "example", Text
    "facetime", Text
    "fax", Text
    "feed"
      , Text
    "feedready", Text
    "file", Text
    "filesystem", Text
    "finger", Text
    "fish", Text
    "ftp", Text
    "geo", Text
    "gg"
      , Text
    "git", Text
    "gizmoproject", Text
    "go", Text
    "gopher", Text
    "graph", Text
    "gtalk", Text
    "h323", Text
    "ham"
      , Text
    "hcp", Text
    "http", Text
    "https", Text
    "hxxp", Text
    "hxxps", Text
    "hydrazone", Text
    "iax", Text
    "icap", Text
    "icon"
      , Text
    "im", Text
    "imap", Text
    "info", Text
    "iotdisco", Text
    "ipn", Text
    "ipp", Text
    "ipps", Text
    "irc", Text
    "irc6"
      , Text
    "ircs", Text
    "iris", Text
    "iris.beep", Text
    "iris.lwz", Text
    "iris.xpc", Text
    "iris.xpcs"
      , Text
    "isostore", Text
    "itms", Text
    "jabber", Text
    "jar", Text
    "jms", Text
    "keyparc", Text
    "lastfm", Text
    "ldap"
      , Text
    "ldaps", Text
    "lvlt", Text
    "magnet", Text
    "mailserver", Text
    "mailto", Text
    "maps", Text
    "market"
      , Text
    "message", Text
    "mid", Text
    "mms", Text
    "modem", Text
    "mongodb", Text
    "moz", Text
    "ms-access"
      , Text
    "ms-browser-extension", Text
    "ms-drive-to", Text
    "ms-enrollment", Text
    "ms-excel"
      , Text
    "ms-gamebarservices", Text
    "ms-getoffice", Text
    "ms-help", Text
    "ms-infopath"
      , Text
    "ms-media-stream-id", Text
    "ms-officeapp", Text
    "ms-project", Text
    "ms-powerpoint"
      , Text
    "ms-publisher", Text
    "ms-search-repair", Text
    "ms-secondary-screen-controller"
      , Text
    "ms-secondary-screen-setup", Text
    "ms-settings", Text
    "ms-settings-airplanemode"
      , Text
    "ms-settings-bluetooth", Text
    "ms-settings-camera", Text
    "ms-settings-cellular"
      , Text
    "ms-settings-cloudstorage", Text
    "ms-settings-connectabledevices"
      , Text
    "ms-settings-displays-topology", Text
    "ms-settings-emailandaccounts"
      , Text
    "ms-settings-language", Text
    "ms-settings-location", Text
    "ms-settings-lock"
      , Text
    "ms-settings-nfctransactions", Text
    "ms-settings-notifications"
      , Text
    "ms-settings-power", Text
    "ms-settings-privacy", Text
    "ms-settings-proximity"
      , Text
    "ms-settings-screenrotation", Text
    "ms-settings-wifi", Text
    "ms-settings-workplace"
      , Text
    "ms-spd", Text
    "ms-sttoverlay", Text
    "ms-transit-to", Text
    "ms-virtualtouchpad"
      , Text
    "ms-visio", Text
    "ms-walk-to", Text
    "ms-whiteboard", Text
    "ms-whiteboard-cmd", Text
    "ms-word"
      , Text
    "msnim", Text
    "msrp", Text
    "msrps", Text
    "mtqp", Text
    "mumble", Text
    "mupdate", Text
    "mvn", Text
    "news", Text
    "nfs"
      , Text
    "ni", Text
    "nih", Text
    "nntp", Text
    "notes", Text
    "ocf", Text
    "oid", Text
    "onenote", Text
    "onenote-cmd"
      , Text
    "opaquelocktoken", Text
    "pack", Text
    "palm", Text
    "paparazzi", Text
    "pkcs11", Text
    "platform", Text
    "pop"
      , Text
    "pres", Text
    "prospero", Text
    "proxy", Text
    "pwid", Text
    "psyc", Text
    "qb", Text
    "query", Text
    "redis"
      , Text
    "rediss", Text
    "reload", Text
    "res", Text
    "resource", Text
    "rmi", Text
    "rsync", Text
    "rtmfp", Text
    "rtmp"
      , Text
    "rtsp", Text
    "rtsps", Text
    "rtspu", Text
    "secondlife", Text
    "service", Text
    "session", Text
    "sftp", Text
    "sgn"
      , Text
    "shttp", Text
    "sieve", Text
    "sip", Text
    "sips", Text
    "skype", Text
    "smb", Text
    "sms", Text
    "smtp", Text
    "snews"
      , Text
    "snmp", Text
    "soap.beep", Text
    "soap.beeps", Text
    "soldat", Text
    "spotify", Text
    "ssh", Text
    "steam"
      , Text
    "stun", Text
    "stuns", Text
    "submit", Text
    "svn", Text
    "tag", Text
    "teamspeak", Text
    "tel", Text
    "teliaeid"
      , Text
    "telnet", Text
    "tftp", Text
    "things", Text
    "thismessage", Text
    "tip", Text
    "tn3270", Text
    "tool", Text
    "turn"
      , Text
    "turns", Text
    "tv", Text
    "udp", Text
    "unreal", Text
    "urn", Text
    "ut2004", Text
    "v-event", Text
    "vemmi"
      , Text
    "ventrilo", Text
    "videotex", Text
    "vnc", Text
    "view-source", Text
    "wais", Text
    "webcal", Text
    "wpid"
      , Text
    "ws", Text
    "wss", Text
    "wtai", Text
    "wyciwyg", Text
    "xcon", Text
    "xcon-userid", Text
    "xfire"
      , Text
    "xmlrpc.beep", Text
    "xmlrpc.beeps", Text
    "xmpp", Text
    "xri", Text
    "ymsgr", Text
    "z39.50", Text
    "z39.50r"
      , Text
    "z39.50s"
      -- Unofficial schemes
      , Text
    "doi", Text
    "isbn", Text
    "javascript", Text
    "pmid"
      ]

    -- | Check if the string is a valid URL with a IANA or frequently used but
    -- unofficial scheme (see @schemes@).
    isURI :: T.Text -> Bool
    isURI :: Text -> Bool
    isURI = Bool -> (URI -> Bool) -> Maybe URI -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False URI -> Bool
    hasKnownScheme (Maybe URI -> Bool) -> (Text -> Maybe URI) -> Text -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Maybe URI
    parseURI (FilePath -> Maybe URI) -> (Text -> FilePath) -> Text -> Maybe URI
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> FilePath -> FilePath
    escapeURIString Char -> Bool
    isAscii (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> FilePath
    T.unpack
      where
        hasKnownScheme :: URI -> Bool
    hasKnownScheme = (Text -> Set Text -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set Text
    schemes) (Text -> Bool) -> (URI -> Text) -> URI -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    T.toLower (Text -> Text) -> (URI -> Text) -> URI -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                         (Char -> Bool) -> Text -> Text
    T.filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ':') (Text -> Text) -> (URI -> Text) -> URI -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Text
    T.pack (FilePath -> Text) -> (URI -> FilePath) -> URI -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . URI -> FilePath
    uriScheme