module Main where

import Test.Hspec
import IHP.Prelude
import IHP.ModelSupport
import IHP.Log.Types
import IHP.ControllerPrelude hiding (query)
import System.Environment (lookupEnv)
import Generated.Types

-- Integration tests run with a temporary PostgreSQL database.
-- Run: nix flake check  (or `test` inside devenv)
main :: IO ()
main = do
    databaseUrl <- lookupEnv "DATABASE_URL" >>= \case
        Just url -> pure (cs url)
        Nothing  -> error "DATABASE_URL not set. Run `devenv up` first or use `nix flake check`."
    logger <- newLogger def { level = Warn }
    withModelContext databaseUrl logger \modelContext -> do
        let ?modelContext = modelContext
        hspec do

            -- ----------------------------------------------------------------
            -- Hub CRUD
            -- ----------------------------------------------------------------
            describe "Hub CRUD" do
                it "can create and fetch a hub" do
                    hub <- newRecord @Hub
                        |> set #slug   "test-hub"
                        |> set #name   "Test Hub"
                        |> set #domain "test"
                        |> createRecord
                    hub.name `shouldBe` "Test Hub"
                    fetched <- fetch hub.id
                    fetched.slug `shouldBe` "test-hub"
                    deleteRecord hub

            -- ----------------------------------------------------------------
            -- Widget CRUD + versioning
            -- ----------------------------------------------------------------
            describe "Widget CRUD" do
                it "creates widget and records version 1" do
                    hub <- newRecord @Hub
                        |> set #slug "w-hub" |> set #name "W Hub" |> set #domain "d"
                        |> createRecord
                    widget <- newRecord @Widget
                        |> set #hubId      hub.id
                        |> set #name       "Test Widget"
                        |> set #widgetType "chart"
                        |> createRecord
                    widget.version `shouldBe` 1
                    let snapshot = object ["name" .= widget.name]
                    _ver <- newRecord @WidgetVersion
                        |> set #widgetId widget.id
                        |> set #version  1
                        |> set #schemaSnapshot snapshot
                        |> createRecord
                    versions <- query @WidgetVersion |> filterWhere (#widgetId, widget.id) |> fetch
                    length versions `shouldBe` 1
                    deleteRecord hub

            -- ----------------------------------------------------------------
            -- Interaction event capture
            -- ----------------------------------------------------------------
            describe "InteractionEvent capture" do
                it "records event with anonymous actor" do
                    hub <- newRecord @Hub
                        |> set #slug "ev-hub" |> set #name "Ev Hub" |> set #domain "d"
                        |> createRecord
                    widget <- newRecord @Widget
                        |> set #hubId hub.id |> set #name "Ev Widget" |> set #widgetType "form"
                        |> createRecord
                    event <- newRecord @InteractionEvent
                        |> set #widgetId  widget.id
                        |> set #eventType "clicked"
                        |> set #actorType "anonymous"
                        |> createRecord
                    event.eventType `shouldBe` "clicked"
                    event.actorType `shouldBe` "anonymous"
                    deleteRecord hub

                it "append-only: UPDATE raises exception" do
                    hub <- newRecord @Hub
                        |> set #slug "ao-hub" |> set #name "AO Hub" |> set #domain "d"
                        |> createRecord
                    widget <- newRecord @Widget
                        |> set #hubId hub.id |> set #name "AO Widget" |> set #widgetType "table"
                        |> createRecord
                    event <- newRecord @InteractionEvent
                        |> set #widgetId  widget.id
                        |> set #eventType "viewed"
                        |> set #actorType "user"
                        |> createRecord
                    let attemptUpdate = sqlExec
                            "UPDATE interaction_events SET event_type = 'tampered' WHERE id = ?"
                            (Only event.id)
                    attemptUpdate `shouldThrow` anyException
                    deleteRecord hub

            -- ----------------------------------------------------------------
            -- Annotation CRUD + threading
            -- ----------------------------------------------------------------
            describe "Annotation CRUD" do
                it "creates annotation and lists it" do
                    hub <- newRecord @Hub
                        |> set #slug "ann-hub" |> set #name "Ann Hub" |> set #domain "d"
                        |> createRecord
                    widget <- newRecord @Widget
                        |> set #hubId hub.id |> set #name "Ann Widget" |> set #widgetType "panel"
                        |> createRecord
                    ann <- newRecord @Annotation
                        |> set #widgetId widget.id
                        |> set #body     "This is confusing"
                        |> set #category "friction"
                        |> set #actorType "user"
                        |> createRecord
                    anns <- query @Annotation |> filterWhere (#widgetId, widget.id) |> fetch
                    length anns `shouldBe` 1
                    (head anns).body `shouldBe` "This is confusing"
                    deleteRecord hub

                it "supports threaded replies via parent_id" do
                    hub <- newRecord @Hub
                        |> set #slug "thread-hub" |> set #name "Thread Hub" |> set #domain "d"
                        |> createRecord
                    widget <- newRecord @Widget
                        |> set #hubId hub.id |> set #name "Thread Widget" |> set #widgetType "form"
                        |> createRecord
                    root <- newRecord @Annotation
                        |> set #widgetId widget.id
                        |> set #body     "Root comment"
                        |> set #category "friction"
                        |> set #actorType "user"
                        |> createRecord
                    reply <- newRecord @Annotation
                        |> set #widgetId widget.id
                        |> set #parentId (Just root.id)
                        |> set #body     "Reply to root"
                        |> set #category "other"
                        |> set #actorType "user"
                        |> createRecord
                    reply.parentId `shouldBe` Just root.id
                    deleteRecord hub

            -- ----------------------------------------------------------------
            -- Validation: empty body rejected
            -- ----------------------------------------------------------------
            describe "Annotation validation" do
                it "empty body fails validation" do
                    hub <- newRecord @Hub
                        |> set #slug "val-hub" |> set #name "Val Hub" |> set #domain "d"
                        |> createRecord
                    widget <- newRecord @Widget
                        |> set #hubId hub.id |> set #name "Val Widget" |> set #widgetType "form"
                        |> createRecord
                    let ann = newRecord @Annotation
                            |> set #widgetId widget.id
                            |> set #body     ""
                            |> set #category "friction"
                            |> validateField #body nonEmpty
                    isValid ann `shouldBe` False
                    deleteRecord hub