fixed warning

fixed warning

module Test.Feature
  ( Properties
  , XPath
  , FilePath
  , accessUrlFromFieldValue
  , accessUrlFromFieldValueWithProperties
  , check
  , checkWithProperties
  , clear
  , clearWithProperties
  , click
  , clickWithProperties
  , clickNotRepeatedly
  , dragAndDrop
  , dragAndDropWithProperties
  , expectDownloadedTextFileToMatchFile
  , expectNotPresented
  , expectNotPresentedWithProperties
  , expectNotPresentedNotRepeatedly
  , expectNotPresentedWithPropertiesNotRepeatedly
  , expectPresented
  , expectPresentedWithProperties
  , expectPresentedNotRepeatedly
  , expectPresentedWithPropertiesNotRepeatedly
  , expectSelectValue
  , hover
  , hoverWithProperties
  , pressEnter
  , provideFieldValue
  , provideFieldValueWithProperties
  , provideFileInputValue
  , provideFileInputValueWithProperties
  , pushRadioButton
  , pushRadioButtonWithProperties
  , selectFromDropdown
  , selectFromDropdownWithProperties
  , typeString
  , uncheck
  , uncheckWithProperties
  , smallWaitTime
  , logCurrentScreen
  ) where

import SlamData.Prelude

import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Exception (throw)

import Data.Array (elemIndex, length)
import Data.List (toUnfoldable)
import Data.List as L
import Data.Map as Map
import Data.String as String

import Node.Buffer (toString)
import Node.Encoding (Encoding(..))
import Node.FS.Aff (readFile, readTextFile, readdir, unlink)

import Selenium.ActionSequence as Sequence
import Selenium.Monad (get, getAttribute, clickEl, attempt, later, byXPath, tryRepeatedlyTo, findElements, isDisplayed, getLocation, getSize, saveScreenshot, sendKeysEl)
import Selenium.Monad as Selenium
import Selenium.Types (Element, Location)

import Test.Feature.ActionSequence as FeatureSequence
import Test.Feature.Log (warnMsg)
import Test.Feature.Monad (Feature, await)
import Test.Utils (appendToCwd, ifTrue, ifFalse, singletonValue, throwIfEmpty, passover)

import XPath as XPath

type Properties = Map.Map String (Maybe String)
type XPath = String
type FilePath = String

smallWaitTime ∷ Int
smallWaitTime = 500

finderInternalFindAllNotRepeatedly ∷ ∀ eff o. XPath → Feature eff o (Array Element)
finderInternalFindAllNotRepeatedly =
  map toUnfoldable ∘ findElements <=< byXPath

-- Basic XPath dependent finders
findAllNotRepeatedly ∷ ∀ eff o. XPath → Feature eff o (Array Element)
findAllNotRepeatedly = findAllWithPropertiesNotRepeatedly Map.empty

findNotRepeatedly ∷ ∀ eff o. XPath → Feature eff o Element
findNotRepeatedly xPath =
  singletonValue throwNoElements throwMoreThanOneElement
    =<< findAllNotRepeatedly xPath
  where
  throwNoElements =
    liftEff
      $ throw
      $ XPath.errorMessage "Couldn't find an element" xPath

  throwMoreThanOneElement i =
    liftEff
      $ throw
      $ XPath.errorMessage
          ("Found (" ⊕ show i ⊕ ") more than one element")
          xPath

findAtLeastOneNotRepeatedly ∷ ∀ eff o. XPath → Feature eff o (Array Element)
findAtLeastOneNotRepeatedly xPath =
  headOrThrow =<< findAllNotRepeatedly xPath
  where
  headOrThrow = passover (throwIfEmpty noElementsMessage)
  noElementsMessage = XPath.errorMessage "Couldn't find an element" xPath

find ∷ ∀ eff o. XPath → Feature eff o Element
find xPath = expectPresented xPath *> findNotRepeatedly xPath

findAll ∷ ∀ eff o. XPath → Feature eff o (Array Element)
findAll xPath = expectPresented xPath *> findAllNotRepeatedly xPath

-- Property and XPath dependent finders
findAllInvisibleWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o (Array Element)
findAllInvisibleWithPropertiesNotRepeatedly properties xPath =
  elementsWithProperties properties
    =<< finderInternalFindAllNotRepeatedly xPath

findAllWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o (Array Element)
findAllWithPropertiesNotRepeatedly properties xPath =
  passover (expectPresentedVisualElements properties xPath)
    =<< elementsWithProperties properties
    =<< finderInternalFindAllNotRepeatedly xPath

findAtLeastOneWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o (Array Element)
findAtLeastOneWithPropertiesNotRepeatedly properties xPath =
  headOrThrow
    =<< elementsWithProperties properties
    =<< findAllNotRepeatedly xPath
  where
  headOrThrow =
    passover (throwIfEmpty noElementsMessage)
  noElementsMessage =
    XPath.errorMessage
      (withPropertiesMessage properties "Couldn't find an element")
      xPath

findInvisibleWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Element
findInvisibleWithPropertiesNotRepeatedly properties xPath =
  singletonValue throwNoElements throwMoreThanOneElement
    =<< findAllInvisibleWithPropertiesNotRepeatedly properties xPath
  where
  throwNoElements =
    liftEff $ throw $ noElementWithPropertiesError properties xPath

  throwMoreThanOneElement i =
    liftEff $ throw $ moreThanOneElementMessage i

  moreThanOneElementRawMessage i = "Found (" ⊕ show i ⊕ ") more than one element"
  moreThanOneElementMessage i =
    XPath.errorMessage
      (withPropertiesMessage properties
       $ moreThanOneElementRawMessage i) xPath

findWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Element
findWithPropertiesNotRepeatedly properties xPath =
  singletonValue throwNoElements throwMoreThanOneElement
    =<< findAllWithPropertiesNotRepeatedly properties xPath
  where
  throwNoElements =
    liftEff $ throw $ noElementWithPropertiesError properties xPath

  throwMoreThanOneElement i =
    liftEff $ throw $ moreThanOneElementMessage i

  moreThanOneElementRawMessage i = "Found (" ⊕ show i ⊕ ") more than one element"
  moreThanOneElementMessage i =
    XPath.errorMessage
      (withPropertiesMessage properties
       $ moreThanOneElementRawMessage i) xPath

findAllWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o (Array Element)
findAllWithProperties properties xPath =
  expectPresentedWithProperties properties xPath
    *> findAllWithPropertiesNotRepeatedly properties xPath

findAtLeastOneWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o (Array Element)
findAtLeastOneWithProperties properties xPath =
  expectPresentedWithProperties properties xPath
    *> findAtLeastOneWithPropertiesNotRepeatedly properties xPath

findWithProperties ∷ ∀ eff o. Properties → XPath → Feature eff o Element
findWithProperties properties xPath =
  expectPresentedWithProperties properties xPath
    *> findWithPropertiesNotRepeatedly properties xPath

-- Errors
printPropertyValue ∷ Maybe String → String
printPropertyValue = maybe "null" show

printProperty ∷ String → Maybe String → String
printProperty name value =
  name ⊕ "=" ⊕ printPropertyValue value

printProperties ∷ Properties → String
printProperties =
  String.joinWith " "
    ∘ L.toUnfoldable
    ∘ map (uncurry printProperty)
    ∘ Map.toList

noElementWithPropertiesError ∷ Properties → XPath → String
noElementWithPropertiesError properties =
  XPath.errorMessage
    $ withPropertiesMessage properties "Unable to find element with "

elementWithPropertiesError ∷ Properties → XPath → String
elementWithPropertiesError properties =
  XPath.errorMessage
    $ withPropertiesMessage properties "Expected not to find element with "

withPropertiesMessage ∷ Properties → String → String
withPropertiesMessage mp s
  | Map.isEmpty mp = s
withPropertiesMessage xs s =
  s ⊕ " with the attributes or properties: " ⊕ printProperties xs

-- Expectations
expectNotPresentedNotRepeatedly ∷ ∀ eff o. XPath → Feature eff o Unit
expectNotPresentedNotRepeatedly xPath =
  expectNotPresentedWithPropertiesNotRepeatedly Map.empty xPath

expectPresentedNotRepeatedly ∷ ∀ eff o. XPath → Feature eff o Unit
expectPresentedNotRepeatedly xPath =
  expectPresentedWithPropertiesNotRepeatedly Map.empty xPath

-- | Expect nodes found with the provided XPath to either:
-- |
-- | * not exist
-- | * or be hidden visually and for them and their ancestors to be aria-hidden.
expectNotPresented ∷ ∀ eff o. XPath → Feature eff o Unit
expectNotPresented xPath = expectNotPresentedWithProperties Map.empty xPath

-- | Expect nodes found with the providied XPath to exist, be presented visually
-- | and for them and their ancestors not to be aria-hidden.
expectPresented ∷ ∀ eff o. XPath → Feature eff o Unit
expectPresented xPath = expectPresentedWithProperties Map.empty xPath

validateJustTrue
  ∷ ∀ eff o
  . (String → String)
  → String
  → Maybe String
  → Feature eff o Unit
validateJustTrue _ _ (Just "true") = pure unit
validateJustTrue error xPath _ = liftEff $ throw $ error xPath

expectNotPresentedAria ∷ ∀ eff o. Properties → XPath → Feature eff o Unit
expectNotPresentedAria properties xPath =
  ifFalse checkAria ∘ eq 0 ∘ length
    =<< findAllInvisibleWithPropertiesNotRepeatedly properties xPath
  where
  checkAria =
    throwIfEmpty message
      =<< findAllInvisibleWithPropertiesNotRepeatedly properties hiddenXPath
  hiddenXPath =
    xPath `XPath.ancestorOrSelf` "*[@aria-hidden='true']"

  message =
    XPath.errorMessage
      (withPropertiesMessage properties rawMessage)
      xPath

  printedAriaHiddenProperty =
    printProperty "aria-hidden" (Just "true")

  rawMessage =
    "Expected no elements to be found or for them or their ancestors to have an "
      ⊕ printedAriaHiddenProperty
      ⊕ " attribute"

expectNotPresentedVisual
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
expectNotPresentedVisual properties xPath =
  expectNotPresentedVisualElements properties xPath
    =<< findAllInvisibleWithPropertiesNotRepeatedly properties xPath

-- | Expect nodes found with the provided XPath which have the provided
-- | attributes or properties to either:
-- |
-- | * not exist
-- | * or be hidden visually and for them or their ancestors to be aria-hidden.
expectNotPresentedWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
expectNotPresentedWithProperties properties xPath =
  tryRepeatedlyTo
    $ expectNotPresentedWithPropertiesNotRepeatedly properties xPath

expectNotPresentedWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
expectNotPresentedWithPropertiesNotRepeatedly properties xPath =
  expectNotPresentedVisual properties xPath
    *> expectNotPresentedAria properties xPath

-- | Expect nodes found with the providied XPath which have the provided
-- | attributes or properties to exist, be presented visually and for them or
-- | their ancestors not to be aria-hidden.
expectPresentedWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
expectPresentedWithProperties ps xPath =
  tryRepeatedlyTo $ expectPresentedWithPropertiesNotRepeatedly ps xPath

expectPresentedWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
expectPresentedWithPropertiesNotRepeatedly properties xPath =
  expectNode
    *> expectPresentedVisual
    *> expectPresentedAria
  where
  verify =
    either (const $ pure unit) ∘ const ∘ throwExpectation

  throwExpectation =
    liftEff ∘ throw

  expectNode =
    findAtLeastOneWithPropertiesNotRepeatedly properties xPath

  expectPresentedVisual =
    verify visualError
      =<< (attempt $ expectNotPresentedVisual properties xPath)

  expectPresentedAria =
    verify ariaError
      =<< (attempt $ expectNotPresentedAria properties xPath)

  visualError =
    XPath.errorMessage (withPropertiesMessage properties visualMessage) xPath

  ariaError =
    XPath.errorMessage (withPropertiesMessage properties ariaMessage) xPath

  visualMessage =
    "Expected to find only visually presented elements"

  ariaMessage =
    "Expected no true values for \"aria-hidden\" on elements or their ancestors found"

-- | Expect the select node found with the provided XPath to have the option
-- | with the provided text selected.
-- |
-- | This only works when your select node's value is based on the value
-- | rather than the text of the option. It allows you to provide the text
-- | rather than the value which is an implementation detail.
-- |
-- | When your select node's value matches the option text use
-- | `expectPresentedWithProperties (Map.singleton "value" $ Just "the option text")`
-- | instead.
expectSelectValue ∷ ∀ eff o. String → XPath → Feature eff o Unit
expectSelectValue value xPath =
  tryRepeatedlyTo $ getOptionValue >>= expectPresentedWithValue
  where
  optionXPath = xPath ⊕ "/descendant::option[text()='" ⊕ value ⊕ "']"
  getOptionValue = flip getAttribute "value" =<< find optionXPath
  valueProperty = Map.singleton "value"
  expectPresentedWithValue value = expectPresentedWithProperties (valueProperty value) xPath

-- Independent expectations
-- | Expects the frst provided file to be in the provided folder and to match
-- | the second provided file.
expectDownloadedTextFileToMatchFile
  ∷ ∀ eff o
  . FilePath
  → FilePath
  → FilePath
  → Feature eff o Unit
expectDownloadedTextFileToMatchFile downloadFolder downloadedFileName expectedFilePath = do
  expectedString ← appendToCwd expectedFilePath
  expectedFile ← lift $ readTextFile UTF8 $ expectedString
  let filePath = downloadFolder ⊕ "/" ⊕ downloadedFileName
  await ("Expected file " ⊕ filePath ⊕ " to be downloaded") do
    files ← lift $ readdir downloadFolder
    pure $ isJust $ elemIndex downloadedFileName files
  downloadedFile ← lift $ readTextFile UTF8 $ filePath
  if downloadedFile == expectedFile
    then lift $ unlink filePath
    else liftEff $ throw $ notEqualError filePath downloadedFile expectedFilePath
  where
  notEqualError filePath fileContents expectedFilePath =
    "Expected file "
      ⊕ filePath
      ⊕ "'s contents\n\n"
      ⊕ fileContents
      ⊕ "\n\n to match file "
      ⊕ expectedFilePath

-- Interaction utilities
checkedProperty ∷ Maybe String → Properties
checkedProperty checked = Map.singleton "checked" checked

updateProperty ∷ String → Maybe String → Properties → Properties
updateProperty name value =
  Map.union $ Map.singleton name value

-- XPath dependent interactions
-- | Clear the element's value
clear ∷ ∀ eff o. XPath → Feature eff o Unit
clear xPath = clearWithProperties Map.empty xPath

-- | Check the checkbox node found with the provided XPath.
check ∷ ∀ eff o. XPath → Feature eff o Unit
check xPath = checkWithProperties Map.empty xPath

-- | Uncheck the checkbox node found with the provided XPath.
uncheck ∷ ∀ eff o. XPath → Feature eff o Unit
uncheck xPath = uncheckWithProperties Map.empty xPath

-- | Push the radio button node found with the provided XPath.
pushRadioButton ∷ ∀ eff o. XPath → Feature eff o Unit
pushRadioButton xPath = pushRadioButtonWithProperties Map.empty xPath

-- | Provide a value for the text or number field found with the provided
-- | XPath.
provideFieldValue ∷ ∀ eff o. XPath → String → Feature eff o Unit
provideFieldValue =
  provideFieldValueWithProperties Map.empty

-- | Select option with the provided text from the select node found with
-- | the provided XPath.
selectFromDropdown ∷ ∀ eff o. XPath → String → Feature eff o Unit
selectFromDropdown xPath text = selectFromDropdownWithProperties Map.empty xPath text

-- | Click the node found with the provided XPath.
click ∷ ∀ eff o. XPath → Feature eff o Unit
click xPath = clickWithProperties Map.empty xPath

-- | Click all nodes found with the provided XPath.
clickAll ∷ ∀ eff o. XPath → Feature eff o Unit
clickAll xPath = clickAllWithProperties Map.empty xPath

clickNotRepeatedly ∷ ∀ eff o. XPath → Feature eff o Unit
clickNotRepeatedly xPath = clickWithPropertiesNotRepeatedly Map.empty xPath

-- | Drag node found with the first provided XPath to the node found with the
-- | second provided XPath.
dragAndDrop ∷ ∀ eff o. XPath → XPath → Feature eff o Unit
dragAndDrop fromXPath toXPath =
  dragAndDropWithProperties Map.empty fromXPath Map.empty toXPath

-- | Hover over the node found with the provided XPath.
hover ∷ ∀ eff o. XPath → Feature eff o Unit
hover xPath = hoverWithProperties Map.empty xPath

-- | Provide file input value to the file input found with the provided XPath.
provideFileInputValue ∷ ∀ eff o. XPath → FilePath → Feature eff o Unit
provideFileInputValue xPath fileName = provideFileInputValueWithProperties Map.empty xPath fileName

-- | Navigate to the URL presented in the field found with the providied Xath.
-- |
-- | URLs are often presented in text inputs so they can be copied. This
-- | function allows feature tests to access such URLs.
accessUrlFromFieldValue ∷ ∀ eff o. XPath → Feature eff o Unit
accessUrlFromFieldValue xPath = accessUrlFromFieldValueWithProperties Map.empty xPath

-- XPath and property dependent interactions
clearWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
clearWithProperties properties xPath =
  tryRepeatedlyTo $ Selenium.clearEl =<< findWithPropertiesNotRepeatedly properties xPath

checkWithProperties'
  ∷ ∀ eff o
  . (Maybe String)
  → Properties
  → XPath
  → Feature eff o Unit
checkWithProperties' checked properties xPath =
  (traverse_ clickEl) =<< findAtLeastOneWithPropertiesNotRepeatedly properties' xPath
  where
  properties' = updateProperty "checked" checked properties

-- | Check the checkbox node with the provided properties found with the
-- | provided XPath.
checkWithProperties ∷ ∀ eff o. Properties → XPath → Feature eff o Unit
checkWithProperties properties xPath =
  tryRepeatedlyTo $ checkWithProperties' Nothing properties xPath

-- | Uncheck the checkbox node with the provided properties found with the
-- | provided XPath.
uncheckWithProperties ∷ ∀ eff o. Properties → XPath → Feature eff o Unit
uncheckWithProperties properties xPath =
  tryRepeatedlyTo $ checkWithProperties' (Just "true") properties xPath

-- | Push the radio button node with the provided properties found with the
-- | provided XPath.
pushRadioButtonWithProperties ∷ ∀ eff o. Properties → XPath → Feature eff o Unit
pushRadioButtonWithProperties properties xPath =
  tryRepeatedlyTo $ checkWithProperties' Nothing properties xPath

-- | Provide a value for the text or number field with the provided properties
-- | found with the provided XPath.
provideFieldValueWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → String
  → Feature eff o Unit
provideFieldValueWithProperties properties xPath value =
  tryRepeatedlyTo $ provideFieldValueElement value =<< findWithPropertiesNotRepeatedly properties xPath

-- | Select option with the provided text from the select node with the provided
-- | attributes or properties found with the provided XPath.
selectFromDropdownWithProperties ∷ ∀ eff o. Properties → XPath → String → Feature eff o Unit
selectFromDropdownWithProperties properties xPath text =
  tryRepeatedlyTo $ selectFromDropdownElement text =<< findWithPropertiesNotRepeatedly properties xPath

clickWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
clickWithPropertiesNotRepeatedly properties =
  clickEl <=< findWithPropertiesNotRepeatedly properties

-- | Click node with the provided properties or attributes found with the
-- | provided XPath.
clickWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
clickWithProperties properties xPath =
  tryRepeatedlyTo $ clickEl =<< findWithPropertiesNotRepeatedly properties xPath

-- | Click all nodes with the provided properties or attributes found with the
-- | provided XPath.
clickAllWithProperties ∷ ∀ eff o. Properties → XPath → Feature eff o Unit
clickAllWithProperties properties xPath =
  tryRepeatedlyTo
    $ (traverse_ clickEl)
    =<< findAtLeastOneWithPropertiesNotRepeatedly properties xPath

-- | Drag node with the first provided properties or attributes found with the first
-- | provided XPath to the node with the second provided properties or attributes found with
-- | the second provided XPath.
dragAndDropWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → Properties
  → XPath
  → Feature eff o Unit
dragAndDropWithProperties fromProperties fromXPath toProperties toXPath =
  tryRepeatedlyTo do
    from ← findWithPropertiesNotRepeatedly fromProperties fromXPath
    fromLocation ← getCenterLocation from
    toLocation ← getCenterLocation =<< findWithPropertiesNotRepeatedly toProperties toXPath
    dragAndDropElement from $ offset fromLocation toLocation
  where
  offset from to =
    { x: to.x - from.x
    , y: to.y - from.y
    }
  getCenterLocation element = do
    location ← getLocation element
    size ← getSize element
    pure
      { x: location.x + (size.width / 2)
      , y: location.y + (size.height / 2)
      }

-- | Hover over the node with the provided properties or attributes found with
-- | the provided XPath.
hoverWithProperties ∷ ∀ eff o. Properties → XPath → Feature eff o Unit
hoverWithProperties properties xPath =
  tryRepeatedlyTo $ hoverElement =<< findWithPropertiesNotRepeatedly properties xPath

-- | Provide file input value to the file input with the provided attributes or
-- | properties found with the provided XPath. This also will find invisible
-- | file inputs.
provideFileInputValueWithProperties ∷ ∀ eff o. Properties → XPath → FilePath → Feature eff o Unit
provideFileInputValueWithProperties properties xPath filePath =
  tryRepeatedlyTo $ sendKeysEl filePath
    =<< findInvisibleWithPropertiesNotRepeatedly properties xPath

-- | Navigate to the URL presented in the field with the provided attributes or
-- | properties found with the providied Xath.
-- |
-- | URLs are often presented in text inputs so they can be copied. This
-- | function allows feature tests to access such URLs.
accessUrlFromFieldValueWithProperties ∷ ∀ eff o. Properties → XPath → Feature eff o Unit
accessUrlFromFieldValueWithProperties properties xPath =
  tryRepeatedlyTo $ get =<< maybe throwNullValueError pure =<< getValue =<< findField
  where
  findField = findWithPropertiesNotRepeatedly properties xPath
  getValue = flip getAttribute "value"
  throwNullValueError = liftEff $ throw nullValueErrorMessage
  nullValueErrorMessage =
    XPath.errorMessage (withPropertiesMessage properties rawNullValueErrorMessage) xPath
  rawNullValueErrorMessage =
    "Expected a non null value attribute or property for the element found with"

-- Independent interactions
typeString ∷ ∀ eff o. String → Feature eff o Unit
typeString string = Selenium.sequence $ FeatureSequence.keys string

pressEnter ∷ ∀ eff o. Feature eff o Unit
pressEnter = Selenium.sequence $ FeatureSequence.sendEnter

-- Element dependent interactions
clickAllElements ∷ ∀ eff o. Array Element → Feature eff o Unit
clickAllElements = traverse_ clickEl

clearElement ∷ ∀ eff o. Element → Feature eff o Unit
clearElement element =
  Selenium.clickEl element
    *> moveToEndOfString
    *> typeEnoughBackspaces
  where
  getValueLength ∷ Feature eff o (Maybe Int)
  getValueLength = map String.length <$> Selenium.getAttribute element "value"

  getTextLength ∷ Feature eff o Int
  getTextLength = map String.length $ Selenium.getText element

  getTotalLength ∷ Feature eff o Int
  getTotalLength = do
    vl ← map (fromMaybe zero) getValueLength
    tl ← getTextLength
    pure $ vl + tl

  typeEnoughBackspaces ∷ Feature eff o Unit
  typeEnoughBackspaces = typeBackspaces =<< getTotalLength

  moveToEndOfString ∷ Feature eff o Unit
  moveToEndOfString = typeRightArrow =<< getTotalLength

  typeBackspaces ∷ Int → Feature eff o Unit
  typeBackspaces = Selenium.sequence ∘ FeatureSequence.sendBackspaces

  typeRightArrow ∷ Int → Feature eff o Unit
  typeRightArrow = Selenium.sequence ∘ FeatureSequence.sendRights

hoverElement ∷ ∀ eff o. Element → Feature eff o Unit
hoverElement = Selenium.sequence ∘ Sequence.hover

provideFieldValueElement ∷ ∀ eff o. String → Element → Feature eff o Unit
provideFieldValueElement value element =
  Selenium.clickEl element *> clearElement element *> typeString value

selectFromDropdownElement ∷ ∀ eff o. String → Element → Feature eff o Unit
selectFromDropdownElement text element = do
  clickEl element
  typeString text
  pressEnter

dragAndDropElement ∷ ∀ eff o. Element → Location → Feature eff o Unit
dragAndDropElement from =
  Selenium.sequence <<< Sequence.dndToLocation from

-- Element dependent functions
elementsWithProperties
  ∷ ∀ eff o
  . Properties
  → Array Element
  → Feature eff o (Array Element)
elementsWithProperties properties
  | Map.isEmpty properties = pure
elementsWithProperties properties =
  map filterElementsPropertiesPairs
    ∘ elementsPropertiesTuples
  where
  propKeys ∷ L.List String
  propKeys = Map.keys properties

  filterElementsPropertiesPairs
    ∷ ∀ f
    . (Foldable f)
    ⇒ f (Tuple Element Properties)
    → Array Element
  filterElementsPropertiesPairs =
    foldMap (\(Tuple el ps) → guard (ps == properties) $> el)

  getPropertiesForElement
    ∷ Element
    → Feature eff o Properties
  getPropertiesForElement el =
    Map.fromFoldable
      <$> traverse (\k → Tuple k <$> ((later 0 $ getAttribute el k))) propKeys

  elementsPropertiesTuples
    ∷ ∀ t
    . (Traversable t)
    ⇒ t Element
    → Feature eff o (t (Tuple Element Properties))
  elementsPropertiesTuples =
    traverse (\el → Tuple el <$> getPropertiesForElement el)

expectNotPresentedVisualElements
  ∷ ∀ eff o
  . Properties
  → XPath
  → Array Element
  → Feature eff o Unit
expectNotPresentedVisualElements properties xPath =
  traverse_ validate
  where
  validate =
    ifTrue throwVisualError <=< isDisplayed

  throwVisualError =
    liftEff $ throw $ XPath.errorMessage message xPath

  message =
    withPropertiesMessage
      properties
      "Expected to find no visually displayed elements"

expectPresentedVisualElements
  ∷ ∀ eff o
  . Properties
  → String
  → Array Element
  → Feature eff o Unit
expectPresentedVisualElements properties xPath =
  traverse_ (\element → hoverElement element *> validate element)
  where
  validate =
    ifFalse throwVisualError <=< isDisplayed

  throwVisualError =
    liftEff $ throw $ XPath.errorMessage message xPath

  message =
    withPropertiesMessage
      properties
      "Expected to find only visually displayed elements"

-- Utilities
logCurrentScreen ∷ ∀ eff o. Feature eff o Unit
logCurrentScreen =
  saveScreenshot path *> logScreenshot path
  where
  path = "current.png"
  message = ("Screenshot taken now:\ndata:image/png;base64," <> _)
  logScreenshot p = (message <$> showImageFile p) >>= warnMsg

showImageFile ∷ ∀ eff o. FilePath → Feature eff o String
showImageFile =
  showBuffer <=< readBuffer <=< getFullPath
  where
  getFullPath = appendToCwd
  readBuffer = lift ∘ readFile
  showBuffer = liftEff ∘ toString Base64

module Test.Feature
  ( Properties
  , XPath
  , FilePath
  , accessUrlFromFieldValue
  , accessUrlFromFieldValueWithProperties
  , check
  , checkWithProperties
  , clear
  , clearWithProperties
  , click
  , clickWithProperties
  , clickNotRepeatedly
  , dragAndDrop
  , dragAndDropWithProperties
  , expectDownloadedTextFileToMatchFile
  , expectNotPresented
  , expectNotPresentedWithProperties
  , expectNotPresentedNotRepeatedly
  , expectNotPresentedWithPropertiesNotRepeatedly
  , expectPresented
  , expectPresentedWithProperties
  , expectPresentedNotRepeatedly
  , expectPresentedWithPropertiesNotRepeatedly
  , expectSelectValue
  , hover
  , hoverWithProperties
  , pressEnter
  , provideFieldValue
  , provideFieldValueWithProperties
  , provideFileInputValue
  , provideFileInputValueWithProperties
  , pushRadioButton
  , pushRadioButtonWithProperties
  , selectFromDropdown
  , selectFromDropdownWithProperties
  , typeString
  , uncheck
  , uncheckWithProperties
  , smallWaitTime
  , logCurrentScreen
  ) where

import SlamData.Prelude

import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Exception (throw)

import Data.Array (elemIndex, length)
import Data.List (toUnfoldable)
import Data.List as L
import Data.Map as Map
import Data.String as String

import Node.Buffer (toString)
import Node.Encoding (Encoding(..))
import Node.FS.Aff (readFile, readTextFile, readdir, unlink)

import Selenium.ActionSequence as Sequence
import Selenium.Monad (get, getAttribute, clickEl, attempt, later, byXPath, tryRepeatedlyTo, findElements, isDisplayed, getLocation, getSize, saveScreenshot, sendKeysEl)
import Selenium.Monad as Selenium
import Selenium.Types (Element, Location)

import Test.Feature.ActionSequence as FeatureSequence
import Test.Feature.Log (warnMsg)
import Test.Feature.Monad (Feature, await)
import Test.Utils (appendToCwd, ifTrue, ifFalse, throwIfNotEmpty, singletonValue, throwIfEmpty, passover)

import XPath as XPath

type Properties = Map.Map String (Maybe String)
type XPath = String
type FilePath = String

smallWaitTime ∷ Int
smallWaitTime = 500

finderInternalFindAllNotRepeatedly ∷ ∀ eff o. XPath → Feature eff o (Array Element)
finderInternalFindAllNotRepeatedly =
  map toUnfoldable ∘ findElements <=< byXPath

-- Basic XPath dependent finders
findAllNotRepeatedly ∷ ∀ eff o. XPath → Feature eff o (Array Element)
findAllNotRepeatedly = findAllWithPropertiesNotRepeatedly Map.empty

findNotRepeatedly ∷ ∀ eff o. XPath → Feature eff o Element
findNotRepeatedly xPath =
  singletonValue throwNoElements throwMoreThanOneElement
    =<< findAllNotRepeatedly xPath
  where
  throwNoElements =
    liftEff
      $ throw
      $ XPath.errorMessage "Couldn't find an element" xPath

  throwMoreThanOneElement i =
    liftEff
      $ throw
      $ XPath.errorMessage
          ("Found (" ⊕ show i ⊕ ") more than one element")
          xPath

findAtLeastOneNotRepeatedly ∷ ∀ eff o. XPath → Feature eff o (Array Element)
findAtLeastOneNotRepeatedly xPath =
  headOrThrow =<< findAllNotRepeatedly xPath
  where
  headOrThrow = passover (throwIfEmpty noElementsMessage)
  noElementsMessage = XPath.errorMessage "Couldn't find an element" xPath

find ∷ ∀ eff o. XPath → Feature eff o Element
find xPath = expectPresented xPath *> findNotRepeatedly xPath

findAll ∷ ∀ eff o. XPath → Feature eff o (Array Element)
findAll xPath = expectPresented xPath *> findAllNotRepeatedly xPath

-- Property and XPath dependent finders
findAllInvisibleWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o (Array Element)
findAllInvisibleWithPropertiesNotRepeatedly properties xPath =
  elementsWithProperties properties
    =<< finderInternalFindAllNotRepeatedly xPath

findAllWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o (Array Element)
findAllWithPropertiesNotRepeatedly properties xPath =
  passover (expectPresentedVisualElements properties xPath)
    =<< elementsWithProperties properties
    =<< finderInternalFindAllNotRepeatedly xPath

findAtLeastOneWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o (Array Element)
findAtLeastOneWithPropertiesNotRepeatedly properties xPath =
  headOrThrow
    =<< elementsWithProperties properties
    =<< findAllNotRepeatedly xPath
  where
  headOrThrow =
    passover (throwIfEmpty noElementsMessage)
  noElementsMessage =
    XPath.errorMessage
      (withPropertiesMessage properties "Couldn't find an element")
      xPath

findInvisibleWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Element
findInvisibleWithPropertiesNotRepeatedly properties xPath =
  singletonValue throwNoElements throwMoreThanOneElement
    =<< findAllInvisibleWithPropertiesNotRepeatedly properties xPath
  where
  throwNoElements =
    liftEff $ throw $ noElementWithPropertiesError properties xPath

  throwMoreThanOneElement i =
    liftEff $ throw $ moreThanOneElementMessage i

  moreThanOneElementRawMessage i = "Found (" ⊕ show i ⊕ ") more than one element"
  moreThanOneElementMessage i =
    XPath.errorMessage
      (withPropertiesMessage properties
       $ moreThanOneElementRawMessage i) xPath

findWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Element
findWithPropertiesNotRepeatedly properties xPath =
  singletonValue throwNoElements throwMoreThanOneElement
    =<< findAllWithPropertiesNotRepeatedly properties xPath
  where
  throwNoElements =
    liftEff $ throw $ noElementWithPropertiesError properties xPath

  throwMoreThanOneElement i =
    liftEff $ throw $ moreThanOneElementMessage i

  moreThanOneElementRawMessage i = "Found (" ⊕ show i ⊕ ") more than one element"
  moreThanOneElementMessage i =
    XPath.errorMessage
      (withPropertiesMessage properties
       $ moreThanOneElementRawMessage i) xPath

findAllWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o (Array Element)
findAllWithProperties properties xPath =
  expectPresentedWithProperties properties xPath
    *> findAllWithPropertiesNotRepeatedly properties xPath

findAtLeastOneWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o (Array Element)
findAtLeastOneWithProperties properties xPath =
  expectPresentedWithProperties properties xPath
    *> findAtLeastOneWithPropertiesNotRepeatedly properties xPath

findWithProperties ∷ ∀ eff o. Properties → XPath → Feature eff o Element
findWithProperties properties xPath =
  expectPresentedWithProperties properties xPath
    *> findWithPropertiesNotRepeatedly properties xPath

-- Errors
printPropertyValue ∷ Maybe String → String
printPropertyValue = maybe "null" show

printProperty ∷ String → Maybe String → String
printProperty name value =
  name ⊕ "=" ⊕ printPropertyValue value

printProperties ∷ Properties → String
printProperties =
  String.joinWith " "
    ∘ L.toUnfoldable
    ∘ map (uncurry printProperty)
    ∘ Map.toList

noElementWithPropertiesError ∷ Properties → XPath → String
noElementWithPropertiesError properties =
  XPath.errorMessage
    $ withPropertiesMessage properties "Unable to find element with "

elementWithPropertiesError ∷ Properties → XPath → String
elementWithPropertiesError properties =
  XPath.errorMessage
    $ withPropertiesMessage properties "Expected not to find element with "

withPropertiesMessage ∷ Properties → String → String
withPropertiesMessage mp s
  | Map.isEmpty mp = s
withPropertiesMessage xs s =
  s ⊕ " with the attributes or properties: " ⊕ printProperties xs

-- Expectations
expectNotPresentedNotRepeatedly ∷ ∀ eff o. XPath → Feature eff o Unit
expectNotPresentedNotRepeatedly xPath =
  expectNotPresentedWithPropertiesNotRepeatedly Map.empty xPath

expectPresentedNotRepeatedly ∷ ∀ eff o. XPath → Feature eff o Unit
expectPresentedNotRepeatedly xPath =
  expectPresentedWithPropertiesNotRepeatedly Map.empty xPath

-- | Expect nodes found with the provided XPath to either:
-- |
-- | * not exist
-- | * or be hidden visually and for them and their ancestors to be aria-hidden.
expectNotPresented ∷ ∀ eff o. XPath → Feature eff o Unit
expectNotPresented xPath = expectNotPresentedWithProperties Map.empty xPath

-- | Expect nodes found with the providied XPath to exist, be presented visually
-- | and for them and their ancestors not to be aria-hidden.
expectPresented ∷ ∀ eff o. XPath → Feature eff o Unit
expectPresented xPath = expectPresentedWithProperties Map.empty xPath

validateJustTrue
  ∷ ∀ eff o
  . (String → String)
  → String
  → Maybe String
  → Feature eff o Unit
validateJustTrue _ _ (Just "true") = pure unit
validateJustTrue error xPath _ = liftEff $ throw $ error xPath

expectNotPresentedAria ∷ ∀ eff o. Properties → XPath → Feature eff o Unit
expectNotPresentedAria properties xPath =
  ifFalse checkAria ∘ eq 0 ∘ length
    =<< findAllInvisibleWithPropertiesNotRepeatedly properties xPath
  where
  checkAria =
    throwIfEmpty message
      =<< findAllInvisibleWithPropertiesNotRepeatedly properties hiddenXPath
  hiddenXPath =
    xPath `XPath.ancestorOrSelf` "*[@aria-hidden='true']"

  message =
    XPath.errorMessage
      (withPropertiesMessage properties rawMessage)
      xPath

  printedAriaHiddenProperty =
    printProperty "aria-hidden" (Just "true")

  rawMessage =
    "Expected no elements to be found or for them or their ancestors to have an "
      ⊕ printedAriaHiddenProperty
      ⊕ " attribute"

expectNotPresentedVisual
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
expectNotPresentedVisual properties xPath =
  expectNotPresentedVisualElements properties xPath
    =<< findAllInvisibleWithPropertiesNotRepeatedly properties xPath

-- | Expect nodes found with the provided XPath which have the provided
-- | attributes or properties to either:
-- |
-- | * not exist
-- | * or be hidden visually and for them or their ancestors to be aria-hidden.
expectNotPresentedWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
expectNotPresentedWithProperties properties xPath =
  tryRepeatedlyTo
    $ expectNotPresentedWithPropertiesNotRepeatedly properties xPath

expectNotPresentedWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
expectNotPresentedWithPropertiesNotRepeatedly properties xPath =
  expectNotPresentedVisual properties xPath
    *> expectNotPresentedAria properties xPath

-- | Expect nodes found with the providied XPath which have the provided
-- | attributes or properties to exist, be presented visually and for them or
-- | their ancestors not to be aria-hidden.
expectPresentedWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
expectPresentedWithProperties ps xPath =
  tryRepeatedlyTo $ expectPresentedWithPropertiesNotRepeatedly ps xPath

expectPresentedWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
expectPresentedWithPropertiesNotRepeatedly properties xPath =
  expectNode
    *> expectPresentedVisual
    *> expectPresentedAria
  where
  verify =
    either (const $ pure unit) ∘ const ∘ throwExpectation

  throwExpectation =
    liftEff ∘ throw

  expectNode =
    findAtLeastOneWithPropertiesNotRepeatedly properties xPath

  expectPresentedVisual =
    verify visualError
      =<< (attempt $ expectNotPresentedVisual properties xPath)

  expectPresentedAria =
    verify ariaError
      =<< (attempt $ expectNotPresentedAria properties xPath)

  visualError =
    XPath.errorMessage (withPropertiesMessage properties visualMessage) xPath

  ariaError =
    XPath.errorMessage (withPropertiesMessage properties ariaMessage) xPath

  visualMessage =
    "Expected to find only visually presented elements"

  ariaMessage =
    "Expected no true values for \"aria-hidden\" on elements or their ancestors found"

-- | Expect the select node found with the provided XPath to have the option
-- | with the provided text selected.
-- |
-- | This only works when your select node's value is based on the value
-- | rather than the text of the option. It allows you to provide the text
-- | rather than the value which is an implementation detail.
-- |
-- | When your select node's value matches the option text use
-- | `expectPresentedWithProperties (Map.singleton "value" $ Just "the option text")`
-- | instead.
expectSelectValue ∷ ∀ eff o. String → XPath → Feature eff o Unit
expectSelectValue value xPath =
  tryRepeatedlyTo $ getOptionValue >>= expectPresentedWithValue
  where
  optionXPath = xPath ⊕ "/descendant::option[text()='" ⊕ value ⊕ "']"
  getOptionValue = flip getAttribute "value" =<< find optionXPath
  valueProperty = Map.singleton "value"
  expectPresentedWithValue value = expectPresentedWithProperties (valueProperty value) xPath

-- Independent expectations
-- | Expects the frst provided file to be in the provided folder and to match
-- | the second provided file.
expectDownloadedTextFileToMatchFile
  ∷ ∀ eff o
  . FilePath
  → FilePath
  → FilePath
  → Feature eff o Unit
expectDownloadedTextFileToMatchFile downloadFolder downloadedFileName expectedFilePath = do
  expectedString ← appendToCwd expectedFilePath
  expectedFile ← lift $ readTextFile UTF8 $ expectedString
  let filePath = downloadFolder ⊕ "/" ⊕ downloadedFileName
  await ("Expected file " ⊕ filePath ⊕ " to be downloaded") do
    files ← lift $ readdir downloadFolder
    pure $ isJust $ elemIndex downloadedFileName files
  downloadedFile ← lift $ readTextFile UTF8 $ filePath
  if downloadedFile == expectedFile
    then lift $ unlink filePath
    else liftEff $ throw $ notEqualError filePath downloadedFile expectedFilePath
  where
  notEqualError filePath fileContents expectedFilePath =
    "Expected file "
      ⊕ filePath
      ⊕ "'s contents\n\n"
      ⊕ fileContents
      ⊕ "\n\n to match file "
      ⊕ expectedFilePath

-- Interaction utilities
checkedProperty ∷ Maybe String → Properties
checkedProperty checked = Map.singleton "checked" checked

updateProperty ∷ String → Maybe String → Properties → Properties
updateProperty name value =
  Map.union $ Map.singleton name value

-- XPath dependent interactions
-- | Clear the element's value
clear ∷ ∀ eff o. XPath → Feature eff o Unit
clear xPath = clearWithProperties Map.empty xPath

-- | Check the checkbox node found with the provided XPath.
check ∷ ∀ eff o. XPath → Feature eff o Unit
check xPath = checkWithProperties Map.empty xPath

-- | Uncheck the checkbox node found with the provided XPath.
uncheck ∷ ∀ eff o. XPath → Feature eff o Unit
uncheck xPath = uncheckWithProperties Map.empty xPath

-- | Push the radio button node found with the provided XPath.
pushRadioButton ∷ ∀ eff o. XPath → Feature eff o Unit
pushRadioButton xPath = pushRadioButtonWithProperties Map.empty xPath

-- | Provide a value for the text or number field found with the provided
-- | XPath.
provideFieldValue ∷ ∀ eff o. XPath → String → Feature eff o Unit
provideFieldValue =
  provideFieldValueWithProperties Map.empty

-- | Select option with the provided text from the select node found with
-- | the provided XPath.
selectFromDropdown ∷ ∀ eff o. XPath → String → Feature eff o Unit
selectFromDropdown xPath text = selectFromDropdownWithProperties Map.empty xPath text

-- | Click the node found with the provided XPath.
click ∷ ∀ eff o. XPath → Feature eff o Unit
click xPath = clickWithProperties Map.empty xPath

-- | Click all nodes found with the provided XPath.
clickAll ∷ ∀ eff o. XPath → Feature eff o Unit
clickAll xPath = clickAllWithProperties Map.empty xPath

clickNotRepeatedly ∷ ∀ eff o. XPath → Feature eff o Unit
clickNotRepeatedly xPath = clickWithPropertiesNotRepeatedly Map.empty xPath

-- | Drag node found with the first provided XPath to the node found with the
-- | second provided XPath.
dragAndDrop ∷ ∀ eff o. XPath → XPath → Feature eff o Unit
dragAndDrop fromXPath toXPath =
  dragAndDropWithProperties Map.empty fromXPath Map.empty toXPath

-- | Hover over the node found with the provided XPath.
hover ∷ ∀ eff o. XPath → Feature eff o Unit
hover xPath = hoverWithProperties Map.empty xPath

-- | Provide file input value to the file input found with the provided XPath.
provideFileInputValue ∷ ∀ eff o. XPath → FilePath → Feature eff o Unit
provideFileInputValue xPath fileName = provideFileInputValueWithProperties Map.empty xPath fileName

-- | Navigate to the URL presented in the field found with the providied Xath.
-- |
-- | URLs are often presented in text inputs so they can be copied. This
-- | function allows feature tests to access such URLs.
accessUrlFromFieldValue ∷ ∀ eff o. XPath → Feature eff o Unit
accessUrlFromFieldValue xPath = accessUrlFromFieldValueWithProperties Map.empty xPath

-- XPath and property dependent interactions
clearWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
clearWithProperties properties xPath =
  tryRepeatedlyTo $ Selenium.clearEl =<< findWithPropertiesNotRepeatedly properties xPath

checkWithProperties'
  ∷ ∀ eff o
  . (Maybe String)
  → Properties
  → XPath
  → Feature eff o Unit
checkWithProperties' checked properties xPath =
  (traverse_ clickEl) =<< findAtLeastOneWithPropertiesNotRepeatedly properties' xPath
  where
  properties' = updateProperty "checked" checked properties

-- | Check the checkbox node with the provided properties found with the
-- | provided XPath.
checkWithProperties ∷ ∀ eff o. Properties → XPath → Feature eff o Unit
checkWithProperties properties xPath =
  tryRepeatedlyTo $ checkWithProperties' Nothing properties xPath

-- | Uncheck the checkbox node with the provided properties found with the
-- | provided XPath.
uncheckWithProperties ∷ ∀ eff o. Properties → XPath → Feature eff o Unit
uncheckWithProperties properties xPath =
  tryRepeatedlyTo $ checkWithProperties' (Just "true") properties xPath

-- | Push the radio button node with the provided properties found with the
-- | provided XPath.
pushRadioButtonWithProperties ∷ ∀ eff o. Properties → XPath → Feature eff o Unit
pushRadioButtonWithProperties properties xPath =
  tryRepeatedlyTo $ checkWithProperties' Nothing properties xPath

-- | Provide a value for the text or number field with the provided properties
-- | found with the provided XPath.
provideFieldValueWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → String
  → Feature eff o Unit
provideFieldValueWithProperties properties xPath value =
  tryRepeatedlyTo $ provideFieldValueElement value =<< findWithPropertiesNotRepeatedly properties xPath

-- | Select option with the provided text from the select node with the provided
-- | attributes or properties found with the provided XPath.
selectFromDropdownWithProperties ∷ ∀ eff o. Properties → XPath → String → Feature eff o Unit
selectFromDropdownWithProperties properties xPath text =
  tryRepeatedlyTo $ selectFromDropdownElement text =<< findWithPropertiesNotRepeatedly properties xPath

clickWithPropertiesNotRepeatedly
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
clickWithPropertiesNotRepeatedly properties =
  clickEl <=< findWithPropertiesNotRepeatedly properties

-- | Click node with the provided properties or attributes found with the
-- | provided XPath.
clickWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → Feature eff o Unit
clickWithProperties properties xPath =
  tryRepeatedlyTo $ clickEl =<< findWithPropertiesNotRepeatedly properties xPath

-- | Click all nodes with the provided properties or attributes found with the
-- | provided XPath.
clickAllWithProperties ∷ ∀ eff o. Properties → XPath → Feature eff o Unit
clickAllWithProperties properties xPath =
  tryRepeatedlyTo
    $ (traverse_ clickEl)
    =<< findAtLeastOneWithPropertiesNotRepeatedly properties xPath

-- | Drag node with the first provided properties or attributes found with the first
-- | provided XPath to the node with the second provided properties or attributes found with
-- | the second provided XPath.
dragAndDropWithProperties
  ∷ ∀ eff o
  . Properties
  → XPath
  → Properties
  → XPath
  → Feature eff o Unit
dragAndDropWithProperties fromProperties fromXPath toProperties toXPath =
  tryRepeatedlyTo do
    from ← findWithPropertiesNotRepeatedly fromProperties fromXPath
    fromLocation ← getCenterLocation from
    toLocation ← getCenterLocation =<< findWithPropertiesNotRepeatedly toProperties toXPath
    dragAndDropElement from $ offset fromLocation toLocation
  where
  offset from to =
    { x: to.x - from.x
    , y: to.y - from.y
    }
  getCenterLocation element = do
    location ← getLocation element
    size ← getSize element
    pure
      { x: location.x + (size.width / 2)
      , y: location.y + (size.height / 2)
      }

-- | Hover over the node with the provided properties or attributes found with
-- | the provided XPath.
hoverWithProperties ∷ ∀ eff o. Properties → XPath → Feature eff o Unit
hoverWithProperties properties xPath =
  tryRepeatedlyTo $ hoverElement =<< findWithPropertiesNotRepeatedly properties xPath

-- | Provide file input value to the file input with the provided attributes or
-- | properties found with the provided XPath. This also will find invisible
-- | file inputs.
provideFileInputValueWithProperties ∷ ∀ eff o. Properties → XPath → FilePath → Feature eff o Unit
provideFileInputValueWithProperties properties xPath filePath =
  tryRepeatedlyTo $ sendKeysEl filePath
    =<< findInvisibleWithPropertiesNotRepeatedly properties xPath

-- | Navigate to the URL presented in the field with the provided attributes or
-- | properties found with the providied Xath.
-- |
-- | URLs are often presented in text inputs so they can be copied. This
-- | function allows feature tests to access such URLs.
accessUrlFromFieldValueWithProperties ∷ ∀ eff o. Properties → XPath → Feature eff o Unit
accessUrlFromFieldValueWithProperties properties xPath =
  tryRepeatedlyTo $ get =<< maybe throwNullValueError pure =<< getValue =<< findField
  where
  findField = findWithPropertiesNotRepeatedly properties xPath
  getValue = flip getAttribute "value"
  throwNullValueError = liftEff $ throw nullValueErrorMessage
  nullValueErrorMessage =
    XPath.errorMessage (withPropertiesMessage properties rawNullValueErrorMessage) xPath
  rawNullValueErrorMessage =
    "Expected a non null value attribute or property for the element found with"

-- Independent interactions
typeString ∷ ∀ eff o. String → Feature eff o Unit
typeString string = Selenium.sequence $ FeatureSequence.keys string

pressEnter ∷ ∀ eff o. Feature eff o Unit
pressEnter = Selenium.sequence $ FeatureSequence.sendEnter

-- Element dependent interactions
clickAllElements ∷ ∀ eff o. Array Element → Feature eff o Unit
clickAllElements = traverse_ clickEl

clearElement ∷ ∀ eff o. Element → Feature eff o Unit
clearElement element =
  Selenium.clickEl element
    *> moveToEndOfString
    *> typeEnoughBackspaces
  where
  getValueLength ∷ Feature eff o (Maybe Int)
  getValueLength = map String.length <$> Selenium.getAttribute element "value"

  getTextLength ∷ Feature eff o Int
  getTextLength = map String.length $ Selenium.getText element

  getTotalLength ∷ Feature eff o Int
  getTotalLength = do
    vl ← map (fromMaybe zero) getValueLength
    tl ← getTextLength
    pure $ vl + tl

  typeEnoughBackspaces ∷ Feature eff o Unit
  typeEnoughBackspaces = typeBackspaces =<< getTotalLength

  moveToEndOfString ∷ Feature eff o Unit
  moveToEndOfString = typeRightArrow =<< getTotalLength

  typeBackspaces ∷ Int → Feature eff o Unit
  typeBackspaces = Selenium.sequence ∘ FeatureSequence.sendBackspaces

  typeRightArrow ∷ Int → Feature eff o Unit
  typeRightArrow = Selenium.sequence ∘ FeatureSequence.sendRights

hoverElement ∷ ∀ eff o. Element → Feature eff o Unit
hoverElement = Selenium.sequence ∘ Sequence.hover

provideFieldValueElement ∷ ∀ eff o. String → Element → Feature eff o Unit
provideFieldValueElement value element =
  Selenium.clickEl element *> clearElement element *> typeString value

selectFromDropdownElement ∷ ∀ eff o. String → Element → Feature eff o Unit
selectFromDropdownElement text element = do
  clickEl element
  typeString text
  pressEnter

dragAndDropElement ∷ ∀ eff o. Element → Location → Feature eff o Unit
dragAndDropElement from =
  Selenium.sequence <<< Sequence.dndToLocation from

-- Element dependent functions
elementsWithProperties
  ∷ ∀ eff o
  . Properties
  → Array Element
  → Feature eff o (Array Element)
elementsWithProperties properties
  | Map.isEmpty properties = pure
elementsWithProperties properties =
  map filterElementsPropertiesPairs
    ∘ elementsPropertiesTuples
  where
  propKeys ∷ L.List String
  propKeys = Map.keys properties

  filterElementsPropertiesPairs
    ∷ ∀ f
    . (Foldable f)
    ⇒ f (Tuple Element Properties)
    → Array Element
  filterElementsPropertiesPairs =
    foldMap (\(Tuple el ps) → guard (ps == properties) $> el)

  getPropertiesForElement
    ∷ Element
    → Feature eff o Properties
  getPropertiesForElement el =
    Map.fromFoldable
      <$> traverse (\k → Tuple k <$> ((later 0 $ getAttribute el k))) propKeys

  elementsPropertiesTuples
    ∷ ∀ t
    . (Traversable t)
    ⇒ t Element
    → Feature eff o (t (Tuple Element Properties))
  elementsPropertiesTuples =
    traverse (\el → Tuple el <$> getPropertiesForElement el)

expectNotPresentedVisualElements
  ∷ ∀ eff o
  . Properties
  → XPath
  → Array Element
  → Feature eff o Unit
expectNotPresentedVisualElements properties xPath =
  traverse_ validate
  where
  validate =
    ifTrue throwVisualError <=< isDisplayed

  throwVisualError =
    liftEff $ throw $ XPath.errorMessage message xPath

  message =
    withPropertiesMessage
      properties
      "Expected to find no visually displayed elements"

expectPresentedVisualElements
  ∷ ∀ eff o
  . Properties
  → String
  → Array Element
  → Feature eff o Unit
expectPresentedVisualElements properties xPath =
  traverse_ (\element → hoverElement element *> validate element)
  where
  validate =
    ifFalse throwVisualError <=< isDisplayed

  throwVisualError =
    liftEff $ throw $ XPath.errorMessage message xPath

  message =
    withPropertiesMessage
      properties
      "Expected to find only visually displayed elements"

-- Utilities
logCurrentScreen ∷ ∀ eff o. Feature eff o Unit
logCurrentScreen =
  saveScreenshot path *> logScreenshot path
  where
  path = "current.png"
  message = ("Screenshot taken now:\ndata:image/png;base64," <> _)
  logScreenshot p = (message <$> showImageFile p) >>= warnMsg

showImageFile ∷ ∀ eff o. FilePath → Feature eff o String
showImageFile =
  showBuffer <=< readBuffer <=< getFullPath
  where
  getFullPath = appendToCwd
  readBuffer = lift ∘ readFile
  showBuffer = liftEff ∘ toString Base64


Update

Update

module Main where

import Prelude
import Math as Math
import Data.Array
import Data.Maybe (Maybe(..))
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (logShow)
import DOM
import Graphics.Canvas
import Signal
import Signal.DOM
import Partial.Unsafe (unsafePartial)

oRate :: Number
oRate = 0.999

fric :: Number
fric = 0.0

data Point3D = Point3D
	{	x :: Number
	,	y :: Number
	,	z :: Number
	}

vertices :: Array Point3D
vertices =
	[ Point3D {x:(-100.0), y:100.0, z:(-100.0)}
		,Point3D {x:100.0, y:100.0, z:(-100.0)}
		,Point3D {x:100.0, y:(-100.0), z:(-100.0)}
		,Point3D {x:(-100.0), y:(-100.0), z:(-100.0)}
		,Point3D {x:(-100.0), y:100.0, z:100.0}
		,Point3D {x:100.0, y:100.0, z:100.0}
		,Point3D {x:100.0, y:(-100.0), z:100.0}
		,Point3D {x:(-100.0), y:(-100.0), z:100.0}
	]

data Angle3D = Angle3D
	{	qx :: Number
	, qy :: Number
	, qz :: Number
	}

angle :: Angle3D
angle = Angle3D{
		qx: Math.pi/4.0
	,	qy: Math.pi/3.0
	,	qz: Math.pi/4.0
}

faces :: Array (Array Int)
faces = [
	[0,1,2,3],
	[1,5,6,2],
	[5,4,7,6],
	[4,0,3,7],
	[0,4,5,1],
	[3,2,6,7]
]

project3Dto2D :: Point3D -> Angle3D -> Point3D
project3Dto2D (Point3D p) (Angle3D ang) =
	let	xRotQz = p.x * Math.cos ang.qz + p.y * Math.sin ang.qz
		yRotQz = p.y * Math.cos ang.qz + p.x * Math.sin ang.qz
		zRotQz = p.z
		xRotQzQx = xRotQz
		yRotQzQx = yRotQz * Math.cos ang.qx + zRotQz * Math.sin ang.qx
		zRotQzQx = zRotQz * Math.cos ang.qx - yRotQz * Math.sin ang.qx
		xRotQzQxQy = xRotQzQx * Math.cos ang.qy + zRotQzQx * Math.sin ang.qy
		yRotQzQxQy = yRotQzQx
	in
		Point3D {x:xRotQzQxQy, y:yRotQzQxQy, z:p.z}

drawCube :: forall e. Context2D -> Eff (canvas :: CANVAS | e) Unit
drawCube ctx =
	ctx <- setFillStyle "#000000" ctx
	fillPath ctx do
		ctx <- moveTo ctx 100.0 100.0
		ctx <- lineTo ctx 200.0 200.0
		ctx <- lineTo ctx 150.0 150.0
		void $ closePath ctx

transform :: Point3D -> Point3D
transform (Point3D p) =
	let	nx = p.x + 200.0
		ny = p.x + 200.0
	in
		Point3D {x:nx, y:ny, z:p.z}

{-forall eff.Eff( canvas :: CANVAS
						, dom :: DOM
						, timer :: TIMER
						| eff
						) Unit
-}
main = void $ unsafePartial do
	Just canvas <- getCanvasElementById "thecanvas"
	ctx <- getContext2D canvas
	animFrame <- animationFrame
	ctx <- setFillStyle "#0000FF" ctx
	ctx <- fillRect {x: 0.0, y: 0.0, w: 500.0, h: 500.0} ctx
	drawCube ctx

module Main where

import Prelude
import Math as Math
import Data.Array
import Data.Maybe (Maybe(..))
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (logShow)
import DOM
import Graphics.Canvas
import Signal
import Signal.DOM
import Partial.Unsafe (unsafePartial)

oRate :: Number
oRate = 0.999

fric :: Number
fric = 0.0

data Point3D = Point3D
	{	x :: Number
	,	y :: Number
	,	z :: Number
	}

vertices :: Array Point3D
vertices =
	[ Point3D {x:(-100.0), y:100.0, z:(-100.0)}
		,Point3D {x:100.0, y:100.0, z:(-100.0)}
		,Point3D {x:100.0, y:(-100.0), z:(-100.0)}
		,Point3D {x:(-100.0), y:(-100.0), z:(-100.0)}
		,Point3D {x:(-100.0), y:100.0, z:100.0}
		,Point3D {x:100.0, y:100.0, z:100.0}
		,Point3D {x:100.0, y:(-100.0), z:100.0}
		,Point3D {x:(-100.0), y:(-100.0), z:100.0}
	]

data Angle3D = Angle3D
	{	qx :: Number
	, qy :: Number
	, qz :: Number
	}

angle :: Angle3D
angle = Angle3D{
		qx: Math.pi/4.0
	,	qy: Math.pi/3.0
	,	qz: Math.pi/4.0
}

faces :: Array (Array Int)
faces = [
	[0,1,2,3],
	[1,5,6,2],
	[5,4,7,6],
	[4,0,3,7],
	[0,4,5,1],
	[3,2,6,7]
]

project3Dto2D :: Point3D -> Angle3D -> Point3D
project3Dto2D (Point3D p) (Angle3D ang) =
	let	xRotQz = p.x * Math.cos ang.qz + p.y * Math.sin ang.qz
		yRotQz = p.y * Math.cos ang.qz + p.x * Math.sin ang.qz
		zRotQz = p.z
		xRotQzQx = xRotQz
		yRotQzQx = yRotQz * Math.cos ang.qx + zRotQz * Math.sin ang.qx
		zRotQzQx = zRotQz * Math.cos ang.qx - yRotQz * Math.sin ang.qx
		xRotQzQxQy = xRotQzQx * Math.cos ang.qy + zRotQzQx * Math.sin ang.qy
		yRotQzQxQy = yRotQzQx
	in
		Point3D {x:xRotQzQxQy, y:yRotQzQxQy, z:p.z}

drawCube :: forall e. Context2D -> Eff (canvas :: CANVAS | e) Unit
drawCube ctx =
	--setFillStyle "#000000" ctx
	fillPath ctx do
		ctx <- moveTo ctx 100.0 100.0
		ctx <- lineTo ctx 200.0 200.0
		ctx <- lineTo ctx 150.0 150.0
		void $ closePath ctx

transform :: Point3D -> Point3D
transform (Point3D p) =
	let	nx = p.x + 200.0
		ny = p.x + 200.0
	in
		Point3D {x:nx, y:ny, z:p.z}

{-forall eff.Eff( canvas :: CANVAS
						, dom :: DOM
						, timer :: TIMER
						| eff
						) Unit
-}
main = void $ unsafePartial do
	Just canvas <- getCanvasElementById "thecanvas"
	ctx <- getContext2D canvas
	animFrame <- animationFrame
	ctx <- setFillStyle "#0000FF" ctx
	--ctx <- fillRect {x: 0.0, y: 0.0, w: 500.0, h: 500.0} ctx
	drawCube ctx


add a few comments

add a few comments

module Main where

import Prelude
import Control.Monad.Aff (runAff)
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Exception (throwException)

import Data.Array (filter)
import Data.Either (either)
import Data.Foreign (toForeign)
import Data.Foreign.Class (IsForeign, readProp)
import Data.Maybe (Maybe(..))
import Data.String (contains)

import Halogen hiding (Prop())
import Halogen.HTML.Core (Prop(), eventName, handler')
import Halogen.HTML.Events.Handler (EventHandler())
import Halogen.Util
import qualified Halogen.HTML.Indexed as H
import qualified Halogen.HTML.Properties.Indexed as P
import qualified Halogen.HTML.Events.Indexed as E

import Unsafe.Coerce (unsafeCoerce)

import FunctionIndex

-- | The state consists of a collection of IndexEntries, and a search query
-- | that's used to filter the entries.
type State = {
  searchQuery :: String,
  indexEntries :: IndexEntries
}

-- | The only action is to update the searchQuery in response to user input.
data Query a = Search String a

-- | This is 100% copied from Halogen.HTML.Events.Forms
-- |   https://github.com/slamdata/purescript-halogen/blob/master/src/Halogen/HTML/Events/Forms.purs
-- | it was the only way I could come up with to get the input value on every key up event.
addForeignPropHandler :: forall f value. (IsForeign value) => String -> String -> (value -> EventHandler (f Unit)) -> Prop (f Unit)
addForeignPropHandler key prop f = handler' (eventName key) (either (const $ pure Nothing) (map Just <<< f) <<< readProp prop <<< toForeign <<< _.target)

-- | Attaches an event handler which will fire on keyup and receive the *value* of the input.
onKeyUpInput :: forall f. (String -> EventHandler (f Unit)) -> Prop (f Unit)
onKeyUpInput = addForeignPropHandler "keyup" "value"

ui :: forall g. (Functor g) => Component State Query g
ui = component render eval
  where

  render :: State -> ComponentHTML Query
  render s =
    H.div_
      [ H.input [ P.inputType P.InputText
                , P.placeholder "Filter"
                , P.autofocus true
                , P.value s.searchQuery
                -- This is totally ugly, and I hate it. The example I was
                -- following used
                --    E.onValueChange (E.input Search)
                -- but that doesn't trigger as you type, only when the value
                -- "registers". You can't just change it to E.onKeyUp, because
                -- that generates a KeyboardEvent which itself gives no easy
                -- way to get at the input value.
                , unsafeCoerce $ onKeyUpInput (E.input Search) ]
      , H.table_
          [
            H.thead_
              [
                H.tr_
                  [ H.th_ [H.text "chapter"],
                    H.th_ [H.text "page"],
                    H.th_ [H.text "function"]
                  ]
              ]
          , H.tbody_ (map makeTableRow filteredEntries)
          ]
      ]
    where
    makeTableRow entry =
      H.tr_
        [
          H.td_ [H.text (show entry.chapter)],
          H.td_ [H.text (show entry.page)],
          H.td_ [H.text entry.function]
        ]
    -- only show entries whose function name contains the search query
    filteredEntries = filter isMatch s.indexEntries
    isMatch entry = contains s.searchQuery entry.function

  eval :: Natural Query (ComponentDSL State Query g)
  eval (Search s next) = do
    modify (\state -> state { searchQuery = s})
    pure next

main :: Eff (HalogenEffects ()) Unit
main = runAff throwException (const (pure unit)) $ do
  app <- runUI ui { searchQuery : "", indexEntries : indexEntries }
  onLoad $ appendToBody app.node

module Main where

import Prelude
import Control.Monad.Aff (runAff)
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Exception (throwException)

import Data.Array (filter)
import Data.Either (either)
import Data.Foreign (toForeign)
import Data.Foreign.Class (IsForeign, readProp)
import Data.Maybe (Maybe(..))
import Data.String (contains)

import Halogen hiding (Prop())
import Halogen.HTML.Core (Prop(), eventName, handler')
import Halogen.HTML.Events.Handler (EventHandler())
import Halogen.Util
import qualified Halogen.HTML.Indexed as H
import qualified Halogen.HTML.Properties.Indexed as P
import qualified Halogen.HTML.Events.Indexed as E

import Unsafe.Coerce (unsafeCoerce)

import FunctionIndex

-- | The state consists of a collection of IndexEntries, and a search query
-- | that's used to filter the entries.
type State = {
  searchQuery :: String,
  indexEntries :: IndexEntries
}

-- | The only action is to update the searchQuery in response to user input.
data Query a = Search String a

-- | This is 100% copied from Halogen.HTML.Events.Forms
-- |   https://github.com/slamdata/purescript-halogen/blob/master/src/Halogen/HTML/Events/Forms.purs
-- | it was the only way I could come up with to get the input value on every
-- | key up event.
addForeignPropHandler :: forall f value. (IsForeign value) => String -> String -> (value -> EventHandler (f Unit)) -> Prop (f Unit)
addForeignPropHandler key prop f = handler' (eventName key) (either (const $ pure Nothing) (map Just <<< f) <<< readProp prop <<< toForeign <<< _.target)

-- | Attaches an event handler which will fire on keyup.
onKeyUpInput :: forall f. (String -> EventHandler (f Unit)) -> Prop (f Unit)
onKeyUpInput = addForeignPropHandler "keyup" "value"

ui :: forall g. (Functor g) => Component State Query g
ui = component render eval
  where

  render :: State -> ComponentHTML Query
  render s =
    H.div_
      [ H.input [ P.inputType P.InputText
                , P.placeholder "Filter"
                , P.autofocus true
                , P.value s.searchQuery
                -- This is totally ugly, and I hate it. The example I was
                -- following used
                --    E.onValueChange (E.input Search)
                -- but that doesn't trigger as you type, only when the value
                -- "registers". You can't just change it to E.onKeyUp, because
                -- that generates a KeyboardEvent which itself gives no easy
                -- way to get at the input value.
                , unsafeCoerce $ onKeyUpInput (E.input Search) ]
      , H.table_
          [
            H.thead_
              [
                H.tr_
                  [ H.th_ [H.text "chapter"],
                    H.th_ [H.text "page"],
                    H.th_ [H.text "function"]
                  ]
              ]
          , H.tbody_ (map makeTableRow filteredEntries)
          ]
      ]
    where
    makeTableRow entry =
      H.tr_
        [
          H.td_ [H.text (show entry.chapter)],
          H.td_ [H.text (show entry.page)],
          H.td_ [H.text entry.function]
        ]
    filteredEntries = filter isMatch s.indexEntries
    isMatch entry = contains s.searchQuery entry.function

  eval :: Natural Query (ComponentDSL State Query g)
  eval (Search s next) = do
    modify (\state -> state { searchQuery = s})
    pure next

main :: Eff (HalogenEffects ()) Unit
main = runAff throwException (const (pure unit)) $ do
  app <- runUI ui { searchQuery : "", indexEntries : indexEntries }
  onLoad $ appendToBody app.node


unfold' refactoring

unfold' refactoring

-- / A turn in a game round
module App.Turn where

import Data.Maybe
import App.Animation as Animation
import App.Board as Board
import App.Hand as Hand
import Data.List (List(..), (:), concat)
import Data.Tuple (Tuple(..))
import Data.Unfoldable (class Unfoldable, unfoldr)
import Prelude ((>>>), (<<<), ($), map)

-- XXX: 'Turn' is a bad name; it is a verb but we need noun.
type Turn =
  { hand :: Hand.State
  , board :: Board.State
  }

type State = Animation.State Turn

data Action = NextFrame

init :: Board.Player -> Board.State -> State
init player board = Animation.init turn rest
  where turn = { hand, board }
        hand = Hand.init player 0
        rest = unfoldTurns turn

update :: Action -> State -> Maybe State
update NextFrame = Animation.step

-- TODO: fully implement and tidy up this function.
turns :: Turn -> Tuple (List (Turn -> Turn)) (Maybe Turn)
turns state@{ hand, board } =
  t
  where seedsBelow = Board.lookup hand.pitRef board
        nextRef = Board.nextRef hand.pitRef
        next2Ref = Board.nextRef nextRef
        seedsNext = Board.lookup nextRef board
        seedsNext2 = Board.lookup next2Ref board
        t = go hand.seeds seedsBelow seedsNext seedsNext2 state
        continue changes = Tuple changes (Just state) -- TODO apply them
        end changes = Tuple changes Nothing
        go 0 0 0 _ state' = end $ Nil
        go 0 0 s 0 state' =
          -- advance; capture; Nothing
          end $ advance : capture : Nil
        go _ _ _ _ state' = end $ Nil -- TODO

-- | A version of unfoldr that allows a elements in end cause.
unfoldr' :: forall a b t. Unfoldable t
        => (b -> Tuple a (Maybe b)) -> b -> t a
unfoldr' f = unfoldr (map f) <<< Just

unfoldTurns :: Turn -> List (Turn -> Turn)
unfoldTurns = concat <<< unfoldr' turns

capture :: Turn -> Turn
capture state@{ hand, board } =
  state { board = board' }
  where seeds = Board.lookup hand.pitRef board
        board' = (Board.clear hand.pitRef >>> Board.store hand.player seeds) board

advance :: Turn -> Turn
advance x = x

-- / A turn in a game round
module App.Turn where

import Data.Maybe
import App.Animation as Animation
import App.Board as Board
import App.Hand as Hand
import Data.List (List(..), (:), concat)
import Data.Tuple (Tuple(..))
import Data.Unfoldable (unfoldr)
import Prelude ((>>>), (<<<), ($))

type Turn =
  { hand :: Hand.State
  , board :: Board.State
  }

type State = Animation.State Turn

data Action = NextFrame

init :: Board.Player -> Board.State -> State
init player board = Animation.init turn rest
  where turn = { hand, board }
        hand = Hand.init player 0
        rest = unfoldTurns turn

update :: Action -> State -> Maybe State
update NextFrame = Animation.step

-- TODO: fully implement and tidy up this function.
turns :: Maybe Turn -> Maybe (Tuple (List (Turn -> Turn)) (Maybe Turn))
turns Nothing = Nothing
turns (Just state@{ hand, board }) =
  Just t
  where seedsBelow = Board.lookup hand.pitRef board
        nextRef = Board.nextRef hand.pitRef
        next2Ref = Board.nextRef nextRef
        seedsNext = Board.lookup nextRef board
        seedsNext2 = Board.lookup next2Ref board
        t = go hand.seeds seedsBelow seedsNext seedsNext2 state
        continue changes = Tuple changes (Just state) -- TODO apply them
        end changes = Tuple changes Nothing
        go 0 0 0 _ state' = end $ Nil
        go 0 0 s 0 state' =
          -- advance; capture; Nothing
          end $ advance : capture : Nil
        go _ _ _ _ state' = end $ Nil -- TODO

unfoldTurns :: Turn -> List (Turn -> Turn)
unfoldTurns = concat <<< unfoldr turns <<< Just

capture :: Turn -> Turn
capture state@{ hand, board } =
  state { board = board' }
  where seeds = Board.lookup hand.pitRef board
        board' = (Board.clear hand.pitRef >>> Board.store hand.player seeds) board

advance :: Turn -> Turn
advance x = x


Update names

Update names

module Language.PureScript.Names where

import Data.Array (map)
import Data.Maybe
import Data.Tuple
import Data.String (joinWith, split)

-- |
-- Names for value identifiers
--
data Ident
  -- |
  -- An alphanumeric identifier
  --
  = Ident String
  -- |
  -- A symbolic name for an infix operator
  --
  | Op String

instance showIdent :: Show Ident where
  show (Ident i) = "Ident " ++ show i
  show (Op op) = "Op " ++ show op

runIdent :: Ident -> String
runIdent (Ident i) = i
runIdent (Op op) = op

instance eqIdent :: Eq Ident where
  (==) (Ident s1) (Ident s2) = s1 == s2
  (==) (Op s1)    (Op s2)    = s1 == s2
  (==) _          _          = false
  (/=) i1         i2         = not (i1 == i2)

instance ordIdent :: Ord Ident where
  compare (Ident i1) (Ident i2) = compare i1 i2
  compare (Ident _)  _          = LT
  compare (Op op1)   (Op op2)   = compare op1 op2
  compare (Op op1)   _          = GT

-- |
-- Proper names, i.e. capitalized names for e.g. module names, type//data constructors.
--
data ProperName = ProperName String

runProperName :: ProperName -> String
runProperName (ProperName s) = s

instance showProperName :: Show ProperName where
  show = runProperName

instance eqProperName :: Eq ProperName where
  (==) (ProperName s1) (ProperName s2) = s1 == s2
  (/=) (ProperName s1) (ProperName s2) = s1 /= s2

instance ordProperName :: Ord ProperName where
  compare (ProperName s1) (ProperName s2) = compare s1 s2

-- |
-- Module names
--
data ModuleName = ModuleName [ProperName]

instance showModuleName :: Show ModuleName where
  show = runModuleName

instance eqModuleName :: Eq ModuleName where
  (==) (ModuleName s1) (ModuleName s2) = s1 == s2
  (/=) (ModuleName s1) (ModuleName s2) = s1 /= s2

instance ordModuleName :: Ord ModuleName where
  compare (ModuleName s1) (ModuleName s2) = compare s1 s2

runModuleName :: ModuleName -> String
runModuleName (ModuleName pns) = joinWith "." (runProperName `map` pns)

moduleNameFromString :: String -> ModuleName
moduleNameFromString = ModuleName <<< map ProperName <<< split "."

-- |
-- A qualified name, i.e. a name with an optional module name
--
data Qualified a = Qualified (Maybe ModuleName) a

instance eqQualified :: (Eq a) => Eq (Qualified a) where
  (==) (Qualified m1 a1) (Qualified m2 a2) = m1 == m2 && a1 == a2
  (/=) q1 q2 = not (q1 == q2)

instance showQualified :: (Show a) => Show (Qualified a) where
  show (Qualified Nothing a) = show a
  show (Qualified (Just name) a) = show name ++ "." ++ show a

-- |
-- Provide a default module name, if a name is unqualified
--
qualify :: forall a. ModuleName -> Qualified a -> Tuple ModuleName a
qualify m (Qualified Nothing a) = Tuple m a
qualify _ (Qualified (Just m) a) = Tuple m a

module Language.PureScript.Names where

import Prelude
import Data.Array (map)
import Data.Maybe
import Data.Tuple
import Data.String
import Data.Generics

-- |
-- Names for value identifiers
--
data Ident
  -- |
  -- An alphanumeric identifier
  --
  = Ident String
  -- |
  -- A symbolic name for an infix operator
  --
  | Op String
  -- |
  -- An escaped name
  --
  | Escaped String

instance genericIdent :: Generic Ident where
  typeOf _ = TyCon { tyCon: "Language.PureScript.Names.Ident", args: [] }
  term (Ident s) = TmCon { con: "Language.PureScript.Names.Ident", values: [term s] }
  term (Op s) = TmCon { con: "Language.PureScript.Names.Op", values: [term s] }
  term (Escaped s) = TmCon { con: "Language.PureScript.Names.Escaped", values: [term s] }
  unTerm (TmCon { con = "Language.PureScript.Names.Ident", values = [t] }) = Ident <$> unTerm t
  unTerm (TmCon { con = "Language.PureScript.Names.Op", values = [t] }) = Op <$> unTerm t
  unTerm (TmCon { con = "Language.PureScript.Names.Escaped", values = [t] }) = Escaped <$> unTerm t
  unTerm _ = Nothing

instance showIdent :: Show Ident where
  show = gshow

instance eqIdent :: Eq Ident where
  (==) (Ident s1)    (Ident s2)   = s1 == s2
  (==) (Op s1)       (Op s2)      = s1 == s2
  (==) (Escaped s1)  (Escaped s2) = s1 == s2
  (==) (Ident s1)    (Escaped s2) = s1 == s2
  (==) (Escaped s1)  (Ident s2)   = s1 == s2
  (==) _             _            = false
  (/=) i1            i2           = not (i1 == i2)

--instance ordIdent :: Ord Ident where
--  compare i1 i2 = compare (show i1) (show i2)

-- |
-- Proper names, i.e. capitalized names for e.g. module names, type//data constructors.
--
data ProperName = ProperName String

runProperName :: ProperName -> String
runProperName (ProperName s) = s

instance genericProperName :: Generic ProperName where
  typeOf _ = TyCon { tyCon: "Language.PureScript.Names.ProperName", args: [] }
  term (ProperName s) = TmCon { con: "Language.PureScript.Names.ProperName", values : [term s] }
  unTerm (TmCon { con = "Language.PureScript.Names.ProperName", values = [t] }) = ProperName <$> unTerm t
  unTerm _ = Nothing

instance showProperName :: Show ProperName where
  show = runProperName

instance eqProperName :: Eq ProperName where
  (==) (ProperName s1) (ProperName s2) = s1 == s2
  (/=) (ProperName s1) (ProperName s2) = s1 /= s2

--instance ordProperName :: Ord ProperName where
--  compare (ProperName s1) (ProperName s2) = compare s1 s2

-- |
-- Module names
--
data ModuleName = ModuleName [ProperName]

instance genericModuleName :: Generic ModuleName where
  typeOf _ = TyCon { tyCon: "Language.PureScript.Names.ModuleName", args: [] }
  term (ModuleName pns) = TmCon { con: "Language.PureScript.Names.ModuleName", values : [term pns] }
  unTerm (TmCon { con = "Language.PureScript.Names.ModuleName", values = [t] }) = ModuleName <$> unTerm t
  unTerm _ = Nothing

instance showModuleName :: Show ModuleName where
  show = runModuleName

instance eqModuleName :: Eq ModuleName where
  (==) (ModuleName s1) (ModuleName s2) = s1 == s2
  (/=) (ModuleName s1) (ModuleName s2) = s1 /= s2

--instance ordModuleName :: Ord ModuleName where
--  compare (ModuleName s1) (ModuleName s2) = compare s1 s2

runModuleName :: ModuleName -> String
runModuleName (ModuleName pns) = joinWith "." (runProperName `map` pns)

moduleNameFromString :: String -> ModuleName
moduleNameFromString = ModuleName <<< map ProperName <<< split "."

-- |
-- A qualified name, i.e. a name with an optional module name
--
data Qualified a = Qualified (Maybe ModuleName) a

qualifiedProxy :: forall a. Proxy (Qualified a) -> Proxy a
qualifiedProxy _ = Proxy

instance genericQualified :: (Generic a) => Generic (Qualified a) where
  typeOf p = TyCon { tyCon: "Language.PureScript.Names.Qualified", args: [typeOf (qualifiedProxy p)]}
  term (Qualified mn a) = TmCon { con: "Language.PureScript.Names.Qualified", values : [term mn, term a] }
  unTerm (TmCon { con = "Language.PureScript.Names.Qualified", values = [mn, a] }) = Qualified <$> unTerm mn <*> unTerm a
  unTerm _ = Nothing

instance eqQualified :: (Eq a) => Eq (Qualified a) where
  (==) (Qualified m1 a1) (Qualified m2 a2) = m1 == m2 && a1 == a2
  (/=) q1 q2 = not (q1 == q2)

instance showQualified :: (Show a) => Show (Qualified a) where
  show (Qualified Nothing a) = show a
  show (Qualified (Just name) a) = show name ++ "." ++ show a

-- |
-- Provide a default module name, if a name is unqualified
--
qualify :: forall a. ModuleName -> Qualified a -> Tuple ModuleName a
qualify m (Qualified Nothing a) = Tuple m a
qualify _ (Qualified (Just m) a) = Tuple m a


Begin smart-opts implementation

Begin smart-opts implementation

module Neodoc.Solve.SmartOptions where

import Prelude

import Data.List (List(..), (:))
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Data.Maybe (Maybe(..))
import Data.Either (Either(..), either)
import Data.NonEmpty (NonEmpty, (:|))
import Data.Traversable (for, traverse)

import Neodoc.Spec
import Neodoc.Spec as Spec
import Neodoc.Data.Layout
import Neodoc.Data.Layout as Layout
import Neodoc.Data.SolvedLayout as Solved
import Neodoc.Solve.Error
import Neodoc.Solve.ExpandOptions
import Neodoc.Solve.Traverse

smartOptions
  :: Spec ExpandedOptionsLayout
  -> Either SolveError (Spec ExpandedOptionsLayout)
smartOptions (Spec { program, layouts, descriptions }) = do
  layouts <- for layouts (traverse smartOptionsOnBranch)
  pure (Spec { program, layouts, descriptions })

  where
  smartOptionsOnBranch
    :: Layout.Branch ExpandedOptionsLayoutArg
    -> Either SolveError (Layout.Branch ExpandedOptionsLayoutArg)
  smartOptionsOnBranch branch = traverse go branch
    where
    -- Check for groups
    go g@(Group o r (((Solved.Option oN oMA oR) :| x) :| Nil))
      = case x of
          _ -> fail "..."

    go x = pure x

module Neodoc.Solve.SmartOptions where

import Prelude

import Data.List (List(..), (:))
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Data.Maybe (Maybe(..))
import Data.Either (Either(..), either)
import Data.NonEmpty (NonEmpty, (:|))
import Data.Traversable (for, traverse)

import Neodoc.Spec
import Neodoc.Spec as Spec
import Neodoc.Data.Layout
import Neodoc.Data.Layout as Layout
import Neodoc.Solve.Error
import Neodoc.Solve.ExpandOptions
import Neodoc.Solve.Traverse

smartOptions
  :: Spec ExpandedOptionsLayout
  -> Either SolveError (Spec ExpandedOptionsLayout)
smartOptions (Spec { program, layouts, descriptions }) = do
  layouts <- for layouts (traverse smartOptionsOnBranch)
  pure (Spec { program, layouts, descriptions })

  where
  smartOptionsOnBranch
    :: Layout.Branch ExpandedOptionsLayoutArg
    -> Either SolveError (Layout.Branch ExpandedOptionsLayoutArg)
  smartOptionsOnBranch branch = zipTraverseM' solveAdjacent branch

  solveAdjacent
    :: ExpandedOptionsLayout
    -> Maybe ExpandedOptionsLayout
    -> Either SolveError (Tuple ExpandedOptionsLayout (Maybe ExpandedOptionsLayout))
  solveAdjacent layout mAdjLayout = go layout mAdjLayout
    where
    untouched = pure $ layout /\ mAdjLayout
    go _ _ = untouched


fix documentation in Data.Monoid.Conj

fix documentation in Data.Monoid.Conj

module Data.Monoid.Conj where

import Prelude

import Data.Eq (class Eq1)
import Data.HeytingAlgebra (ff, tt)
import Data.Ord (class Ord1)

-- | Monoid and semigroup for conjunction.
-- |
-- | ``` purescript
-- | Conj x <> Conj y == Conj (x && y)
-- | mempty :: Conj _ == Conj tt
-- | ```
newtype Conj a = Conj a

derive newtype instance eqConj :: Eq a => Eq (Conj a)
derive instance eq1Conj :: Eq1 Conj

derive newtype instance ordConj :: Ord a => Ord (Conj a)
derive instance ord1Conj :: Ord1 Conj

derive newtype instance boundedConj :: Bounded a => Bounded (Conj a)

instance showConj :: (Show a) => Show (Conj a) where
  show (Conj a) = "(Conj " <> show a <> ")"

derive instance functorConj :: Functor Conj

instance applyConj :: Apply Conj where
  apply (Conj f) (Conj x) = Conj (f x)

instance applicativeConj :: Applicative Conj where
  pure = Conj

instance bindConj :: Bind Conj where
  bind (Conj x) f = f x

instance monadConj :: Monad Conj

instance semigroupConj :: HeytingAlgebra a => Semigroup (Conj a) where
  append (Conj a) (Conj b) = Conj (conj a b)

instance monoidConj :: HeytingAlgebra a => Monoid (Conj a) where
  mempty = Conj tt

instance semiringConj :: HeytingAlgebra a => Semiring (Conj a) where
  zero = Conj tt
  one = Conj ff
  add (Conj a) (Conj b) = Conj (conj a b)
  mul (Conj a) (Conj b) = Conj (disj a b)

module Data.Monoid.Conj where

import Prelude

import Data.Eq (class Eq1)
import Data.HeytingAlgebra (ff, tt)
import Data.Ord (class Ord1)

-- | Monoid and semigroup for conjuntion.
-- |
-- | ``` purescript
-- | Conj x <> Conj y == Conj (x && y)
-- | mempty :: Conj _ == Conj top
-- | ```
newtype Conj a = Conj a

derive newtype instance eqConj :: Eq a => Eq (Conj a)
derive instance eq1Conj :: Eq1 Conj

derive newtype instance ordConj :: Ord a => Ord (Conj a)
derive instance ord1Conj :: Ord1 Conj

derive newtype instance boundedConj :: Bounded a => Bounded (Conj a)

instance showConj :: (Show a) => Show (Conj a) where
  show (Conj a) = "(Conj " <> show a <> ")"

derive instance functorConj :: Functor Conj

instance applyConj :: Apply Conj where
  apply (Conj f) (Conj x) = Conj (f x)

instance applicativeConj :: Applicative Conj where
  pure = Conj

instance bindConj :: Bind Conj where
  bind (Conj x) f = f x

instance monadConj :: Monad Conj

instance semigroupConj :: HeytingAlgebra a => Semigroup (Conj a) where
  append (Conj a) (Conj b) = Conj (conj a b)

instance monoidConj :: HeytingAlgebra a => Monoid (Conj a) where
  mempty = Conj tt

instance semiringConj :: HeytingAlgebra a => Semiring (Conj a) where
  zero = Conj tt
  one = Conj ff
  add (Conj a) (Conj b) = Conj (conj a b)
  mul (Conj a) (Conj b) = Conj (disj a b)