    {-
    Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    -}

    {- |
       Module      : Text.Pandoc.Parsing
       Copyright   : Copyright (C) 2006-2010 John MacFarlane
       License     : GNU GPL, version 2 or above

       Maintainer  : John MacFarlane <jgm@berkeley.edu>
       Stability   : alpha
       Portability : portable

    A utility library with parsers used in pandoc readers.
    -}
    module Text.Pandoc.Parsing ( (>>~),
                                 anyLine,
                                 many1Till,
                                 notFollowedBy',
                                 oneOfStrings,
                                 spaceChar,
                                 skipSpaces,
                                 blankline,
                                 blanklines,
                                 enclosed,
                                 stringAnyCase,
                                 parseFromString,
                                 lineClump,
                                 charsInBalanced,
                                 charsInBalanced',
                                 romanNumeral,
                                 emailAddress,
                                 uri,
                                 withHorizDisplacement,
                                 nullBlock,
                                 failIfStrict,
                                 failUnlessLHS,
                                 escaped,
                                 anyOrderedListMarker,
                                 orderedListMarker,
                                 charRef,
                                 tableWith,
                                 gridTableWith,
                                 readWith,
                                 testStringWith,
                                 ParserState (..),
                                 defaultParserState,
                                 HeaderType (..),
                                 ParserContext (..),
                                 QuoteContext (..),
                                 NoteTable,
                                 KeyTable,
                                 Key (..),
                                 lookupKeySrc,
                                 refsMatch )
    where

    import Text.Pandoc.Definition
    import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn)
    import Text.ParserCombinators.Parsec
    import Text.Pandoc.CharacterReferences ( characterReference )
    import Data.Char ( toLower, toUpper, ord, isAscii )
    import Data.List ( intercalate, transpose )
    import Network.URI ( parseURI, URI (..), isAllowedInURI )
    import Control.Monad ( join, liftM )
    import Text.Pandoc.Shared
    import qualified Data.Map as M

    -- | Like >>, but returns the operation on the left.
    -- (Suggested by Tillmann Rendel on Haskell-cafe list.)
    (>>~) :: (Monad m) => m a -> m b -> m a
    a >>~ b = a >>= \x -> b >> return x

    -- | Parse any line of text
    anyLine :: GenParser Char st [Char]
    anyLine = manyTill anyChar newline

    -- | Like @manyTill@, but reads at least one item.
    many1Till :: GenParser tok st a
              -> GenParser tok st end
              -> GenParser tok st [a]
    many1Till p end = do
             first <- p
             rest <- manyTill p end
             return (first:rest)

    -- | A more general form of @notFollowedBy@.  This one allows any
    -- type of parser to be specified, and succeeds only if that parser fails.
    -- It does not consume any input.
    notFollowedBy' :: Show b => GenParser a st b -> GenParser a st ()
    notFollowedBy' p  = try $ join $  do  a <- try p
                                          return (unexpected (show a))
                                      <|>
                                      return (return ())
    -- (This version due to Andrew Pimlott on the Haskell mailing list.)

    -- | Parses one of a list of strings (tried in order).
    oneOfStrings :: [String] -> GenParser Char st String
    oneOfStrings listOfStrings = choice $ map (try . string) listOfStrings

    -- | Parses a space or tab.
    spaceChar :: CharParser st Char
    spaceChar = char ' ' <|> char '\t'

    -- | Skips zero or more spaces or tabs.
    skipSpaces :: GenParser Char st ()
    skipSpaces = skipMany spaceChar

    -- | Skips zero or more spaces or tabs, then reads a newline.
    blankline :: GenParser Char st Char
    blankline = try $ skipSpaces >> newline

    -- | Parses one or more blank lines and returns a string of newlines.
    blanklines :: GenParser Char st [Char]
    blanklines = many1 blankline

    -- | Parses material enclosed between start and end parsers.
    enclosed :: GenParser Char st t   -- ^ start parser
             -> GenParser Char st end  -- ^ end parser
             -> GenParser Char st a    -- ^ content parser (to be used repeatedly)
             -> GenParser Char st [a]
    enclosed start end parser = try $
      start >> notFollowedBy space >> many1Till parser end

    -- | Parse string, case insensitive.
    stringAnyCase :: [Char] -> CharParser st String
    stringAnyCase [] = string ""
    stringAnyCase (x:xs) = do
      firstChar <- char (toUpper x) <|> char (toLower x)
      rest <- stringAnyCase xs
      return (firstChar:rest)

    -- | Parse contents of 'str' using 'parser' and return result.
    parseFromString :: GenParser tok st a -> [tok] -> GenParser tok st a
    parseFromString parser str = do
      oldPos <- getPosition
      oldInput <- getInput
      setInput str
      result <- parser
      setInput oldInput
      setPosition oldPos
      return result

    -- | Parse raw line block up to and including blank lines.
    lineClump :: GenParser Char st String
    lineClump = blanklines
              <|> (many1 (notFollowedBy blankline >> anyLine) >>= return . unlines)

    -- | Parse a string of characters between an open character
    -- and a close character, including text between balanced
    -- pairs of open and close, which must be different. For example,
    -- @charsInBalanced '(' ')'@ will parse "(hello (there))"
    -- and return "hello (there)".  Stop if a blank line is
    -- encountered.
    charsInBalanced :: Char -> Char -> GenParser Char st String
    charsInBalanced open close = try $ do
      char open
      raw <- many $     (many1 (noneOf [open, close, '\n']))
                    <|> (do res <- charsInBalanced open close
                            return $ [open] ++ res ++ [close])
                    <|> try (string "\n" >>~ notFollowedBy' blanklines)
      char close
      return $ concat raw

    -- | Like @charsInBalanced@, but allow blank lines in the content.
    charsInBalanced' :: Char -> Char -> GenParser Char st String
    charsInBalanced' open close = try $ do
      char open
      raw <- many $       (many1 (noneOf [open, close]))
                      <|> (do res <- charsInBalanced' open close
                              return $ [open] ++ res ++ [close])
      char close
      return $ concat raw

    -- Auxiliary functions for romanNumeral:

    lowercaseRomanDigits :: [Char]
    lowercaseRomanDigits = ['i','v','x','l','c','d','m']

    uppercaseRomanDigits :: [Char]
    uppercaseRomanDigits = map toUpper lowercaseRomanDigits

    -- | Parses a roman numeral (uppercase or lowercase), returns number.
    romanNumeral :: Bool                  -- ^ Uppercase if true
                 -> GenParser Char st Int
    romanNumeral upperCase = do
        let romanDigits = if upperCase
                             then uppercaseRomanDigits
                             else lowercaseRomanDigits
        lookAhead $ oneOf romanDigits
        let [one, five, ten, fifty, hundred, fivehundred, thousand] =
              map char romanDigits
        thousands <- many thousand >>= (return . (1000 *) . length)
        ninehundreds <- option 0 $ try $ hundred >> thousand >> return 900
        fivehundreds <- many fivehundred >>= (return . (500 *) . length)
        fourhundreds <- option 0 $ try $ hundred >> fivehundred >> return 400
        hundreds <- many hundred >>= (return . (100 *) . length)
        nineties <- option 0 $ try $ ten >> hundred >> return 90
        fifties <- many fifty >>= (return . (50 *) . length)
        forties <- option 0 $ try $ ten >> fifty >> return 40
        tens <- many ten >>= (return . (10 *) . length)
        nines <- option 0 $ try $ one >> ten >> return 9
        fives <- many five >>= (return . (5 *) . length)
        fours <- option 0 $ try $ one >> five >> return 4
        ones <- many one >>= (return . length)
        let total = thousands + ninehundreds + fivehundreds + fourhundreds +
                    hundreds + nineties + fifties + forties + tens + nines +
                    fives + fours + ones
        if total == 0
           then fail "not a roman numeral"
           else return total

    -- Parsers for email addresses and URIs

    emailChar :: GenParser Char st Char
    emailChar = alphaNum <|> oneOf "-+_."

    domainChar :: GenParser Char st Char
    domainChar = alphaNum <|> char '-'

    domain :: GenParser Char st [Char]
    domain = do
      first <- many1 domainChar
      dom <- many1 $ try (char '.' >> many1 domainChar )
      return $ intercalate "." (first:dom)

    -- | Parses an email address; returns original and corresponding
    -- escaped mailto: URI.
    emailAddress :: GenParser Char st (String, String)
    emailAddress = try $ do
      firstLetter <- alphaNum
      restAddr <- many emailChar
      let addr = firstLetter:restAddr
      char '@'
      dom <- domain
      let full = addr ++ '@':dom
      return (full, escapeURI $ "mailto:" ++ full)

    -- | Parses a URI. Returns pair of original and URI-escaped version.
    uri :: GenParser Char st (String, String)
    uri = try $ do
      let protocols = [ "http:", "https:", "ftp:", "file:", "mailto:",
                        "news:", "telnet:" ]
      lookAhead $ oneOfStrings protocols
      -- scan non-ascii characters and ascii characters allowed in a URI
      str <- many1 $ satisfy (\c -> not (isAscii c) || isAllowedInURI c)
      -- now see if they amount to an absolute URI
      case parseURI (escapeURI str) of
           Just uri' -> if uriScheme uri' `elem` protocols
                           then return (str, show uri')
                           else fail "not a URI"
           Nothing   -> fail "not a URI"

    -- | Applies a parser, returns tuple of its results and its horizontal
    -- displacement (the difference between the source column at the end
    -- and the source column at the beginning). Vertical displacement
    -- (source row) is ignored.
    withHorizDisplacement :: GenParser Char st a  -- ^ Parser to apply
                          -> GenParser Char st (a, Int) -- ^ (result, displacement)
    withHorizDisplacement parser = do
      pos1 <- getPosition
      result <- parser
      pos2 <- getPosition
      return (result, sourceColumn pos2 - sourceColumn pos1)

    -- | Parses a character and returns 'Null' (so that the parser can move on
    -- if it gets stuck).
    nullBlock :: GenParser Char st Block
    nullBlock = anyChar >> return Null

    -- | Fail if reader is in strict markdown syntax mode.
    failIfStrict :: GenParser Char ParserState ()
    failIfStrict = do
      state <- getState
      if stateStrict state then fail "strict mode" else return ()

    -- | Fail unless we're in literate haskell mode.
    failUnlessLHS :: GenParser tok ParserState ()
    failUnlessLHS = do
      state <- getState
      if stateLiterateHaskell state then return () else fail "Literate haskell feature"

    -- | Parses backslash, then applies character parser.
    escaped :: GenParser Char st Char  -- ^ Parser for character to escape
            -> GenParser Char st Inline
    escaped parser = try $ do
      char '\\'
      result <- parser
      return (Str [result])

    -- | Parses an uppercase roman numeral and returns (UpperRoman, number).
    upperRoman :: GenParser Char st (ListNumberStyle, Int)
    upperRoman = do
      num <- romanNumeral True
      return (UpperRoman, num)

    -- | Parses a lowercase roman numeral and returns (LowerRoman, number).
    lowerRoman :: GenParser Char st (ListNumberStyle, Int)
    lowerRoman = do
      num <- romanNumeral False
      return (LowerRoman, num)

    -- | Parses a decimal numeral and returns (Decimal, number).
    decimal :: GenParser Char st (ListNumberStyle, Int)
    decimal = do
      num <- many1 digit
      return (Decimal, read num)

    -- | Parses a '@' and optional label and
    -- returns (DefaultStyle, [next example number]).  The next
    -- example number is incremented in parser state, and the label
    -- (if present) is added to the label table.
    exampleNum :: GenParser Char ParserState (ListNumberStyle, Int)
    exampleNum = do
      char '@'
      lab <- many (alphaNum <|> oneOf "_-")
      st <- getState
      let num = stateNextExample st
      let newlabels = if null lab
                         then stateExamples st
                         else M.insert lab num $ stateExamples st
      updateState $ \s -> s{ stateNextExample = num + 1
                           , stateExamples    = newlabels }
      return (Example, num)

    -- | Parses a '#' returns (DefaultStyle, 1).
    defaultNum :: GenParser Char st (ListNumberStyle, Int)
    defaultNum = do
      char '#'
      return (DefaultStyle, 1)

    -- | Parses a lowercase letter and returns (LowerAlpha, number).
    lowerAlpha :: GenParser Char st (ListNumberStyle, Int)
    lowerAlpha = do
      ch <- oneOf ['a'..'z']
      return (LowerAlpha, ord ch - ord 'a' + 1)

    -- | Parses an uppercase letter and returns (UpperAlpha, number).
    upperAlpha :: GenParser Char st (ListNumberStyle, Int)
    upperAlpha = do
      ch <- oneOf ['A'..'Z']
      return (UpperAlpha, ord ch - ord 'A' + 1)

    -- | Parses a roman numeral i or I
    romanOne :: GenParser Char st (ListNumberStyle, Int)
    romanOne = (char 'i' >> return (LowerRoman, 1)) <|>
               (char 'I' >> return (UpperRoman, 1))

    -- | Parses an ordered list marker and returns list attributes.
    anyOrderedListMarker :: GenParser Char ParserState ListAttributes
    anyOrderedListMarker = choice $
      [delimParser numParser | delimParser <- [inPeriod, inOneParen, inTwoParens],
                               numParser <- [decimal, exampleNum, defaultNum, romanOne,
                               lowerAlpha, lowerRoman, upperAlpha, upperRoman]]

    -- | Parses a list number (num) followed by a period, returns list attributes.
    inPeriod :: GenParser Char st (ListNumberStyle, Int)
             -> GenParser Char st ListAttributes
    inPeriod num = try $ do
      (style, start) <- num
      char '.'
      let delim = if style == DefaultStyle
                     then DefaultDelim
                     else Period
      return (start, style, delim)

    -- | Parses a list number (num) followed by a paren, returns list attributes.
    inOneParen :: GenParser Char st (ListNumberStyle, Int)
               -> GenParser Char st ListAttributes
    inOneParen num = try $ do
      (style, start) <- num
      char ')'
      return (start, style, OneParen)

    -- | Parses a list number (num) enclosed in parens, returns list attributes.
    inTwoParens :: GenParser Char st (ListNumberStyle, Int)
                -> GenParser Char st ListAttributes
    inTwoParens num = try $ do
      char '('
      (style, start) <- num
      char ')'
      return (start, style, TwoParens)

    -- | Parses an ordered list marker with a given style and delimiter,
    -- returns number.
    orderedListMarker :: ListNumberStyle
                      -> ListNumberDelim
                      -> GenParser Char ParserState Int
    orderedListMarker style delim = do
      let num = defaultNum <|>  -- # can continue any kind of list
                case style of
                   DefaultStyle -> decimal
                   Example      -> exampleNum
                   Decimal      -> decimal
                   UpperRoman   -> upperRoman
                   LowerRoman   -> lowerRoman
                   UpperAlpha   -> upperAlpha
                   LowerAlpha   -> lowerAlpha
      let context = case delim of
                   DefaultDelim -> inPeriod
                   Period       -> inPeriod
                   OneParen     -> inOneParen
                   TwoParens    -> inTwoParens
      (start, _, _) <- context num
      return start

    -- | Parses a character reference and returns a Str element.
    charRef :: GenParser Char st Inline
    charRef = do
      c <- characterReference
      return $ Str [c]

    -- | Parse a table using 'headerParser', 'rowParser',
    -- 'lineParser', and 'footerParser'.
    tableWith :: GenParser Char ParserState ([[Block]], [Alignment], [Int])
              -> ([Int] -> GenParser Char ParserState [[Block]])
              -> GenParser Char ParserState sep
              -> GenParser Char ParserState end
              -> GenParser Char ParserState [Inline]
              -> GenParser Char ParserState Block
    tableWith headerParser rowParser lineParser footerParser captionParser = try $ do
        caption' <- option [] captionParser
        (heads, aligns, indices) <- headerParser
        lines' <- rowParser indices `sepEndBy` lineParser
        footerParser
        caption <- if null caption'
                      then option [] captionParser
                      else return caption'
        state <- getState
        let numColumns = stateColumns state
        let widths = widthsFromIndices numColumns indices
        return $ Table caption aligns widths heads lines'

    -- Calculate relative widths of table columns, based on indices
    widthsFromIndices :: Int      -- Number of columns on terminal
                      -> [Int]    -- Indices
                      -> [Double] -- Fractional relative sizes of columns
    widthsFromIndices _ [] = []
    widthsFromIndices numColumns indices =
      let lengths' = zipWith (-) indices (0:indices)
          lengths  = reverse $
                     case reverse lengths' of
                          []       -> []
                          [x]      -> [x]
                          -- compensate for the fact that intercolumn
                          -- spaces are counted in widths of all columns
                          -- but the last...
                          (x:y:zs) -> if x < y && y - x <= 2
                                         then y:y:zs
                                         else x:y:zs
          totLength = sum lengths
          quotient = if totLength > numColumns
                       then fromIntegral totLength
                       else fromIntegral numColumns
          fracs = map (\l -> (fromIntegral l) / quotient) lengths in
      tail fracs

    -- Parse a grid table:  starts with row of '-' on top, then header
    -- (which may be grid), then the rows,
    -- which may be grid, separated by blank lines, and
    -- ending with a footer (dashed line followed by blank line).
    gridTableWith :: GenParser Char ParserState Block    -- ^ Block parser
                  -> GenParser Char ParserState [Inline] -- ^ Caption parser
                  -> Bool                                -- ^ Headerless table
                  -> GenParser Char ParserState Block
    gridTableWith block tableCaption headless =
      tableWith (gridTableHeader headless block) (gridTableRow block) (gridTableSep '-') gridTableFooter tableCaption

    gridTableSplitLine :: [Int] -> String -> [String]
    gridTableSplitLine indices line =
      map removeFinalBar $ tail $ splitByIndices (init indices) line

    gridPart :: Char -> GenParser Char st (Int, Int)
    gridPart ch = do
      dashes <- many1 (char ch)
      char '+'
      return (length dashes, length dashes + 1)

    gridDashedLines :: Char -> GenParser Char st [(Int,Int)]
    gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) >>~ blankline

    removeFinalBar :: String -> String
    removeFinalBar = reverse . dropWhile (=='|') .  dropWhile (`elem` " \t") .
                     reverse

    -- | Separator between rows of grid table.
    gridTableSep :: Char -> GenParser Char ParserState Char
    gridTableSep ch = try $ gridDashedLines ch >> return '\n'

    -- | Parse header for a grid table.
    gridTableHeader :: Bool -- ^ Headerless table
                    -> GenParser Char ParserState Block
                    -> GenParser Char ParserState ([[Block]], [Alignment], [Int])
    gridTableHeader headless block = try $ do
      optional blanklines
      dashes <- gridDashedLines '-'
      rawContent  <- if headless
                        then return $ repeat ""
                        else many1
                             (notFollowedBy (gridTableSep '=') >> char '|' >>
                               many1Till anyChar newline)
      if headless
         then return ()
         else gridTableSep '=' >> return ()
      let lines'   = map snd dashes
      let indices  = scanl (+) 0 lines'
      let aligns   = replicate (length lines') AlignDefault
      -- RST does not have a notion of alignments
      let rawHeads = if headless
                        then replicate (length dashes) ""
                        else map (intercalate " ") $ transpose
                           $ map (gridTableSplitLine indices) rawContent
      heads <- mapM (parseFromString $ many block) $
                   map removeLeadingTrailingSpace rawHeads
      return (heads, aligns, indices)

    gridTableRawLine :: [Int] -> GenParser Char ParserState [String]
    gridTableRawLine indices = do
      char '|'
      line <- many1Till anyChar newline
      return (gridTableSplitLine indices $ removeTrailingSpace line)

    -- | Parse row of grid table.
    gridTableRow :: GenParser Char ParserState Block
                 -> [Int]
                 -> GenParser Char ParserState [[Block]]
    gridTableRow block indices = do
      colLines <- many1 (gridTableRawLine indices)
      let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $
                   transpose colLines
      mapM (liftM compactifyCell . parseFromString (many block)) cols

    removeOneLeadingSpace :: [String] -> [String]
    removeOneLeadingSpace xs =
      if all startsWithSpace xs
         then map (drop 1) xs
         else xs
       where startsWithSpace ""     = True
             startsWithSpace (y:_) = y == ' '

    compactifyCell :: [Block] -> [Block]
    compactifyCell bs = head $ compactify [bs]

    -- | Parse footer for a grid table.
    gridTableFooter :: GenParser Char ParserState [Char]
    gridTableFooter = blanklines

    ---

    -- | Parse a string with a given parser and state.
    readWith :: GenParser Char ParserState a      -- ^ parser
             -> ParserState                    -- ^ initial state
             -> String                         -- ^ input string
             -> a
    readWith parser state input =
        case runParser parser state "source" input of
          Left err     -> error $ "\nError:\n" ++ show err
          Right result -> result

    -- | Parse a string with @parser@ (for testing).
    testStringWith :: (Show a) => GenParser Char ParserState a
                   -> String
                   -> IO ()
    testStringWith parser str = UTF8.putStrLn $ show $
                                readWith parser defaultParserState str

    -- | Parsing options.
    data ParserState = ParserState
        { stateParseRaw        :: Bool,          -- ^ Parse raw HTML and LaTeX?
          stateParserContext   :: ParserContext, -- ^ Inside list?
          stateQuoteContext    :: QuoteContext,  -- ^ Inside quoted environment?
          stateSanitizeHTML    :: Bool,          -- ^ Sanitize HTML?
          stateKeys            :: KeyTable,      -- ^ List of reference keys
    #ifdef _CITEPROC
          stateCitations       :: [String],      -- ^ List of available citations
    #endif
          stateNotes           :: NoteTable,     -- ^ List of notes
          stateTabStop         :: Int,           -- ^ Tab stop
          stateStandalone      :: Bool,          -- ^ Parse bibliographic info?
          stateTitle           :: [Inline],      -- ^ Title of document
          stateAuthors         :: [[Inline]],    -- ^ Authors of document
          stateDate            :: [Inline],      -- ^ Date of document
          stateStrict          :: Bool,          -- ^ Use strict markdown syntax?
          stateSmart           :: Bool,          -- ^ Use smart typography?
          stateLiterateHaskell :: Bool,          -- ^ Treat input as literate haskell
          stateColumns         :: Int,           -- ^ Number of columns in terminal
          stateHeaderTable     :: [HeaderType],  -- ^ Ordered list of header types used
          stateIndentedCodeClasses :: [String],  -- ^ Classes to use for indented code blocks
          stateNextExample     :: Int,           -- ^ Number of next example
          stateExamples        :: M.Map String Int, -- ^ Map from example labels to numbers
          stateHasChapters     :: Bool           -- ^ True if \chapter encountered
        }
        deriving Show

    defaultParserState :: ParserState
    defaultParserState =
        ParserState { stateParseRaw        = False,
                      stateParserContext   = NullState,
                      stateQuoteContext    = NoQuote,
                      stateSanitizeHTML    = False,
                      stateKeys            = M.empty,
    #ifdef _CITEPROC
                      stateCitations       = [],
    #endif
                      stateNotes           = [],
                      stateTabStop         = 4,
                      stateStandalone      = False,
                      stateTitle           = [],
                      stateAuthors         = [],
                      stateDate            = [],
                      stateStrict          = False,
                      stateSmart           = False,
                      stateLiterateHaskell = False,
                      stateColumns         = 80,
                      stateHeaderTable     = [],
                      stateIndentedCodeClasses = [],
                      stateNextExample     = 1,
                      stateExamples        = M.empty,
                      stateHasChapters     = False }

    data HeaderType
        = SingleHeader Char  -- ^ Single line of characters underneath
        | DoubleHeader Char  -- ^ Lines of characters above and below
        deriving (Eq, Show)

    data ParserContext
        = ListItemState   -- ^ Used when running parser on list item contents
        | NullState       -- ^ Default state
        deriving (Eq, Show)

    data QuoteContext
        = InSingleQuote   -- ^ Used when parsing inside single quotes
        | InDoubleQuote   -- ^ Used when parsing inside double quotes
        | NoQuote         -- ^ Used when not parsing inside quotes
        deriving (Eq, Show)

    type NoteTable = [(String, String)]

    newtype Key = Key [Inline] deriving (Show, Read)

    instance Eq Key where
      Key a == Key b = refsMatch a b

    instance Ord Key where
      compare (Key a) (Key b) = if a == b then EQ else compare a b

    type KeyTable = M.Map Key Target

    -- | Look up key in key table and return target object.
    lookupKeySrc :: KeyTable  -- ^ Key table
                 -> Key       -- ^ Key
                 -> Maybe Target
    lookupKeySrc table key = case M.lookup key table of
                               Nothing  -> Nothing
                               Just src -> Just src

    -- | Returns @True@ if keys match (case insensitive).
    refsMatch :: [Inline] -> [Inline] -> Bool
    refsMatch ((Str x):restx) ((Str y):resty) =
        ((map toLower x) == (map toLower y)) && refsMatch restx resty
    refsMatch ((Emph x):restx) ((Emph y):resty) =
        refsMatch x y && refsMatch restx resty
    refsMatch ((Strong x):restx) ((Strong y):resty) =
        refsMatch x y && refsMatch restx resty
    refsMatch ((Strikeout x):restx) ((Strikeout y):resty) =
        refsMatch x y && refsMatch restx resty
    refsMatch ((Superscript x):restx) ((Superscript y):resty) =
        refsMatch x y && refsMatch restx resty
    refsMatch ((Subscript x):restx) ((Subscript y):resty) =
        refsMatch x y && refsMatch restx resty
    refsMatch ((SmallCaps x):restx) ((SmallCaps y):resty) =
        refsMatch x y && refsMatch restx resty
    refsMatch ((Quoted t x):restx) ((Quoted u y):resty) =
        t == u && refsMatch x y && refsMatch restx resty
    refsMatch ((Code x):restx) ((Code y):resty) =
        ((map toLower x) == (map toLower y)) && refsMatch restx resty
    refsMatch ((Math t x):restx) ((Math u y):resty) =
        ((map toLower x) == (map toLower y)) && t == u && refsMatch restx resty
    refsMatch ((TeX x):restx) ((TeX y):resty) =
        ((map toLower x) == (map toLower y)) && refsMatch restx resty
    refsMatch ((HtmlInline x):restx) ((HtmlInline y):resty) =
        ((map toLower x) == (map toLower y)) && refsMatch restx resty
    refsMatch (x:restx) (y:resty) = (x == y) && refsMatch restx resty
    refsMatch [] x = null x
    refsMatch x [] = null x