-- | Database interaction
module DB where

import GHC.Stack (HasCallStack)
import Data.Text qualified as T
import Database.Sqlite.Easy qualified as DB
import Text.RawString.QQ
import Fedi

-----------------------
-- * Database handler API

data DB
  = DB
    { getNotes :: IO [Note]
    , insertNote :: NoteEntry -> IO NoteId
    }

-- * Data types

data NoteEntry
  = NoteEntry
    { inReplyTo :: Maybe Url
    , content :: T.Text
    , name :: Maybe String
    , url :: Maybe Url
    }

-----------------------
-- * Handler smart constructor

mkDB :: DB.ConnectionString -> UserDetails -> IO DB
mkDB connstr details = do
  pool <- DB.createSqlitePool connstr
  DB.withPool pool runMigrations
  pure DB
    { getNotes =
      DB.withPool pool (getNotesFromDb $ actorUrl details)
    , insertNote =
      \note -> DB.withPool pool (insertNoteToDb (actorUrl details) note)
    }

-----------------------
-- * Database migrations

runMigrations :: HasCallStack => DB.SQLite ()
runMigrations = DB.migrate migrations migrateUp migrateDown

migrations :: [DB.MigrationName]
migrations =
  [ "note"
  ]

migrateUp :: HasCallStack => DB.MigrationName -> DB.SQLite ()
migrateUp = \case
  "note" -> do
    [] <- DB.run
      [r| create table note(
          id integer primary key autoincrement,
          published datetime default (datetime('now')),
          actor text not null,
          content text not null,
          name text,
          inReplyTo text,
          url text
        )
      |]

    pure ()

  name -> error $ "unexpected migration: " <> show name

migrateDown :: HasCallStack => DB.MigrationName -> DB.SQLite ()
migrateDown = \case
  "notes" -> do
    [] <- DB.run "DROP TABLE note"
    pure ()
  name -> error $ "unexpected migration: " <> show name

-----------------------
-- * Database actions

getNotesFromDb :: Url -> DB.SQLite [Note]
getNotesFromDb url =
  map decodeNoteRow <$> uncurry DB.runWith (getNotesSQL url)

insertNoteToDb :: Url -> NoteEntry -> DB.SQLite NoteId
insertNoteToDb actor note = do
  [n] <- map decodeNoteIdRow <$> uncurry DB.runWith (insertNoteSQL actor note)
  pure n

-- ** SQL

getNotesSQL :: Url -> (DB.SQL, [DB.SQLData])
getNotesSQL url =
  ( [r|
      SELECT
        ? || '/notes/' || id,
        published,
        actor,
        content,
        name,
        inReplyTo,
        url
      FROM note
      ORDER BY published DESC
    |]
  , [DB.SQLText $ T.pack url]
  )

insertNoteSQL :: Url -> NoteEntry -> (DB.SQL, [DB.SQLData])
insertNoteSQL actor note =
  ( [r|
      INSERT INTO note(actor, inReplyTo, content, name, url)
      VALUES (?, ?, ?, ?, ?)
      RETURNING cast(id as text)
    |]
  , [ DB.SQLText (T.pack actor)
    , toNullableString note.inReplyTo
    , DB.SQLText note.content
    , toNullableString note.name
    , toNullableString note.url
    ]
  )

-----------------------
-- ** Decode row

decodeNoteRow :: [DB.SQLData] -> Note
decodeNoteRow = \case
  [ DB.SQLText noteid,
    DB.SQLText published,
    DB.SQLText actor,
    DB.SQLText content,
    nullableString -> Just name,
    nullableString -> Just inReplyTo,
    nullableString -> Just url
    ] ->
      Note
        { id = T.unpack noteid
        , published = read (T.unpack published)
        , actor = T.unpack actor
        , inReplyTo = inReplyTo
        , content = content
        , url = url
        , name = name
        , replies = Collection
          { id = T.unpack noteid <> "/replies"
          , summary = "Replies"
          , items = []
          , first = Nothing
          , last = Nothing
          }
        }
  row -> error $ "Couldn't decode row as Note: " <> show row

decodeNoteIdRow :: [DB.SQLData] -> NoteId
decodeNoteIdRow = \case
  [ DB.SQLText noteid] -> T.unpack noteid
  row -> error $ "Couldn't decode row as NoteId: " <> show row

nullableString :: DB.SQLData -> Maybe (Maybe String)
nullableString = \case
  DB.SQLText text -> Just (Just $ T.unpack text)
  DB.SQLNull -> Just Nothing
  _ -> Nothing

toNullableString :: Maybe String -> DB.SQLData
toNullableString = \case
  Nothing -> DB.SQLNull
  Just str -> DB.SQLText (T.pack str)