{-# LANGUAGE OverloadedStrings #-}

module Inf.Types where

import qualified Control.Exception as Exn
import qualified Data.Char as Char
import qualified Data.Text as T
import qualified Data.Time as Time
import qualified Database.SQLite.Simple as SQL
import qualified Database.SQLite.Simple.FromField as SQL
import qualified Database.SQLite.Simple.ToField as SQL

newtype PostId = PostId { fromPostId :: Int } deriving (Eq, Show)

instance SQL.FromField PostId where
  fromField f = PostId `fmap` SQL.fromField f

instance SQL.ToField PostId where
  toField = SQL.toField . fromPostId

newtype User = User { userName :: T.Text } deriving (Eq, Show)

instance SQL.FromField User where
  fromField f = User `fmap` SQL.fromField f

instance SQL.ToField User where
  toField = SQL.toField . userName

-- | A 'PostRef' is just the information needed to identify a post
-- internally, including when it was posted and its title and slug
data PostRef = PostRef
  { prYear  :: !Int
  , prMonth :: !Int
  , prSlug  :: !T.Text
  , prName  :: !T.Text
  , prDate  :: !Time.UTCTime
  } deriving Show

-- | A 'Post' is all the information needed to display a post in full,
-- including the raw Markdown of the post itself
data Post = Post
  { postId       :: !PostId
  , postDate     :: !Time.UTCTime
  , postTitle    :: !T.Text
  , postSlug     :: !T.Text
  , postContents :: !T.Text
  , postAuthor   :: !User
  , postNext     :: !(Maybe PostRef)
  , postPrev     :: !(Maybe PostRef)
  } deriving Show

-- | A 'RawPost' is the information needed to create a new post, and
-- thus may not have a post ID (as it might not have been submitted
-- yet!)
data RawPost = RawPost
  { rpId       :: !(Maybe PostId)
  , rpTitle    :: !T.Text
  , rpAuthor   :: !User
  , rpContents :: !T.Text
  } deriving Show

-- | A blank post for populating an editing field
emptyRawPost :: RawPost
emptyRawPost = RawPost
  { rpId       = Nothing
  , rpTitle    = ""
  , rpAuthor   = User { userName = "" }
  , rpContents = ""
  }

data Page = Page
  { pageName :: !T.Text
  , pageText :: !T.Text
  } deriving Show

instance SQL.FromRow Page where
  fromRow = uncurry Page <$> SQL.fromRow

data URL = URL
  { urlRelative :: !T.Text
  , urlAbsolute :: !T.Text
  } deriving Show


mkURL :: [T.Text] -> URL
mkURL path =
  let pathJoined = T.intercalate "/" path
      root       = "https://blog.infinitenegativeutility.com"
  in URL { urlRelative = T.cons '/' pathJoined
         , urlAbsolute = root `T.append` T.cons '/' pathJoined
         }


postDateT :: Post -> T.Text
postDateT Post { postDate = date } =
  T.pack (Time.formatTime
           Time.defaultTimeLocale
           Time.rfc822DateFormat
           date)


postURL :: Post -> T.Text
postURL Post { postDate = date, postSlug = slug } = do
  let (year, month, _) = Time.toGregorian (Time.utctDay date) in
    T.concat [ "/", T.pack (show year)
             , "/", T.pack (show month)
             , "/", slug
             ]


postRefDateT :: PostRef -> T.Text
postRefDateT PostRef { prDate = date } =
  T.pack (Time.formatTime
           Time.defaultTimeLocale
           "%Y-%m-%d"
           date)


postRefURL :: PostRef -> T.Text
postRefURL PostRef { prYear = year, prMonth = month, prSlug = slug } =
  T.concat [ "/", T.pack (show year)
           , "/", T.pack (show month)
           , "/", slug
           ]


slugify :: T.Text -> T.Text
slugify = T.map conv
  where
    conv c
      | Char.isAlphaNum c = Char.toLower c
      | otherwise = '-'


postToRawPost :: Post -> RawPost
postToRawPost p = RawPost
  { rpId       = Just (postId p)
  , rpTitle    = postTitle p
  , rpContents = postContents p
  , rpAuthor   = postAuthor p
  }


data DBException
  = MissingPost !PostId
  | MissingPage !T.Text
  | NoPostFound !T.Text !T.Text !T.Text
  | NonUniqueResult
  | BadUserError
  | NoSuchPost
  deriving (Eq, Show)

instance Exn.Exception DBException where

data Unimplemented = Unimplemented String
  deriving (Eq, Show)