{-# LANGUAGE OverloadedRecordDot #-}

module Zettel.Links where

import Data.Char (isAlphaNum, isLetter, isNumber)
import Data.List (nub)
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import Data.Text.Read (decimal)
import Numeric (readInt, showIntAtBase)
import Text.Pandoc.Definition (Inline (..), Pandoc (..))
import Text.Pandoc.Shared (stringify)
import Text.Pandoc.Walk (query, walk)
import Zettel.Common
import Zettel.Types

parseIds :: Text -> Text
parseIds t
  | T.null t = ""
  | T.head t == '#' && T.all isAlphaNum (T.tail t) = T.tail t
  | otherwise = ""

splitId :: ZettelId -> [Text]
splitId (ZettelId zid)
  | T.null zid = []
  | isNumber (T.head zid) = T.takeWhile isNumber zid : (splitId . ZettelId $ T.dropWhile isNumber zid)
  | isLetter (T.head zid) = T.takeWhile isLetter zid : (splitId . ZettelId $ T.dropWhile isLetter zid)
  | otherwise = []

combineId :: [Text] -> ZettelId
combineId = ZettelId . fold

intToDigit26 :: Int -> Char
intToDigit26 i
  | i <= 25 && i >= 0 = toEnum $ fromEnum 'a' + i
  | otherwise = error "Integer out of range."

digitToInt26 :: Char -> Int
digitToInt26 c = fromEnum c - fromEnum 'a'

fromBase :: Int -> String -> Maybe Int
fromBase base = fmap fst . viaNonEmpty head . readInt base ((< base) . digitToInt26) digitToInt26

toBase :: Int -> Int -> String
toBase base num = showIntAtBase base intToDigit26 num ""

opOnBase26 :: (Int -> Int) -> Text -> Maybe Text
opOnBase26 f t =
  fromString . toBase 26 . f <$> fromBase 26 (toString t)

opOnIdPart :: (Int -> Int) -> Text -> Maybe Text
opOnIdPart f t
  | T.null t = Nothing
  | isNumber $ T.head t =
      case decimal t of
        Right (a, _) -> Just . show $ f a
        _ -> Nothing
  | isLetter $ T.head t = opOnBase26 f t
  | otherwise = Nothing

defPredId :: ZettelId -> Maybe ZettelId
defPredId z =
  case nonEmpty (splitId z) of
    Just ne ->
      if last ne == "a" || last ne == "1"
        then Just (combineId (init ne))
        else combineId . (init ne <>) . (: []) <$> opOnIdPart (subtract 1) (last ne)
    Nothing -> Nothing

defNextId :: ZettelId -> Maybe ZettelId
defNextId z =
  case nonEmpty (splitId z) of
    Just ne ->
      combineId . (init ne <>) . (: []) <$> opOnIdPart (+ 1) (last ne)
    Nothing -> Nothing

defBranchId :: ZettelId -> Maybe ZettelId
defBranchId (ZettelId t)
  | T.null t = Nothing
  | isNumber $ T.last t = Just (ZettelId (t <> "a"))
  | isLetter $ T.last t = Just (ZettelId (t <> "1"))
  | otherwise = Nothing

gatherForwardIds :: Inline -> [ZettelId]
gatherForwardIds (Link _ i _) = [ZettelId . parseIds $ stringify i]
gatherForwardIds _ = []

addIdPresent :: ZettelGraph -> Maybe ZettelId -> [ZettelId]
addIdPresent zg (Just ident) =
  [ident | ident `elem` Map.keys (unZettelGraph zg)]
addIdPresent _ Nothing = []

forwardLinkNode :: ZettelGraph -> ZettelId -> Zettel -> Zettel
forwardLinkNode zg ident zn =
  zn
    { zettelNext =
        nub
          ( query gatherForwardIds zn.zettelBody
              <> addIdPresent zg (defNextId ident)
              <> addIdPresent zg (defBranchId ident)
          )
    }

forwardLink :: ZettelGraph -> ZettelGraph
forwardLink zg = ZettelGraph . Map.mapWithKey (forwardLinkNode zg) $ unZettelGraph zg

backwardLinkNode :: ZettelGraph -> ZettelId -> Zettel -> Zettel
backwardLinkNode graph ident node = Map.foldlWithKey' f node (unZettelGraph graph)
  where
    f :: Zettel -> ZettelId -> Zettel -> Zettel
    f l ident' zg
      | ident `elem` zg.zettelNext =
          l {zettelPrev = ident' : l.zettelPrev}
      | otherwise = l

backwardLink :: ZettelGraph -> ZettelGraph
backwardLink zg = ZettelGraph . Map.mapWithKey (backwardLinkNode zg) $ unZettelGraph zg

updatePandocLinksInline :: Inline -> Inline
updatePandocLinksInline l@(Link a i (_, t))
  | not $ T.null ids = Link a i ("/tree/" <> ids, t)
  | otherwise = l
  where
    ids = parseIds $ stringify i
updatePandocLinksInline i = i

updatePandocLinksPandoc :: Pandoc -> Pandoc
updatePandocLinksPandoc = walk updatePandocLinksInline

updatePandocLinksZettel :: Zettel -> Zettel
updatePandocLinksZettel zg =
  zg {zettelBody = updatePandocLinksPandoc (zettelBody zg)}

updatePandocLinks :: ZettelGraph -> ZettelGraph
updatePandocLinks zg = ZettelGraph $ updatePandocLinksZettel <$> unZettelGraph zg

linkAll :: ZettelGraph -> ZettelGraph
linkAll = refreshPandocMeta . backwardLink . forwardLink . updatePandocLinks