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 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

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

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] -> Meta -> ZettelMetadata
zettelMetaFromMeta t m =
  ZettelMetadata
    (lookupString "date" m)
    (lookupString "modified" m)
    t
    cempty
    (Just "Yann Herklotz")

pandocFromChunk :: Chunk -> Pandoc
pandocFromChunk c =
  walk removeMathNL
    . walk removeDiv
    . walk removeHeadings
    . Pandoc
      (Meta (fromList (("custom_id", 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 attr) p cempty cempty)
  where
    ident = fromMaybe "" $ lookupString "custom_id" attr
    (title, tags) = maybe ([], []) separateTitleTags $ lookupInlines "title" attr

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

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