{-# LANGUAGE OverloadedRecordDot #-}

-- |
-- Module      : Zettel.Common
-- Description : Shared functions used throughout the project
-- Copyright   : (c) 2023, Yann Herklotz
-- License     : GPL-3.0-only
-- Maintainer  : git [at] yannherklotz [dot] com
-- Stability   : experimental
-- Portability : POSIX
module Zettel.Common where

import Data.Char (isAlphaNum, isLetter, isNumber)
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 (..), Meta (..), MetaValue (..), Pandoc (..))
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

metaToString :: MetaValue -> Maybe Text
metaToString (MetaString t) = Just t
metaToString _ = Nothing

metaToInlines :: MetaValue -> Maybe [Inline]
metaToInlines (MetaInlines t) = Just t
metaToInlines _ = Nothing

metaToTextList :: MetaValue -> Maybe [Text]
metaToTextList (MetaList t) = traverse metaToString t
metaToTextList _ = Nothing

lookupString :: Text -> Meta -> Maybe Text
lookupString t m = Map.lookup t (unMeta m) >>= metaToString

lookupInlines :: Text -> Meta -> Maybe [Inline]
lookupInlines t m = Map.lookup t (unMeta m) >>= metaToInlines

lookupTextList :: Text -> Meta -> Maybe [Text]
lookupTextList t m = Map.lookup t (unMeta m) >>= metaToTextList