module Zettel.Parse where

import Data.Default (def)
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import Text.Pandoc.Builder (toMetaValue)
import Text.Pandoc.Chunks (Chunk (..), ChunkedDoc (..), splitIntoChunks)
import Text.Pandoc.Class (runIOorExplode)
import Text.Pandoc.Definition (Block (..), Inline (..), Meta (..), MetaValue (..), Pandoc (..))
import Text.Pandoc.Options (ReaderOptions (..), getDefaultExtensions)
import Text.Pandoc.Readers (readOrg)
import Text.Pandoc.Shared (stringify)
import Text.Pandoc.Walk (query, walk)
import System.FilePath (takeBaseName)
import Zettel.Common
import Zettel.Types

decode :: ByteString -> Text
decode = decodeUtf8

removeHeadings :: Block -> Block
removeHeadings Header {} = Plain []
removeHeadings a = a

removeDiv :: [Block] -> [Block]
removeDiv = concatMap removeDiv'
  where
    removeDiv' (Div _ b') = b'
    removeDiv' a = [a]

queryHeaderMetaData :: [Block] -> [(Text, MetaValue)]
queryHeaderMetaData = query headingAttr
  where
    headingAttr (Header _ (_, _, l) i) =
      map (bimap exportDate MetaString) l
        <> [ ("title", MetaInlines i),
             ("author", MetaInlines [Str "Yann", Space, Str "Herklotz"])
           ]
    headingAttr _ = []
    exportDate s
      | s == "export_date" = "date"
      | otherwise = s

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

removeSpan :: [Inline] -> [Inline]
removeSpan = concatMap removeSpan'
  where
    removeSpan' (Span _ _) = []
    removeSpan' a = [a]

removeMathNL :: Inline -> Inline
removeMathNL (Math mt t) = Math mt . fold $ T.lines t
removeMathNL a = a

separateTitleTags :: [Inline] -> ([Inline], [ZettelTag])
separateTitleTags title =
  (walk removeSpan $ filter (not . isTagSpan) title, map (ZettelTag . stringify) $ filter isTagSpan title)
  where
    isTagSpan (Span (_, l, _) _) = "tag" `elem` l
    isTagSpan _ = False

parseDate :: Text -> Maybe Text
parseDate t
  | T.null t = Just t
  | T.head t == '[' = viaNonEmpty head . T.words $ T.tail t
  | otherwise = Just t

parseDateVal :: MetaValue -> Maybe MetaValue
parseDateVal v = MetaString <$> (metaToString v >>= parseDate)

zettelMetaFromMeta :: [ZettelTag] -> [ZettelCat] -> Meta -> ZettelMetadata
zettelMetaFromMeta t c m =
  ZettelMetadata
    (lookupString "date" m)
    (lookupString "modified" m)
    t
    c
    (Just "Yann Herklotz")

pandocFromChunk :: (Int, Text, Chunk) -> Pandoc
pandocFromChunk (_, t, c) =
  walk removeMathNL
    . walk removeDiv
    . walk removeHeadings
    . Pandoc
      (Meta (fromList (("categories", toMetaValue [t])
                       : ("zettelid", MetaString (chunkId c))
                       : headingMeta)))
    $ chunkContents c
  where
    headingMeta = queryHeaderMetaData $ chunkContents c

zettelFromPandoc :: Pandoc -> (ZettelId, Zettel)
zettelFromPandoc p@(Pandoc attr _) =
  (ZettelId ident, Zettel title (zettelMetaFromMeta tags cats attr) p cempty cempty)
  where
    ident = fromMaybe "" $ lookupString "zettelid" attr
    title = fromMaybe [] $ lookupInlines "title" attr
    tags = maybe [] (map ZettelTag) $ lookupTextList "tags" attr
    cats = maybe [] (map ZettelCat) $ lookupTextList "categories" attr

updatePandocAttr :: Pandoc -> Pandoc
updatePandocAttr (Pandoc attr b) =
  Pandoc
    ( Meta
        ( Map.insert
            "tags"
            tags
            . Map.insert
              "title"
              (MetaInlines title')
            . Map.update
              parseDateVal
              "modified"
            . Map.update parseDateVal "date"
            $ unMeta attr
        )
    )
    b
  where
    tags = toMetaValue $ map unZettelTag tags'
    (title', tags') = maybe ([], []) separateTitleTags $ lookupInlines "title" attr

propagateNames :: [((Int, Text), [Chunk])] -> [(Int, Text, Chunk)]
propagateNames n =
  [(i, name, chunk) | ((i, name), namedChunk) <- n, chunk <- namedChunk]

parseZettelKasten :: [(Int, FilePath)] -> IO ZettelGraph
parseZettelKasten fl = do
  let names = map (second (T.pack . takeBaseName)) fl
  fs <- mapM (readFileBS . snd) fl
  orgFiles <- mapM (runIOorExplode . readOrg (def {readerExtensions = getDefaultExtensions "org"}) . decode) fs
  let splitChunks = map (splitIntoChunks "%i.md" False Nothing 15) orgFiles
  let chunks = propagateNames . zip names $ map chunkedChunks splitChunks
  let pandocList = map (updatePandocAttr . pandocFromChunk) chunks
  return . refreshPandocMeta . ZettelGraph . fromList $ map zettelFromPandoc pandocList