{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
module Commonmark.ReferenceMap
  ( ReferenceMap(..)
  , LinkInfo(..)
  , emptyReferenceMap
  , insertReference
  , lookupReference
  ) where
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Map.Strict as M
import Data.Dynamic
import Commonmark.Types
#if !MIN_VERSION_base(4,13,0)
import Data.Typeable (Typeable)
#endif

-- | Lookup table for link references.
newtype ReferenceMap = ReferenceMap { ReferenceMap -> Map Text [Dynamic]
unReferenceMap :: M.Map Text [Dynamic] }
  deriving (Int -> ReferenceMap -> ShowS
[ReferenceMap] -> ShowS
ReferenceMap -> String
(Int -> ReferenceMap -> ShowS)
-> (ReferenceMap -> String)
-> ([ReferenceMap] -> ShowS)
-> Show ReferenceMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReferenceMap -> ShowS
showsPrec :: Int -> ReferenceMap -> ShowS
$cshow :: ReferenceMap -> String
show :: ReferenceMap -> String
$cshowList :: [ReferenceMap] -> ShowS
showList :: [ReferenceMap] -> ShowS
Show)

data LinkInfo = LinkInfo{ LinkInfo -> Text
linkDestination :: !Text
                        , LinkInfo -> Text
linkTitle       :: !Text
                        , LinkInfo -> Attributes
linkAttributes  :: !Attributes
                        , LinkInfo -> Maybe SourcePos
linkPos         :: !(Maybe SourcePos)
                            -- ^ Position of the reference link definition
                            -- for references links.
                        }
     deriving (Int -> LinkInfo -> ShowS
[LinkInfo] -> ShowS
LinkInfo -> String
(Int -> LinkInfo -> ShowS)
-> (LinkInfo -> String) -> ([LinkInfo] -> ShowS) -> Show LinkInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinkInfo -> ShowS
showsPrec :: Int -> LinkInfo -> ShowS
$cshow :: LinkInfo -> String
show :: LinkInfo -> String
$cshowList :: [LinkInfo] -> ShowS
showList :: [LinkInfo] -> ShowS
Show, Typeable)

emptyReferenceMap :: ReferenceMap
emptyReferenceMap :: ReferenceMap
emptyReferenceMap = Map Text [Dynamic] -> ReferenceMap
ReferenceMap Map Text [Dynamic]
forall k a. Map k a
M.empty

-- | Insert a link reference into a reference map.
insertReference :: Typeable a
                => Text -- ^ Reference label
                -> a
                -> ReferenceMap
                -> ReferenceMap
insertReference :: forall a. Typeable a => Text -> a -> ReferenceMap -> ReferenceMap
insertReference Text
label a
x (ReferenceMap Map Text [Dynamic]
m) =
  Map Text [Dynamic] -> ReferenceMap
ReferenceMap (([Dynamic] -> [Dynamic] -> [Dynamic])
-> Text -> [Dynamic] -> Map Text [Dynamic] -> Map Text [Dynamic]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (([Dynamic] -> [Dynamic] -> [Dynamic])
-> [Dynamic] -> [Dynamic] -> [Dynamic]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Dynamic] -> [Dynamic] -> [Dynamic]
forall a. [a] -> [a] -> [a]
(++))
    (Text -> Text
T.toCaseFold (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$! Text -> Text
normalizeSpaces Text
label) [a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn a
x] Map Text [Dynamic]
m)

-- | Lookup a reference in a reference map.  If there are several
-- values at this key, we return the first one in the list that
-- can be converted to an 'a'.
lookupReference :: Typeable a
                => Text -- ^ Reference label
                -> ReferenceMap
                -> Maybe a
lookupReference :: forall a. Typeable a => Text -> ReferenceMap -> Maybe a
lookupReference Text
label (ReferenceMap Map Text [Dynamic]
m) =
  Maybe [Dynamic] -> Maybe a
forall {a}. Typeable a => Maybe [Dynamic] -> Maybe a
getFirst (Maybe [Dynamic] -> Maybe a) -> Maybe [Dynamic] -> Maybe a
forall a b. (a -> b) -> a -> b
$! Text -> Map Text [Dynamic] -> Maybe [Dynamic]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Text
T.toCaseFold (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$! Text -> Text
normalizeSpaces Text
label) Map Text [Dynamic]
m
  where getFirst :: Maybe [Dynamic] -> Maybe a
getFirst Maybe [Dynamic]
Nothing       = Maybe a
forall a. Maybe a
Nothing
        getFirst (Just [])     = Maybe a
forall a. Maybe a
Nothing
        getFirst (Just (Dynamic
x:[Dynamic]
xs)) = case Dynamic -> Maybe a
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
x of
                                      Just !a
v  -> a -> Maybe a
forall a. a -> Maybe a
Just a
v
                                      Maybe a
Nothing  -> Maybe [Dynamic] -> Maybe a
getFirst ([Dynamic] -> Maybe [Dynamic]
forall a. a -> Maybe a
Just [Dynamic]
xs)

normalizeSpaces :: Text -> Text
normalizeSpaces :: Text -> Text
normalizeSpaces = [Text] -> Text
T.unwords ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words