content: {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE UndecidableInstances #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  module Commonmark.Extensions.AutoIdentifiers
    ( autoIdentifiersSpec
    , autoIdentifiersAsciiSpec
    )
  where
  import Commonmark.Types
  import Commonmark.Syntax
  import Commonmark.Blocks
  import Data.Char (isSpace, isAlphaNum, isAscii, isMark,
                    generalCategory, GeneralCategory(ConnectorPunctuation))
  import Data.Dynamic
  import qualified Data.Map as M
  import qualified Data.Text as T
  import qualified Text.Emoji as Emoji
  import Text.Parsec
  
  autoIdentifiersSpec :: (Monad m, IsBlock il bl, IsInline il, ToPlainText il)
                      => SyntaxSpec m il bl
  autoIdentifiersSpec = mempty
    { syntaxFinalParsers = [addAutoIdentifiers False]
    }
  
  autoIdentifiersAsciiSpec
                      :: (Monad m, IsBlock il bl, IsInline il, ToPlainText il)
                      => SyntaxSpec m il bl
  autoIdentifiersAsciiSpec = mempty
    { syntaxFinalParsers = [addAutoIdentifiers True]
    }
  
  -- Go through the node stack and add identifiers where they
  -- are missing.
  addAutoIdentifiers :: (Monad m, IsBlock il bl, IsInline il, ToPlainText il)
                     => Bool -> BlockParser m il bl bl
  addAutoIdentifiers ascii = do
    nodes <- nodeStack <$> getState
    nodes' <- mapM (traverse $ addId ascii) nodes
    updateState $ \st -> st{ nodeStack = nodes' }
    return $! mempty
  
  addId :: (Monad m, IsBlock il bl, IsInline il, ToPlainText il)
         => Bool -> BlockData m il bl -> BlockParser m il bl (BlockData m il bl)
  addId ascii bd
    | blockType (blockSpec bd) `elem` ["ATXHeading", "SetextHeading"] =
      case lookup "id" (blockAttributes bd) of
        Nothing  -> do
          contents <- runInlineParser
                      (removeIndent . mconcat . reverse . blockLines $ bd)
          let ident = makeIdentifier ascii
                       (Emoji.replaceEmojis emojiToAlias $ toPlainText contents)
          counterMap <- counters <$> getState
          let key = "identifier:" <> ident
          cnt <- case M.lookup key counterMap of
                      Nothing -> return 0
                      Just x  -> return $! (fromDyn x (0 :: Int) + 1)
          let ident' = if cnt == 0
                          then ident
                          else ident <> "-" <> T.pack (show cnt)
          updateState $ \st ->
            st{ counters = M.insert key (toDyn cnt) counterMap }
          return $! bd{ blockAttributes = ("id",ident') : blockAttributes bd }
        Just _ -> return $! bd
    | otherwise = return $! bd
  
  emojiToAlias :: T.Text -> [T.Text] -> T.Text
  emojiToAlias t [] = t
  emojiToAlias _ (a:_) = a
  
  makeIdentifier :: Bool -> T.Text -> T.Text
  makeIdentifier ascii = toIdent . T.toLower
    where
      toIdent = T.concatMap f
      f '-' = "-"
      f '_' = "_"
      f c | isSpace c = "-"
      f c | isAlphaNum c || isMark c ||
            generalCategory c == ConnectorPunctuation
                      = fromchar c
          | otherwise = mempty
      fromchar c
        | ascii =
          if isAscii c
             then T.singleton c
             else case M.lookup c asciiMap of
                         Nothing -> mempty
                         Just d -> T.singleton d
        | otherwise = T.singleton c
  
  asciiMap :: M.Map Char Char
  asciiMap = M.fromList
    [('\192','A')
    ,('\193','A')
    ,('\194','A')
    ,('\195','A')
    ,('\196','A')
    ,('\197','A')
    ,('\199','C')
    ,('\200','E')
    ,('\201','E')
    ,('\202','E')
    ,('\203','E')
    ,('\204','I')
    ,('\205','I')
    ,('\206','I')
    ,('\207','I')
    ,('\209','N')
    ,('\210','O')
    ,('\211','O')
    ,('\212','O')
    ,('\213','O')
    ,('\214','O')
    ,('\217','U')
    ,('\218','U')
    ,('\219','U')
    ,('\220','U')
    ,('\221','Y')
    ,('\224','a')
    ,('\225','a')
    ,('\226','a')
    ,('\227','a')
    ,('\228','a')
    ,('\229','a')
    ,('\231','c')
    ,('\232','e')
    ,('\233','e')
    ,('\234','e')
    ,('\235','e')
    ,('\236','i')
    ,('\237','i')
    ,('\238','i')
    ,('\239','i')
    ,('\241','n')
    ,('\242','o')
    ,('\243','o')
    ,('\244','o')
    ,('\245','o')
    ,('\246','o')
    ,('\249','u')
    ,('\250','u')
    ,('\251','u')
    ,('\252','u')
    ,('\253','y')
    ,('\255','y')
    ,('\256','A')
    ,('\257','a')
    ,('\258','A')
    ,('\259','a')
    ,('\260','A')
    ,('\261','a')
    ,('\262','C')
    ,('\263','c')
    ,('\264','C')
    ,('\265','c')
    ,('\266','C')
    ,('\267','c')
    ,('\268','C')
    ,('\269','c')
    ,('\270','D')
    ,('\271','d')
    ,('\274','E')
    ,('\275','e')
    ,('\276','E')
    ,('\277','e')
    ,('\278','E')
    ,('\279','e')
    ,('\280','E')
    ,('\281','e')
    ,('\282','E')
    ,('\283','e')
    ,('\284','G')
    ,('\285','g')
    ,('\286','G')
    ,('\287','g')
    ,('\288','G')
    ,('\289','g')
    ,('\290','G')
    ,('\291','g')
    ,('\292','H')
    ,('\293','h')
    ,('\296','I')
    ,('\297','i')
    ,('\298','I')
    ,('\299','i')
    ,('\300','I')
    ,('\301','i')
    ,('\302','I')
    ,('\303','i')
    ,('\304','I')
    ,('\305','i')
    ,('\308','J')
    ,('\309','j')
    ,('\310','K')
    ,('\311','k')
    ,('\313','L')
    ,('\314','l')
    ,('\315','L')
    ,('\316','l')
    ,('\317','L')
    ,('\318','l')
    ,('\323','N')
    ,('\324','n')
    ,('\325','N')
    ,('\326','n')
    ,('\327','N')
    ,('\328','n')
    ,('\332','O')
    ,('\333','o')
    ,('\334','O')
    ,('\335','o')
    ,('\336','O')
    ,('\337','o')
    ,('\340','R')
    ,('\341','r')
    ,('\342','R')
    ,('\343','r')
    ,('\344','R')
    ,('\345','r')
    ,('\346','S')
    ,('\347','s')
    ,('\348','S')
    ,('\349','s')
    ,('\350','S')
    ,('\351','s')
    ,('\352','S')
    ,('\353','s')
    ,('\354','T')
    ,('\355','t')
    ,('\356','T')
    ,('\357','t')
    ,('\360','U')
    ,('\361','u')
    ,('\362','U')
    ,('\363','u')
    ,('\364','U')
    ,('\365','u')
    ,('\366','U')
    ,('\367','u')
    ,('\368','U')
    ,('\369','u')
    ,('\370','U')
    ,('\371','u')
    ,('\372','W')
    ,('\373','w')
    ,('\374','Y')
    ,('\375','y')
    ,('\376','Y')
    ,('\377','Z')
    ,('\378','z')
    ,('\379','Z')
    ,('\380','z')
    ,('\381','Z')
    ,('\382','z')
    ,('\416','O')
    ,('\417','o')
    ,('\431','U')
    ,('\432','u')
    ,('\461','A')
    ,('\462','a')
    ,('\463','I')
    ,('\464','i')
    ,('\465','O')
    ,('\466','o')
    ,('\467','U')
    ,('\468','u')
    ,('\486','G')
    ,('\487','g')
    ,('\488','K')
    ,('\489','k')
    ,('\490','O')
    ,('\491','o')
    ,('\496','j')
    ,('\500','G')
    ,('\501','g')
    ,('\504','N')
    ,('\505','n')
    ,('\512','A')
    ,('\513','a')
    ,('\514','A')
    ,('\515','a')
    ,('\516','E')
    ,('\517','e')
    ,('\518','E')
    ,('\519','e')
    ,('\520','I')
    ,('\521','i')
    ,('\522','I')
    ,('\523','i')
    ,('\524','O')
    ,('\525','o')
    ,('\526','O')
    ,('\527','o')
    ,('\528','R')
    ,('\529','r')
    ,('\530','R')
    ,('\531','r')
    ,('\532','U')
    ,('\533','u')
    ,('\534','U')
    ,('\535','u')
    ,('\536','S')
    ,('\537','s')
    ,('\538','T')
    ,('\539','t')
    ,('\542','H')
    ,('\543','h')
    ,('\550','A')
    ,('\551','a')
    ,('\552','E')
    ,('\553','e')
    ,('\558','O')
    ,('\559','o')
    ,('\562','Y')
    ,('\563','y')
    ,('\894',';')
    ,('\7680','A')
    ,('\7681','a')
    ,('\7682','B')
    ,('\7683','b')
    ,('\7684','B')
    ,('\7685','b')
    ,('\7686','B')
    ,('\7687','b')
    ,('\7690','D')
    ,('\7691','d')
    ,('\7692','D')
    ,('\7693','d')
    ,('\7694','D')
    ,('\7695','d')
    ,('\7696','D')
    ,('\7697','d')
    ,('\7698','D')
    ,('\7699','d')
    ,('\7704','E')
    ,('\7705','e')
    ,('\7706','E')
    ,('\7707','e')
    ,('\7710','F')
    ,('\7711','f')
    ,('\7712','G')
    ,('\7713','g')
    ,('\7714','H')
    ,('\7715','h')
    ,('\7716','H')
    ,('\7717','h')
    ,('\7718','H')
    ,('\7719','h')
    ,('\7720','H')
    ,('\7721','h')
    ,('\7722','H')
    ,('\7723','h')
    ,('\7724','I')
    ,('\7725','i')
    ,('\7728','K')
    ,('\7729','k')
    ,('\7730','K')
    ,('\7731','k')
    ,('\7732','K')
    ,('\7733','k')
    ,('\7734','L')
    ,('\7735','l')
    ,('\7738','L')
    ,('\7739','l')
    ,('\7740','L')
    ,('\7741','l')
    ,('\7742','M')
    ,('\7743','m')
    ,('\7744','M')
    ,('\7745','m')
    ,('\7746','M')
    ,('\7747','m')
    ,('\7748','N')
    ,('\7749','n')
    ,('\7750','N')
    ,('\7751','n')
    ,('\7752','N')
    ,('\7753','n')
    ,('\7754','N')
    ,('\7755','n')
    ,('\7764','P')
    ,('\7765','p')
    ,('\7766','P')
    ,('\7767','p')
    ,('\7768','R')
    ,('\7769','r')
    ,('\7770','R')
    ,('\7771','r')
    ,('\7774','R')
    ,('\7775','r')
    ,('\7776','S')
    ,('\7777','s')
    ,('\7778','S')
    ,('\7779','s')
    ,('\7786','T')
    ,('\7787','t')
    ,('\7788','T')
    ,('\7789','t')
    ,('\7790','T')
    ,('\7791','t')
    ,('\7792','T')
    ,('\7793','t')
    ,('\7794','U')
    ,('\7795','u')
    ,('\7796','U')
    ,('\7797','u')
    ,('\7798','U')
    ,('\7799','u')
    ,('\7804','V')
    ,('\7805','v')
    ,('\7806','V')
    ,('\7807','v')
    ,('\7808','W')
    ,('\7809','w')
    ,('\7810','W')
    ,('\7811','w')
    ,('\7812','W')
    ,('\7813','w')
    ,('\7814','W')
    ,('\7815','w')
    ,('\7816','W')
    ,('\7817','w')
    ,('\7818','X')
    ,('\7819','x')
    ,('\7820','X')
    ,('\7821','x')
    ,('\7822','Y')
    ,('\7823','y')
    ,('\7824','Z')
    ,('\7825','z')
    ,('\7826','Z')
    ,('\7827','z')
    ,('\7828','Z')
    ,('\7829','z')
    ,('\7830','h')
    ,('\7831','t')
    ,('\7832','w')
    ,('\7833','y')
    ,('\7840','A')
    ,('\7841','a')
    ,('\7842','A')
    ,('\7843','a')
    ,('\7864','E')
    ,('\7865','e')
    ,('\7866','E')
    ,('\7867','e')
    ,('\7868','E')
    ,('\7869','e')
    ,('\7880','I')
    ,('\7881','i')
    ,('\7882','I')
    ,('\7883','i')
    ,('\7884','O')
    ,('\7885','o')
    ,('\7886','O')
    ,('\7887','o')
    ,('\7908','U')
    ,('\7909','u')
    ,('\7910','U')
    ,('\7911','u')
    ,('\7922','Y')
    ,('\7923','y')
    ,('\7924','Y')
    ,('\7925','y')
    ,('\7926','Y')
    ,('\7927','y')
    ,('\7928','Y')
    ,('\7929','y')
    ,('\8175','`')
    ,('\8490','K')
    ,('\8800','=')
    ,('\8814','<')
    ,('\8815','>')
    ]
  