{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}

-- |
-- Module      : Zettel.Types
-- Description : Type definitions of ZettelGraph
-- Copyright   : (c) 2023, Yann Herklotz
-- License     : GPL-3.0-only
-- Maintainer  : git [at] yannherklotz [dot] com
-- Stability   : experimental
-- Portability : POSIX
module Zettel.Types
  ( Combine (..),
    UseCombine (..),
    ZettelId (..),
    ZettelCat (..),
    ZettelTag (..),
    ZettelMetadata (..),
    Zettel (..),
    ZettelGraph (..),
    BibId (..),
  )
where

import Text.Pandoc.Builder (ToMetaValue (..))
import Text.Pandoc.Definition (Block (..), Inline (..), Meta (..), MetaValue (..), Pandoc (..))
import Text.Pandoc.Walk (Walkable (..))

class Combine a where
  cappend :: a -> a -> a
  cempty :: a

newtype UseCombine a = UC a

instance (Monoid a) => Combine (UseCombine a) where
  cappend (UC a) (UC b) = UC $ a <> b
  cempty = UC mempty

deriving via (UseCombine Text) instance Combine Text

deriving via (UseCombine Pandoc) instance Combine Pandoc

deriving via (UseCombine [a]) instance Combine [a]

instance Combine (Maybe a) where
  cappend Nothing a = a
  cappend a _ = a

  cempty = Nothing

-- | The ZettelId is just Text, however, it should also be possible to convert
-- it to a list of the ID split up into it's parts.
newtype ZettelId = ZettelId {unZettelId :: Text}
  deriving (Show, Eq, Ord, IsString, ToString, Semigroup, Monoid, ToMetaValue)
  deriving (Combine) via (UseCombine ZettelId)

newtype BibId = BibId {unBibId :: Text}
  deriving (Show, Eq, Ord, IsString, ToString, Semigroup, Monoid, ToMetaValue)
  deriving (Combine) via (UseCombine BibId)

newtype ZettelTag = ZettelTag {unZettelTag :: Text}
  deriving (Show, Eq, Ord, IsString, ToString, Semigroup, Monoid, ToMetaValue)
  deriving (Combine) via (UseCombine ZettelId)

newtype ZettelCat = ZettelCat {unZettelCat :: Text}
  deriving (Show, Eq, Ord, IsString, ToString, Semigroup, Monoid, ToMetaValue)
  deriving (Combine) via (UseCombine ZettelId)

data ZettelMetadata = ZettelMetadata
  { -- | Optional creation date of the Zettel.
    zettelCreationDate :: Maybe Text,
    -- | Optional last modified date of the Zettel.
    zettelModifiedDate :: Maybe Text,
    -- | Optional tags.
    zettelTags :: [ZettelTag],
    -- | Optional Category
    zettelCats :: [ZettelCat],
    -- | Author
    zettelAuthor :: Maybe Text
  }
  deriving (Show, Eq)

instance Combine ZettelMetadata where
  cappend (ZettelMetadata c m t a b) (ZettelMetadata c' m' t' a' b') =
    ZettelMetadata (cappend c c') (cappend m m') (cappend t t') (cappend a a') (cappend b b')

  cempty = ZettelMetadata cempty cempty cempty cempty cempty

data Zettel = Zettel
  { -- | The title of the Zettel, which should also be present in the body,
    -- however, this is useful to gather metadata about the Zettel.
    zettelTitle :: ![Inline],
    -- | Zettel metadata which is mostly optional.
    zettelMetadata :: ZettelMetadata,
    -- | The text body of the Zettel, which is stored as a Pandoc document to
    -- make it easy to export to other documents.
    zettelBody :: Pandoc,
    zettelNext :: [ZettelId],
    zettelPrev :: [ZettelId]
  }
  deriving (Show, Eq)

instance Combine Zettel where
  cappend (Zettel b c d e f) (Zettel b' c' d' e' f') =
    Zettel (cappend b b') (cappend c c') (cappend d d') (cappend e e') (cappend f f')

  cempty = Zettel cempty cempty cempty cempty cempty

walkMZettel ::
  (Walkable a Pandoc, Monad m, Applicative m, Functor m) =>
  (a -> m a) ->
  Zettel ->
  m Zettel
walkMZettel f b = do
  res <- walkM f (zettelBody b)
  return b {zettelBody = res}

queryZettel ::
  (Walkable a Pandoc, Monoid c) => (a -> c) -> Zettel -> c
queryZettel f = query f . zettelBody

instance Walkable Block Zettel where
  walkM = walkMZettel
  query = queryZettel

instance Walkable Meta Zettel where
  walkM = walkMZettel
  query = queryZettel

instance Walkable [Block] Zettel where
  walkM = walkMZettel
  query = queryZettel

instance Walkable Pandoc Zettel where
  walkM = walkMZettel
  query = queryZettel

instance Walkable Inline Zettel where
  walkM = walkMZettel
  query = queryZettel

instance Walkable MetaValue Zettel where
  walkM = walkMZettel
  query = queryZettel

instance Walkable [Inline] Zettel where
  walkM = walkMZettel
  query = queryZettel

data ZettelGraph = ZettelGraph
  { unZettelGraph :: Map ZettelId Zettel,
    zettelGraphBib :: Map BibId Zettel
  }
  deriving (Show, Eq)

walkMZettelGraph ::
  (Walkable a Pandoc, Walkable a Zettel, Monad m, Applicative m, Functor m) =>
  (a -> m a) ->
  ZettelGraph ->
  m ZettelGraph
walkMZettelGraph f b = do
  res <- walkM f (unZettelGraph b)
  newBib <- walkM f (zettelGraphBib b)
  return $ ZettelGraph res newBib

queryZettelGraph ::
  (Monoid a1, Walkable a2 Zettel, Walkable a2 Pandoc) =>
  (a2 -> a1) ->
  ZettelGraph ->
  a1
queryZettelGraph f g = query f (unZettelGraph g) <> query f (zettelGraphBib g)

instance Walkable Block ZettelGraph where
  walkM = walkMZettelGraph
  query = queryZettelGraph

instance Walkable Meta ZettelGraph where
  walkM = walkMZettelGraph
  query = queryZettelGraph

instance Walkable [Block] ZettelGraph where
  walkM = walkMZettelGraph
  query = queryZettelGraph

instance Walkable Pandoc ZettelGraph where
  walkM = walkMZettelGraph
  query = queryZettelGraph

instance Walkable Inline ZettelGraph where
  walkM = walkMZettelGraph
  query = queryZettelGraph

instance Walkable MetaValue ZettelGraph where
  walkM = walkMZettelGraph
  query = queryZettelGraph

instance Walkable [Inline] ZettelGraph where
  walkM = walkMZettelGraph
  query = queryZettelGraph