content: {-# LANGUAGE IncoherentInstances #-}
  {-# LANGUAGE MonoLocalBinds      #-}
  
  
  module WebSpec (tests) where
  
  -- Shared imports
  import Imports
  -- Monads
  import Control.Monad.Loops
  -- Concurrency
  import Control.Concurrent.Async (withAsync)
  -- Text
  import qualified Data.Text as T
  -- Files
  import System.IO.Temp
  -- URLs
  import Network.URI
  -- Testing
  import qualified ApiSpec
  import qualified LogSpec
  import Selenium
  import qualified Test.WebDriver.Common.Keys as Key
  -- Site
  import Guide.Config (Config (..), def)
  import qualified Guide.Main
  
  
  -----------------------------------------------------------------------------
  -- Tests
  -----------------------------------------------------------------------------
  
  tests :: IO ()
  tests = withSystemTempFile "test_guide.log" $ \logFile logFileHandle -> do
    -- Close the log file because otherwise 'run' won't be able to open it
    hClose logFileHandle
    run logFile $ do
      mainPageTests
      categoryTests
      itemTests
      markdownTests
      ApiSpec.tests
    hspec $
      LogSpec.tests logFile
    -- TODO: ApiSpec, LogSpec, and WebSpec should be independent of each
    -- other. Currently it's a mess.
  
  mainPageTests :: Spec
  mainPageTests = session "main page" $ using [chromeCaps] $ do
    openGuide "/"
    wd "is initially empty" $ do
      checkPresent "#categories"
      checkNotPresent "#categories > *"
    wd "has a google-token" $ do
      "meta[name=google-site-verification]" `shouldHaveAttr`
        ("content", "some-google-token")
    wd "has a title" $ do
      "h1" `shouldHaveText` "Aelve Guide | Haskell"
    -- describe "subtitle" $ do
    --   wd "is present" $ do
    --     sub <- select ".subtitle"
    --     fs <- fontSize sub; fs `shouldBeInRange` (15,17)
    --   wd "has a discuss link" $ do
    --     checkPresent ".subtitle a[href='http://discuss.link']"
  
  categoryTests :: Spec
  categoryTests = session "categories" $ using [chromeCaps] $ do
    openGuide "/"
    wd "add a new category" $ do
      createCategory "Some category"
      checkPresent ".category"
      url <- getCurrentRelativeURL
      (slug, _) <- parseCategoryURL (uriPath url)
      slug `shouldBe` "some-category"
    describe "created category" $ do
      wd "has a link to the main page" $ do
        titleLink <- select "h1 > a"
        titleLink `shouldHaveText` "Aelve Guide | Haskell"
        titleLink `shouldLinkToRelative` "/haskell"
      -- wd "has a subtitle" $ do
      --   checkPresent ".subtitle"
      wd "doesn't have an add-category field" $ do
        checkNotPresent ".add-category"
      wd "is present on the main page" $ do
        getBackAfterwards $ do
          catURL <- getCurrentURL
          openGuidePage "/"
          ByLinkText "Some category" `shouldLinkTo` catURL
      wd "is initially empty" $ do
        checkPresent ".items"
        checkNotPresent (".items" :// Not ".dummy")
    describe "category properties" $ do
      describe "title" $ do
        wd "is present" $ do
          e <- select categoryTitle; e `shouldHaveText` "Some category"
          fs <- fontSize e; fs `shouldBeInRange` (20, 26)
        wd "can be changed" $ do
          form <- openCategoryEditForm
          enterInput "Cat 1" (form :// ByName "title")
          categoryTitle `shouldHaveText` "Cat 1"
        wd "changes page slug when changed" $ do
          changesURL $ refresh
          do (slug, _) <- parseCategoryURL . uriPath =<< getCurrentRelativeURL
             slug `shouldBe` "cat-1"
          form <- openCategoryEditForm
          enterInput "Cat 2" (form :// ByName "title")
          changesURL $ refresh
          do (slug, _) <- parseCategoryURL . uriPath =<< getCurrentRelativeURL
             slug `shouldBe` "cat-2"
        wd "is changed on the front page too" $ do
          (_, id1) <- parseCategoryURL . uriPath =<< getCurrentRelativeURL
          openGuidePage "/"
          checkNotPresent (ByLinkText "Some category")
          checkNotPresent (ByLinkText "Cat 1")
          changesURL $ click (ByLinkText "Cat 2")
          (slug2, id2) <- parseCategoryURL . uriPath =<< getCurrentRelativeURL
          id1 `shouldBe` id2; slug2 `shouldBe` "cat-2"
      describe "group" $ do
        wd "is present" $ do
          group_ <- select categoryGroup
          group_ `shouldHaveText` "Miscellaneous"
          fs <- fontSize group_; fs `shouldBeInRange` (12, 15)
        wd "can be changed" $ do
          form <- openCategoryEditForm
          enterInput "Basics" (form :// ByName "group")
          categoryGroup `shouldHaveText` "Basics"
        wd "is changed on the front page too" $ do
          onAnotherPage "/" $ do
            catLink <- select (ByLinkText "Cat 2")
            groupHeader <- select ((".category-group" :<// catLink) :// "h2")
            groupHeader `shouldHaveText` "Basics"
      describe "status" $ do
        wd "is “stub” by default" $ do
          form <- openCategoryEditForm
          chosenOption <- select (form :// ByName "status" :// "option:checked")
          chosenOption `shouldHaveText` "Stub"
          onAnotherPage "/" $ do
            ("div" :</ ("p" :</ ByLinkText "Cat 2")) `shouldHaveAttr`
              ("class", "categories-stub")
        wd "can be changed" $ do
          form <- openCategoryEditForm
          sel <- select (form :// ByName "status")
          opt <- select (sel :// HasText "Complete")
          selectDropdown sel opt
          saveForm form
          onAnotherPage "/" $ do
            ("div" :</ ByLinkText "Cat 2") `shouldHaveAttr`
              ("class", "categories-finished")
      wd "create two items for further tests" $ do
        createItem "some item"
        createItem "another item"
      describe "pros/cons enabled" $ do
        wd "checkbox enabled by default" $ do
          form <- openCategoryEditForm
          checkbox <- select (form :// ByName "pros-cons-enabled")
          shouldBeSelected checkbox
          click (form :// ".cancel")
        wd "section is shown in an item" $ do
          mapM_ shouldBeDisplayed =<< selectAll ".item-traits"
        wd "section isn't shown after unchecking the checkbox" $ do
          form <- openCategoryEditForm
          click (form :// ByName "pros-cons-enabled")
          saveForm form
          waitUntil wait_delay $
            expect . not =<< anyM isDisplayed =<< selectAll ".item-traits"
        wd "section is shown again after checking the checkbox" $ do
          form <- openCategoryEditForm
          click (form :// ByName "pros-cons-enabled")
          saveForm form
          waitUntil wait_delay $
            expect =<< allM isDisplayed =<< selectAll ".item-traits"
      describe "ecosystem enabled" $ do
        wd "checkbox enabled by default" $ do
          form <- openCategoryEditForm
          checkbox <- select (form :// ByName "ecosystem-enabled")
          shouldBeSelected checkbox
          click (form :// ".cancel")
        wd "section is shown in an item" $ do
          mapM_ shouldBeDisplayed =<< selectAll ".item-ecosystem"
        wd "section isn't shown after unchecking the checkbox" $ do
          form <- openCategoryEditForm
          click (form :// ByName "ecosystem-enabled")
          saveForm form
          waitUntil wait_delay $
            expect . not =<< anyM isDisplayed =<< selectAll ".item-ecosystem"
        wd "section is shown again after checking the checkbox" $ do
          form <- openCategoryEditForm
          click (form :// ByName "ecosystem-enabled")
          saveForm form
          waitUntil wait_delay $
            expect =<< allM isDisplayed =<< selectAll ".item-ecosystem"
    describe "feed" $ do
      -- TODO: actually test the generated feed
      wd "exists" $ do
        getBackAfterwards $ do
          url <- getCurrentRelativeURL
          (_, catId) <- parseCategoryURL (uriPath url)
          ".category-feed" `shouldLinkToRelative`
            ("/haskell/feed/category/" <> catId)
          click ".category-feed"
          -- commented out because it doesn't work in Chrome
          -- checkPresent (".item-name" :& HasText "some item")
          -- checkPresent (".item-name" :& HasText "another item")
    describe "notes" $ do
      wd "has a default template" $ do
        form <- openCategoryNotesEditForm
        contents <- T.lines <$> getValue (form :// "textarea")
        contents `shouldSatisfy`
          ("have “# Recommendations”", ("# Recommendations" `elem`))
        click (form :// ".cancel")
      wd "can be edited" $ do
        form <- openCategoryNotesEditForm
        setInput "Blah blah" (form :// "textarea")
        saveForm form
        ".category-notes .notes-like" `shouldHaveText` "Blah blah"
    describe "deleting a category" $ do
      wd "dismissing the alert doesn't do anything" $ do
        click (".category h2" :// ByLinkText "delete")
        dismissAlert
        getBackAfterwards $ do
          catURL <- getCurrentURL
          openGuidePage "/"
          ByLinkText "Cat 2" `shouldLinkTo` catURL
      wd "accepting the alert deletes the category" $ do
        catURL <- getCurrentURL
        changesURL $ do
          click (".category h2" :// ByLinkText "delete")
          acceptAlert
        url <- getCurrentRelativeURL
        uriPath url `shouldBe` "/haskell"
        checkNotPresent (ByLinkText "Cat 2")
        openPage catURL
        -- TODO: we should have, like, a 404 page
        "body" `shouldHaveText` "404 - Not Found\npowered by Spock"
  
  itemTests :: Spec
  itemTests = session "items" $ using [chromeCaps] $ do
    openGuide "/"
    wd "create a test category" $ do
      createCategory "Item test category"
    wd "add new items" $ do
      createItem "An item"
    let item1 = Index 0 ".item"
  
    describe "item properties" $ do
      describe "name" $ do
        wd "is present" $ do
          itemName item1 `shouldHaveText` "An item"
          fs <- fontSize (itemName item1); fs `shouldBeInRange` (20,26)
        wd "can be changed" $ do
          form <- openItemEditForm item1
          enterInput "New item" (form :// ByName "name")
          itemName item1 `shouldHaveText` "New item"
      -- TODO: kind
      -- TODO: site
  
    describe "item sections" $ do
      describe "description/summary" $ do
        wd "default state" $ do
          (item1 :// ".item-description .notes-like p") `shouldHaveText`
            "write something here!"
          form <- openItemDescriptionEditForm item1
          val <- getValue (form :// "textarea")
          val `shouldBe` ""
          click (form :// ".cancel")
        wd "can be changed" $ do
          do form <- openItemDescriptionEditForm item1
             setInput "foo *bar*\n\n# Blah" (form :// "textarea")
             saveForm form
          section <- select (item1 :// ".item-description .notes-like")
          (section :// "p")  `shouldHaveText` "foo bar"
          (section :// "h1") `shouldHaveText` "Blah"
          do form <- openItemDescriptionEditForm item1
             val <- getValue (form :// "textarea")
             val `shouldBe` "foo *bar*\n\n# Blah"
             click (form :// ".cancel")
        wd "edit-cancel-edit works" $ do
          -- It should not store the edited text if it wasn't saved
          do form <- openItemDescriptionEditForm item1
             setInput "ehhhh" (form :// "textarea")
             click (form :// ".cancel")
          do form <- openItemDescriptionEditForm item1
             val <- getValue (form :// "textarea")
             val `shouldBe` "foo *bar*\n\n# Blah"
             click (form :// ".cancel")
      -- TODO: pros/cons
      describe "ecosystem" $ do
        wd "default state" $ do
          (item1 :// ".item-ecosystem .notes-like") `shouldHaveText` ""
          form <- openItemEcosystemEditForm item1
          val <- getValue (form :// "textarea")
          val `shouldBe` ""
          click (form :// ".cancel")
        wd "can be changed" $ do
          do form <- openItemEcosystemEditForm item1
             setInput "foo *bar*\n\n# Blah" (form :// "textarea")
             saveForm form
          section <- select (item1 :// ".item-ecosystem .notes-like")
          (section :// "p")  `shouldHaveText` "foo bar"
          (section :// "h1") `shouldHaveText` "Blah"
          do form <- openItemEcosystemEditForm item1
             val <- getValue (form :// "textarea")
             val `shouldBe` "foo *bar*\n\n# Blah"
             click (form :// ".cancel")
        wd "edit-cancel-edit works" $ do
          -- It should not store the edited text if it wasn't saved
          do form <- openItemEcosystemEditForm item1
             setInput "ehhhh" (form :// "textarea")
             click (form :// ".cancel")
          do form <- openItemEcosystemEditForm item1
             val <- getValue (form :// "textarea")
             val `shouldBe` "foo *bar*\n\n# Blah"
             click (form :// ".cancel")
      -- TODO: notes
  
    describe "items with the same name" $ do
      wd "can be present" $ do
        createItem "same name"
        createItem "same name"
        waitUntil wait_delay $
          expect . (== 2) . length =<< selectAll
            (itemName ".item" :& HasText "same name")
      wd "can be changed separately" $ do
        itemA <- select $
          Index 0 (".item" :<// (".item-name" :& HasText "same name"))
        itemB <- select $
          Index 1 (".item" :<// (".item-name" :& HasText "same name"))
        form <- openItemEditForm itemB
        enterInput "Blah" (form :// ByName "name")
        itemName itemA `shouldHaveText` "same name"
        itemName itemB `shouldHaveText` "Blah"
    describe "moving items" $ do
      let getId :: CanSelect a => a -> WD Text
          getId x = Selenium.attr x "id" >>= \case
            Nothing -> expectationFailure $
                         printf "expected %s to have an id" (show x)
            Just i  -> return i
      wd "up" $ do
        ids <- mapM getId =<< selectAll ".item"
        click (ById (ids !! 1) :// ".move-item-up")
        waitWhile 0.10 (return ()) `onTimeout` return ()
        ids2 <- mapM getId =<< selectAll ".item"
        ids2 `shouldBe` (ids !! 1 : ids !! 0 : drop 2 ids)
      -- TODO: select should only select visible elements
      -- TODO: try to move the first item up
      -- TODO: down
    -- TODO: item's self-link in the header
    -- TODO: deleting an item
  
  -- TODO: tests for merging-on-conflicts
  
  markdownTests :: Spec
  markdownTests = session "markdown" $ using [chromeCaps] $ do
    openGuide "/"
    describe "Markdown isn't allowed in category names" $ do
      wd "when creating a category" $ do
        createCategory "*foo*"
        categoryTitle `shouldHaveText` "*foo*"
      wd "when changing existing category's name" $ do
        form <- openCategoryEditForm
        enterInput "foo `bar`" (form :// ByName "title")
        categoryTitle `shouldHaveText` "foo `bar`"
    wd "Markdown in category notes" $ do
      form <- openCategoryNotesEditForm
      setInput "# Test\n*foo*" (form :// "textarea")
      saveForm form
      ".category-notes .notes-like h1" `shouldHaveText` "Test"
      ".category-notes .notes-like p em" `shouldHaveText` "foo"
    describe "Markdown in item descriptions" $ do
      let item = Index 0 ".item"
      wd "works" $ do
        createItem "test"
        form <- openItemDescriptionEditForm item
        setInput "# Blah\n*bar*" (form :// "textarea")
        saveForm form
        (item :// ".item-description .notes-like h1") `shouldHaveText` "Blah"
        (item :// ".item-description .notes-like p em") `shouldHaveText` "bar"
      wd "@hk links are parsed as Hackage links" $ do
        form <- openItemDescriptionEditForm item
        setInput "[foo-bar](@hk)" (form :// "textarea")
        saveForm form
        (item :// ".item-description .notes-like a") `shouldHaveText` "foo-bar"
        (item :// ".item-description .notes-like a") `shouldLinkTo`
          "https://hackage.haskell.org/package/foo-bar"
    -- TODO: check that headers in notes Markdown are rendered as headers but
    -- still have smaller font size
  
  -----------------------------------------------------------------------------
  -- Helpers dealing with guide specifically
  -----------------------------------------------------------------------------
  
  parseCategoryURL :: String -> WD (String, String)
  parseCategoryURL url = do
    case T.stripPrefix "/haskell/" (toText url) of
      Nothing -> expectationFailure $
                   printf "%s doesn't start with /haskell/" (show url)
      Just u -> do
        let (slug, catId) = T.breakOnEnd "-" u
        slug `shouldSatisfy` ("not null", not . T.null)
        T.last slug `shouldBe` '-'
        return (toString (T.init slug), toString catId)
  
  openGuide :: String -> SpecWith (WdTestSession ())
  openGuide s = wd ("load " ++ s) (openGuidePage s)
  
  openGuidePage :: String -> WD ()
  openGuidePage s = changesURL $ openPage ("http://localhost:8080/haskell" ++ s)
  
  onAnotherPage :: String -> WD a -> WD a
  onAnotherPage s x = getBackAfterwards $ do
    openGuidePage s
    x
  
  -- Assumes that the main page is open
  createCategory :: Text -> WD ()
  createCategory t =
    changesURL $ enterInput t ".add-category"
  
  -- Assumes that the category page is open
  createItem :: Text -> WD Element
  createItem t = do
    let selectItems = selectAll ".item"
    items <- selectItems
    sendKeys (t <> Key.enter) ".add-item"
    waitUntil wait_delay (expect . (\xs -> length xs > length items) =<< selectItems)
    items2 <- selectItems
    case items2 \\ items of
      []  -> expectationFailure "an item wasn't created"
      [x] -> return x
      _   -> expectationFailure "more than one item was created"
  
  itemName :: CanSelect s => s -> ComplexSelector
  itemName item = item :// ".item-name"
  
  categoryTitle :: Selector
  categoryTitle = ByCSS ".category-title"
  
  categoryGroup :: Selector
  categoryGroup = ByCSS ".category .group"
  
  openCategoryEditForm :: WD Element
  openCategoryEditForm = do
    click (".category h2" :// ByLinkText "edit")
    select ".category-info form"
  
  openCategoryNotesEditForm :: WD Element
  openCategoryNotesEditForm = do
    click (".category-notes" :// ByLinkText "edit description")
    select ".category-notes .editing"
  
  openItemEditForm :: CanSelect s => s -> WD Element
  openItemEditForm item = do
    click (item :// ".edit-item-info")
    select (item :// ".item-info form")
  
  openItemDescriptionEditForm :: CanSelect s => s -> WD Element
  openItemDescriptionEditForm item = do
    click (item :// ".item-description .normal .edit-item-description")
    select (item :// ".item-description .editing")
  
  openItemEcosystemEditForm :: CanSelect s => s -> WD Element
  openItemEcosystemEditForm item = do
    click (item :// ".item-ecosystem .normal .edit-item-ecosystem")
    select (item :// ".item-ecosystem .editing")
  
  -- | Save a form and wait for it to close.
  --
  -- Assumes that the form has a button with class @save@.
  saveForm :: CanSelect s => s -> WD ()
  saveForm form = do
    click (form :// ".save")
    -- Normally Selenium wouldn't wait for the “save” request to complete, so
    -- we have to manually wait until the form is hidden. It's important
    -- because otherwise things like issue #134 happen (when Selenium asks for
    -- another page before the form has finished saving).
    checkNotPresent form
  
  -----------------------------------------------------------------------------
  -- Utilities for webdriver
  -----------------------------------------------------------------------------
  
  _TODO :: MonadIO m => m ()
  _TODO = error "test not implemented"
  
  _pause :: WD ()
  _pause = do
    liftIO $ putStr "press Enter to continue testing, or “q” to quit: "
    x <- liftIO $ getLine
    when (x == "q") $
      expectationFailure "quit"
  
  getCurrentRelativeURL :: WD URI
  getCurrentRelativeURL = do
    url <- getCurrentURL
    case parseURI url of
      Nothing -> error ("couldn't parse as URL: " ++ url)
      Just u  -> do
        maybe "" uriRegName (uriAuthority u) `shouldBe` "localhost"
        return u
  
  -- 'Run' prepares directories and config to launch site server for spec tests
  -- and closes them all after test finished.
  run :: FilePath -> Spec -> IO ()
  run logFile ts = do
    -- Config to run spock server.
    let config = def {
          baseUrl       = "/",
          googleToken   = "some-google-token",
          adminPassword = "123",
          discussLink   = Just "http://discuss.link",
          cors          = False,
          logToStderr   = False,
          logToFile     = Just logFile
          }
    -- Prepere resources.
    let prepare = do
          exold <- doesDirectoryExist "state-old"
          when exold $ error "state-old exists"
          ex <- doesDirectoryExist "state"
          when ex $ renameDirectory "state" "state-old"
  
    -- Release resources.
    let finish _ = do
          ex' <- doesDirectoryExist "state"
          when ex' $ removeDirectoryRecursive "state"
          exold' <- doesDirectoryExist "state-old"
          when exold' $ renameDirectory "state-old" "state"
  
    bracket prepare finish $ \_ -> do
      withAsync (Guide.Main.runServer config) $ \_ -> hspec ts
  
  _site :: IO ()
  _site = run "" $ do
    session "_" $ using [chromeCaps] $ do
      wd "_" $ do
        openGuidePage "/"
        _pause
  
  shouldLinkToRelative :: CanSelect a => a -> String -> WD ()
  s `shouldLinkToRelative` url2 = do
    -- TODO: would be nice if it checked relative to the current page
    url <- getLink s
    case parseURI url of
      Nothing -> error ("couldn't parse as URL: " ++ url)
      Just u  -> do
        maybe "" uriRegName (uriAuthority u) `shouldBe` "localhost"
        uriPath u `shouldBe` url2
  