{-# LANGUAGE OverloadedRecordDot #-}

module Zettel.Common 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.Builder (HasMeta (..), ToMetaValue (..))
import Text.Pandoc.Definition (Inline (..), MetaValue (..), Pandoc (..))
import Text.Pandoc.Shared (stringify)
import Text.Pandoc.Walk (query, walk)
import Zettel.Types

trySet :: (HasMeta a, ToMetaValue b) => Text -> Maybe b -> a -> a
trySet t (Just b) a = setMeta t b a
trySet _ Nothing a = a

refreshPandocMetaZettel' :: (HasMeta a) => ZettelId -> Zettel -> a -> a
refreshPandocMetaZettel' zid z =
  trySet "modified" z.zettelMetadata.zettelModifiedDate
    . trySet "date" z.zettelMetadata.zettelCreationDate
    . trySet "author" z.zettelMetadata.zettelAuthor
    . setMeta "title" (MetaInlines z.zettelTitle)
    . setMeta "tags" z.zettelMetadata.zettelTags
    . setMeta "categories" z.zettelMetadata.zettelCats
    . setMeta "backlinks" z.zettelPrev
    . setMeta "forwardlinks" z.zettelNext
    . setMeta "zettelid" zid

clearPandocAttr :: Pandoc -> Pandoc
clearPandocAttr (Pandoc _ b) = Pandoc mempty b

refreshPandocMetaZettel :: ZettelId -> Zettel -> Zettel
refreshPandocMetaZettel zid z =
  z {zettelBody = refreshPandocMetaZettel' zid z . clearPandocAttr $ zettelBody z}

refreshPandocMeta :: ZettelGraph -> ZettelGraph
refreshPandocMeta zg = ZettelGraph (Map.mapWithKey refreshPandocMetaZettel zg.unZettelGraph)
  zg.zettelGraphBib

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

parseLink :: Text -> ZettelId
parseLink t = ZettelId $ parseIds ident
  where
    ident = T.takeWhile (']' /=) $ T.dropWhile ('#' /=) t