{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module Noli.Types
  ( Settings (..),
    Post (..),
    Project (..),
    Page (..),
    PostTemplate,
    FrontMatter (..),
  )
where

import Data.Aeson
import Data.Text
import GHC.Generics
import Lucid.Base

-- | The "dynamic" representation of the static site
data Project
  = Project
      { posts :: [Post],
        pages :: [Page]
      }

data Settings
  = Settings
      { -- | The name of the site
        name :: Text,
        -- | The author's full name
        author :: Text,
        -- | The path to the folder that contains the markdown files
        posts_location :: FilePath,
        -- | The path to where the compiled static site will be saved
        dist_location :: FilePath,
        -- | The path to the static folder
        static_location :: FilePath
      }

newtype FrontMatter
  = FrontMatter
      { frontmatter_title :: Text
      }
  deriving (Show, Generic, ToJSON)

instance FromJSON FrontMatter where
  parseJSON = withObject "FrontMatter" $ \obj -> do
    frontmatter_title <- obj .: "title"
    return (FrontMatter frontmatter_title)

data Post
  = Post
      { title :: Text,
        location :: FilePath,
        filename :: Text,
        raw :: Text,
        raw_html :: Text,
        compiled_html :: Html ()
      }
  deriving (Show)

data Page = Page {pagename :: Text, template :: Html ()}

type PostTitle = Text

type PostBody = Text

type PostTemplate = PostTitle -> PostBody -> Html ()