Remove Evaluate cell type

Remove Evaluate cell type

module Model.Notebook.Cell where

import Data.Argonaut.Combinators ((~>), (:=), (.?))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Argonaut.Decode (DecodeJson, decodeJson)
import Data.Argonaut.Encode (EncodeJson, encodeJson)
import Data.Date (Date())
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Time (Milliseconds())
import Global (readInt, isNaN)
import Model.Notebook.Cell.FileInput
import Model.Notebook.Cell.JTableContent
import Model.Notebook.Port
import Optic.Core (lens, LensP(), prism', PrismP(), (..), (.~))
import Optic.Extended (TraversalP())

import qualified Model.Notebook.Cell.Common as Cm
import qualified Model.Notebook.Cell.Explore as Ex
import qualified Model.Notebook.Cell.Query as Qu
import qualified Model.Notebook.Cell.Search as Sr
import qualified Model.Notebook.Cell.Viz as Vz

type CellId = Number
type FailureMessage = String

string2cellId :: String -> Either String CellId
string2cellId str =
  let int = readInt 10 str
  in if isNaN int then Left "incorrect cell id" else Right int

newtype Cell =
  Cell { cellId :: CellId
       , input :: Port
       , output :: Port
       , content :: CellContent
       , expandedStatus :: Boolean
       , failures :: [FailureMessage]
       , hiddenEditor :: Boolean
       , runState :: RunState
       , addingNextCell :: Boolean
       }

newCell :: CellId -> CellContent -> Cell
newCell cellId content =
  Cell { cellId: cellId
       , input: Closed
       , output: Closed
       , content: content
       , expandedStatus: false
       , failures: []
       , hiddenEditor: false
       , runState: RunInitial
       , addingNextCell: false
       }

_Cell :: LensP Cell _
_Cell = lens (\(Cell obj) -> obj) (const Cell)

_addingNextCell :: LensP Cell Boolean
_addingNextCell = _Cell <<< lens _.addingNextCell _{addingNextCell = _ }

_cellId :: LensP Cell CellId
_cellId = _Cell <<< lens _.cellId (_ { cellId = _ })

_input :: LensP Cell Port
_input = _Cell <<< lens _.input (_ { input = _ })

_output :: LensP Cell Port
_output = _Cell <<< lens _.output (_ { output = _ })

_content :: LensP Cell CellContent
_content = _Cell <<< lens _.content (_ { content = _ })

_hiddenEditor :: LensP Cell Boolean
_hiddenEditor = _Cell <<< lens _.hiddenEditor (_ { hiddenEditor = _ })

_runState :: LensP Cell RunState
_runState = _Cell <<< lens _.runState (_ { runState = _ })

_expandedStatus :: LensP Cell Boolean
_expandedStatus = _Cell <<< lens _.expandedStatus (_ { expandedStatus = _ })

_failures :: LensP Cell [FailureMessage]
_failures = _Cell <<< lens _.failures (_ { failures = _ })

instance eqCell :: Eq Cell where
  (==) (Cell c) (Cell c') = c.cellId == c'.cellId
  (/=) a b = not $ a == b

instance ordCell :: Ord Cell where
  compare (Cell c) (Cell c') = compare c.cellId c'.cellId

instance encodeJsonCell :: EncodeJson Cell where
  encodeJson (Cell cell)
    =  "cellId" := cell.cellId
    ~> "input" := cell.input
    ~> "output" := cell.output
    ~> "content" := cell.content
    ~> jsonEmptyObject

instance decodeJsonCell :: DecodeJson Cell where
  decodeJson json = do
    obj <- decodeJson json
    cell <- newCell <$> obj .? "cellId"
                    <*> obj .? "content"
    input <- obj .? "input"
    output <- obj .? "output"
    pure (cell # (_input .~ input)
              .. (_output .~ output))

data CellContent
  = Search Sr.SearchRec
  | Explore Ex.ExploreRec
  | Visualize Vz.VizRec
  | Query Qu.QueryRec
  | Markdown String

cellContentType :: CellContent -> String
cellContentType (Explore _) = "explore"
cellContentType (Search _) = "search"
cellContentType (Query _) = "query"
cellContentType (Visualize _) = "visualize"
cellContentType (Markdown _) = "markdown"

newSearchContent :: CellContent
newSearchContent = Search Sr.initialSearchRec

newExploreContent :: CellContent
newExploreContent = Explore Ex.initialExploreRec

newQueryContent :: CellContent
newQueryContent = Query Qu.initialQueryRec

newVisualizeContent :: CellContent
newVisualizeContent = Visualize Vz.initialVizRec

newMarkdownContent :: CellContent
newMarkdownContent = Markdown ""

_Explore :: PrismP CellContent Ex.ExploreRec
_Explore = prism' Explore $ \s -> case s of
  Explore r -> Just r
  _ -> Nothing

_Search :: PrismP CellContent Sr.SearchRec
_Search = prism' Search $ \s -> case s of
  Search s -> Just s
  _ -> Nothing

_Query :: PrismP CellContent Qu.QueryRec
_Query = prism' Query $ \s -> case s of
  Query s -> Just s
  _ -> Nothing

_Visualize :: PrismP CellContent Vz.VizRec
_Visualize = prism' Visualize $ \s -> case s of
  Visualize s -> Just s
  _ -> Nothing

_Markdown :: PrismP CellContent String
_Markdown = prism' Markdown $ \s -> case s of
  Markdown s -> Just s
  _ -> Nothing

_FileInput :: TraversalP CellContent FileInput
_FileInput f s = case s of
  Explore _ -> (_Explore .. Ex._input) f s
  Search _ -> (_Search .. Sr._input) f s
  _  -> _const f s

_JTableContent :: TraversalP CellContent JTableContent
_JTableContent f s = case s of
  Explore _ -> (_Explore .. Ex._table) f s
  Search _ -> (_Search .. Sr._table) f s
  Query _ -> (_Query .. Qu._table) f s
  _  -> _const f s

_AceContent :: TraversalP CellContent String
_AceContent f s = case s of
  Search _ -> (_Search .. Sr._buffer) f s
  Query _ -> (_Query .. Qu._input) f s
  Markdown _ -> _Markdown f s
  _ -> _const f s

_const :: forall a b. TraversalP a b
_const _ s = pure s

instance encodeJsonCellContent :: EncodeJson CellContent where
  encodeJson cc
    =  "type" := cellContentType cc
    ~> case cc of
      Search rec -> encodeJson rec
      Explore rec -> encodeJson rec
      Query rec -> encodeJson rec
      Markdown s -> "value" := s ~> jsonEmptyObject
      -- TODO: Visualize
      _ -> jsonEmptyObject

instance decodeJsonExploreRec :: DecodeJson CellContent where
  decodeJson json = do
    obj <- decodeJson json
    cellType <- obj .? "type"
    case cellType of
      "search" -> Search <$> decodeJson json
      "explore" -> Explore <$> decodeJson json
      "query" -> Query <$> decodeJson json
      "markdown" -> Markdown <$> obj .? "value"
      -- TODO: Visualize
      _ -> Left $ "Unknown CellContent type: '" ++ cellType ++ "'"

data RunState = RunInitial
              | RunningSince Date
              | RunFinished Milliseconds

_RunInitial :: PrismP RunState Unit
_RunInitial = prism' (const RunInitial) $ \r -> case r of
  RunInitial -> Just unit
  _ -> Nothing

_RunningSince :: PrismP RunState Date
_RunningSince = prism' RunningSince $ \r -> case r of
  RunningSince d -> Just d
  _ -> Nothing

_RunFinished :: PrismP RunState Milliseconds
_RunFinished = prism' RunFinished $ \r -> case r of
  RunFinished m -> Just m
  _ -> Nothing

module Model.Notebook.Cell where

import Data.Argonaut.Combinators ((~>), (:=), (.?))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Argonaut.Decode (DecodeJson, decodeJson)
import Data.Argonaut.Encode (EncodeJson, encodeJson)
import Data.Date (Date())
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Time (Milliseconds())
import Global (readInt, isNaN)
import Model.Notebook.Cell.FileInput
import Model.Notebook.Cell.JTableContent
import Model.Notebook.Port
import Optic.Core (lens, LensP(), prism', PrismP(), (..), (.~))
import Optic.Extended (TraversalP())

import qualified Model.Notebook.Cell.Common as Cm
import qualified Model.Notebook.Cell.Explore as Ex
import qualified Model.Notebook.Cell.Query as Qu
import qualified Model.Notebook.Cell.Search as Sr
import qualified Model.Notebook.Cell.Viz as Vz

type CellId = Number
type FailureMessage = String

string2cellId :: String -> Either String CellId
string2cellId str =
  let int = readInt 10 str
  in if isNaN int then Left "incorrect cell id" else Right int

newtype Cell =
  Cell { cellId :: CellId
       , input :: Port
       , output :: Port
       , content :: CellContent
       , expandedStatus :: Boolean
       , failures :: [FailureMessage]
       , hiddenEditor :: Boolean
       , runState :: RunState
       , addingNextCell :: Boolean
       }

newCell :: CellId -> CellContent -> Cell
newCell cellId content =
  Cell { cellId: cellId
       , input: Closed
       , output: Closed
       , content: content
       , expandedStatus: false
       , failures: []
       , hiddenEditor: false
       , runState: RunInitial
       , addingNextCell: false
       }

_Cell :: LensP Cell _
_Cell = lens (\(Cell obj) -> obj) (const Cell)

_addingNextCell :: LensP Cell Boolean
_addingNextCell = _Cell <<< lens _.addingNextCell _{addingNextCell = _ }

_cellId :: LensP Cell CellId
_cellId = _Cell <<< lens _.cellId (_ { cellId = _ })

_input :: LensP Cell Port
_input = _Cell <<< lens _.input (_ { input = _ })

_output :: LensP Cell Port
_output = _Cell <<< lens _.output (_ { output = _ })

_content :: LensP Cell CellContent
_content = _Cell <<< lens _.content (_ { content = _ })

_hiddenEditor :: LensP Cell Boolean
_hiddenEditor = _Cell <<< lens _.hiddenEditor (_ { hiddenEditor = _ })

_runState :: LensP Cell RunState
_runState = _Cell <<< lens _.runState (_ { runState = _ })

_expandedStatus :: LensP Cell Boolean
_expandedStatus = _Cell <<< lens _.expandedStatus (_ { expandedStatus = _ })

_failures :: LensP Cell [FailureMessage]
_failures = _Cell <<< lens _.failures (_ { failures = _ })

instance eqCell :: Eq Cell where
  (==) (Cell c) (Cell c') = c.cellId == c'.cellId
  (/=) a b = not $ a == b

instance ordCell :: Ord Cell where
  compare (Cell c) (Cell c') = compare c.cellId c'.cellId

instance encodeJsonCell :: EncodeJson Cell where
  encodeJson (Cell cell)
    =  "cellId" := cell.cellId
    ~> "input" := cell.input
    ~> "output" := cell.output
    ~> "content" := cell.content
    ~> jsonEmptyObject

instance decodeJsonCell :: DecodeJson Cell where
  decodeJson json = do
    obj <- decodeJson json
    cell <- newCell <$> obj .? "cellId"
                    <*> obj .? "content"
    input <- obj .? "input"
    output <- obj .? "output"
    pure (cell # (_input .~ input)
              .. (_output .~ output))

data CellContent
  = Evaluate String
  | Search Sr.SearchRec
  | Explore Ex.ExploreRec
  | Visualize Vz.VizRec
  | Query Qu.QueryRec
  | Markdown String

cellContentType :: CellContent -> String
cellContentType (Evaluate _) = "evaluate"
cellContentType (Explore _) = "explore"
cellContentType (Search _) = "search"
cellContentType (Query _) = "query"
cellContentType (Visualize _) = "visualize"
cellContentType (Markdown _) = "markdown"

newEvaluateContent :: CellContent
newEvaluateContent = Evaluate ""

newSearchContent :: CellContent
newSearchContent = Search Sr.initialSearchRec

newExploreContent :: CellContent
newExploreContent = Explore Ex.initialExploreRec

newQueryContent :: CellContent
newQueryContent = Query Qu.initialQueryRec

newVisualizeContent :: CellContent
newVisualizeContent = Visualize Vz.initialVizRec

newMarkdownContent :: CellContent
newMarkdownContent = Markdown ""

_Evaluate :: PrismP CellContent String
_Evaluate = prism' Evaluate $ \s -> case s of
  Evaluate s -> Just s
  _ -> Nothing

_Explore :: PrismP CellContent Ex.ExploreRec
_Explore = prism' Explore $ \s -> case s of
  Explore r -> Just r
  _ -> Nothing

_Search :: PrismP CellContent Sr.SearchRec
_Search = prism' Search $ \s -> case s of
  Search s -> Just s
  _ -> Nothing

_Query :: PrismP CellContent Qu.QueryRec
_Query = prism' Query $ \s -> case s of
  Query s -> Just s
  _ -> Nothing

_Visualize :: PrismP CellContent Vz.VizRec
_Visualize = prism' Visualize $ \s -> case s of
  Visualize s -> Just s
  _ -> Nothing

_Markdown :: PrismP CellContent String
_Markdown = prism' Markdown $ \s -> case s of
  Markdown s -> Just s
  _ -> Nothing

_FileInput :: TraversalP CellContent FileInput
_FileInput f s = case s of
  Explore _ -> (_Explore .. Ex._input) f s
  Search _ -> (_Search .. Sr._input) f s
  _  -> _const f s

_JTableContent :: TraversalP CellContent JTableContent
_JTableContent f s = case s of
  Explore _ -> (_Explore .. Ex._table) f s
  Search _ -> (_Search .. Sr._table) f s
  Query _ -> (_Query .. Qu._table) f s
  _  -> _const f s

_AceContent :: TraversalP CellContent String
_AceContent f s = case s of
  Evaluate _ -> _Evaluate f s
  Search _ -> (_Search .. Sr._buffer) f s
  Query _ -> (_Query .. Qu._input) f s
  Markdown _ -> _Markdown f s
  _ -> _const f s

_const :: forall a b. TraversalP a b
_const _ s = pure s

instance encodeJsonCellContent :: EncodeJson CellContent where
  encodeJson cc
    =  "type" := cellContentType cc
    ~> case cc of
      Search rec -> encodeJson rec
      Explore rec -> encodeJson rec
      Query rec -> encodeJson rec
      Markdown s -> "value" := s ~> jsonEmptyObject
      -- TODO: Visualize
      _ -> jsonEmptyObject

instance decodeJsonExploreRec :: DecodeJson CellContent where
  decodeJson json = do
    obj <- decodeJson json
    cellType <- obj .? "type"
    case cellType of
      "search" -> Search <$> decodeJson json
      "explore" -> Explore <$> decodeJson json
      "query" -> Query <$> decodeJson json
      "markdown" -> Markdown <$> obj .? "value"
      -- TODO: Visualize
      _ -> Left $ "Unknown CellContent type: '" ++ cellType ++ "'"

data RunState = RunInitial
              | RunningSince Date
              | RunFinished Milliseconds

_RunInitial :: PrismP RunState Unit
_RunInitial = prism' (const RunInitial) $ \r -> case r of
  RunInitial -> Just unit
  _ -> Nothing

_RunningSince :: PrismP RunState Date
_RunningSince = prism' RunningSince $ \r -> case r of
  RunningSince d -> Just d
  _ -> Nothing

_RunFinished :: PrismP RunState Milliseconds
_RunFinished = prism' RunFinished $ \r -> case r of
  RunFinished m -> Just m
  _ -> Nothing


Display file details in a table

Display file details in a table

module App.View where

import App.State (Event(..), State)
import App.State.FileInputs as FileInputs
import App.State.Files as Files
import App.State.Signers as Signers
import Data.Map (toUnfoldable)
import Data.Maybe (Maybe(..), maybe)
import Data.Traversable (for_)
import Data.Tuple (Tuple(..))
import Lib.SignHash.Types (HashSigner(..), ProofMethod, ProofVerification(..))
import Prelude hiding (div,id)
import Pux.DOM.Events (onChange, onDragOver, onDrop)
import Pux.DOM.HTML (HTML, child)
import Text.Smolder.HTML (div, h1, hr, input, label, li, table, tbody, td, th, thead, tr, ul)
import Text.Smolder.HTML.Attributes (className, for, id, type')
import Text.Smolder.Markup (text, (!), (#!))

view :: State -> HTML Event
view { file, signer } =
  do
    div ! className "content" $ do
      h1 $ text "SignHash"
      hr
      child FileInput viewFileInput unit
      hr
      div fileStatus
      hr
      div signerStatus

  where
    fileStatus = case file of
      Nothing ->
        div $ text "Please provide a file"
      Just value -> viewFile value

    signerStatus = case signer of
      Nothing -> div $ text "No signer"
      Just value -> child Signer viewSigner value

viewFileInput :: Unit -> HTML FileInputs.Event
viewFileInput _ =
  div do
    label
      ! for "file-upload"
      ! className "file-upload"
      #! onDrop FileInputs.newFilesEvent
      #! onDragOver (FileInputs.PreventDefault FileInputs.NoOp)
      $ text "Click or drag and drop files"

    input
      ! id "file-upload"
      ! type' "file"
      #! onChange FileInputs.newFilesEvent

viewFile :: Files.State -> HTML Event
viewFile { meta, result, signer } =
  div do
    table ! className "u-full-width" $ tbody $ do
      renderRow "FileName" meta.name
      renderRow "Size" $ show meta.size <> " Bytes"
      renderRow "SHA256" $ maybe loading _.hash result
      renderRow "Signer address" $ maybe loading renderSigner signer

  where
    loading = "Loading..."
    renderRow label value =
      tr $ do
        th $ text label
        td $ text value

    renderSigner (HashSigner address) = address
    renderSigner NoSigner = "Not signed"

viewSigner :: Signers.State -> HTML Signers.Event
viewSigner { address, proofs } =
  div do
    div $ text "Signer"
    div $ text ("Address: " <> address)
    div $ text "Proofs:"
    viewProofs proofs

viewProofs :: Signers.SignerProofs -> HTML Signers.Event
viewProofs proofs =
  ul $ for_ unfolded renderProof
  where
    unfolded :: Array (Tuple ProofMethod Signers.ProofState)
    unfolded = toUnfoldable proofs
    renderProof (Tuple method state) = do
      li do
        div $ text ("Method: " <> show method)
        div $ text ("Verification: " <> viewProofState state)

    viewProofState Signers.Pending = "Pending..."
    viewProofState Signers.NetworkError = "Network error"
    viewProofState (Signers.Finished (Verified msg)) =
      "Verified: " <> msg
    viewProofState (Signers.Finished (Unverified msg)) =
      "Verification failed: " <> msg
    viewProofState (Signers.Finished Unavailable) =
      "No proof defined"

module App.View where

import App.State (Event(..), State)
import App.State.FileInputs as FileInputs
import App.State.Files as Files
import App.State.Signers as Signers
import Data.Map (toUnfoldable)
import Data.Maybe (Maybe(..))
import Data.Traversable (for_)
import Data.Tuple (Tuple(..))
import Lib.SignHash.Types (HashSigner(..), ProofMethod, ProofVerification(..))
import Prelude hiding (div,id)
import Pux.DOM.Events (onChange, onDragOver, onDrop)
import Pux.DOM.HTML (HTML, child)
import Text.Smolder.HTML (div, h1, hr, input, label, li, ul)
import Text.Smolder.HTML.Attributes (className, for, id, type')
import Text.Smolder.Markup (text, (!), (#!))

view :: State -> HTML Event
view { file, signer } =
  do
    div ! className "content" $ do
      h1 $ text "SignHash"
      hr
      child FileInput viewFileInput unit
      hr
      div fileStatus
      hr
      div signerStatus

  where
    fileStatus = case file of
      Nothing ->
        div $ text "Please provide a file"
      Just value -> viewFile value

    signerStatus = case signer of
      Nothing -> div $ text "No signer"
      Just value -> child Signer viewSigner value

viewFileInput :: Unit -> HTML FileInputs.Event
viewFileInput _ =
  div do
    label ! for "file-upload" ! className "file-upload"
      #! onDrop FileInputs.newFilesEvent
      #! onDragOver (FileInputs.PreventDefault FileInputs.NoOp)
      $ text "Click or drag and drop files"

    input
      ! id "file-upload"
      ! type' "file"
      #! onChange FileInputs.newFilesEvent

viewFile :: Files.State -> HTML Event
viewFile { meta, result, signer } =
  div do
    div $ text ("Filename: " <> meta.name)
    div $ text ("Size: " <> show meta.size <> " Bytes")
    div resultComponent
  where
    resultComponent = case result of
      Nothing ->
        div $ text $ "Loading..."
      Just value -> do
        div $ text $ "sha256: " <> value.hash
        div $ text $ "elapsed:" <> show value.elapsed
        signerComponent

    signerComponent = case signer of
      Nothing ->
        div $ text $ "Fetching signer..."
      Just (HashSigner address) ->
        div $ text $ "Signer address: " <> address
      Just NoSigner ->
        div $ text $ "Not signed"

viewSigner :: Signers.State -> HTML Signers.Event
viewSigner { address, proofs } =
  div do
    div $ text "Signer"
    div $ text ("Address: " <> address)
    div $ text "Proofs:"
    viewProofs proofs

viewProofs :: Signers.SignerProofs -> HTML Signers.Event
viewProofs proofs =
  ul $ for_ unfolded renderProof
  where
    unfolded :: Array (Tuple ProofMethod Signers.ProofState)
    unfolded = toUnfoldable proofs
    renderProof (Tuple method state) = do
      li do
        div $ text ("Method: " <> show method)
        div $ text ("Verification: " <> viewProofState state)

    viewProofState Signers.Pending = "Pending..."
    viewProofState Signers.NetworkError = "Network error"
    viewProofState (Signers.Finished (Verified msg)) =
      "Verified: " <> msg
    viewProofState (Signers.Finished (Unverified msg)) =
      "Verification failed: " <> msg
    viewProofState (Signers.Finished Unavailable) =
      "No proof defined"


Fixed FT bug where tests counted pending deletions as deletions (#1468)

module Test.SlamData.Feature.Interactions where

import SlamData.Prelude

import Data.Argonaut (encodeJson)
import Data.Array as Arr
import Data.Map as Map
import Data.String as S
import Data.StrMap as SM

import Global (encodeURIComponent)

import Selenium.Monad (get, refresh, getCurrentUrl, tryRepeatedlyTo)

import Test.Feature as Feature
import Test.SlamData.Feature.Monad (SlamFeature, getConfig, waitTime)
import Test.SlamData.Feature.XPaths as XPaths
import Test.Utils (appendToCwd)

import XPath as XPath

import Utils (prettyJson)
import Utils.Array (enumerate)

followingLastPreviousCardGripper :: String -> String
followingLastPreviousCardGripper = XPath.following lastPreviousCardGripperXPath
  where
  lastPreviousCardGripperXPath = XPath.last $ XPath.anywhere XPaths.previousCardGripper

launchSlamData ∷ SlamFeature Unit
launchSlamData = get ∘ _.slamdataUrl =<< getConfig

accessWorkspaceWithModifiedURL ∷ (String → String) → SlamFeature Unit
accessWorkspaceWithModifiedURL modifier =
  getCurrentUrl >>= modifier >>> get

mountTestDatabase ∷ SlamFeature Unit
mountTestDatabase = do
  -- If we don't wait for "Configure database" to appear in the toolbar the
  -- wrong item will be clicked for "Mount database" due to a timing issue. Yay.
  Feature.expectPresented (XPath.anywhere XPaths.accessConfigureMount)
  Feature.click (XPath.anywhere XPaths.accessMountDatabase)
  Feature.provideFieldValue (XPath.anywhere XPaths.mountName) "test-mount"
  Feature.selectFromDropdown (XPath.anywhere XPaths.mountType) "MongoDB"
  Feature.click (XPath.anywhere $ XPaths.mountName)
  Feature.provideFieldValue (XPath.index (XPath.anywhere XPaths.mountPort) 1) "63174"
  Feature.provideFieldValue (XPath.index (XPath.anywhere XPaths.mountHost) 1) "localhost"
  Feature.provideFieldValue (XPath.anywhere XPaths.mountDatabase) "testDb"
  Feature.click (XPath.anywhere XPaths.mountButton)

skipGuide ∷ SlamFeature Unit
skipGuide =
  Feature.click $ XPath.anywhere $ XPath.anyWithText "Skip"

dismissHint ∷ SlamFeature Unit
dismissHint =
  Feature.click $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Dismiss"

accessFile ∷ String → SlamFeature Unit
accessFile =
  Feature.click ∘ XPath.anywhere ∘ XPaths.accessFile

exploreFile ∷ String → SlamFeature Unit
exploreFile name = do
  Feature.provideFieldValue (XPath.anywhere $ XPath.anyWithExactAriaLabel "New workspace name") name
  Feature.click $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Explore file"

accessBreadcrumb ∷ String → SlamFeature Unit
accessBreadcrumb = Feature.click ∘ XPath.anywhere ∘ XPaths.accessBreadcrumb

browseRootFolder ∷ SlamFeature Unit
browseRootFolder = do
  Feature.click $ XPath.anywhere XPaths.headerGripper
  Feature.click $ XPath.index (XPath.anywhere XPaths.browseRootFolder) 1

browseTestFolder ∷ SlamFeature Unit
browseTestFolder =
  browseRootFolder *> accessFile "test-mount" *> accessFile "testDb"

createWorkspace ∷ SlamFeature Unit
createWorkspace = Feature.click $ XPath.anywhere XPaths.createWorkspace

nameDeck ∷ String → SlamFeature Unit
nameDeck name = do
  flipDeck
  Feature.click $ XPath.anywhere XPaths.renameDeck
  Feature.provideFieldValue (XPath.anywhere $ XPath.nodeWithExactAriaLabel "input" "Deck name") name
  Feature.click $ XPath.anywhere $ XPath.anyWithExactText "Save"

deleteFile ∷ String → SlamFeature Unit
deleteFile name =
  Feature.click (XPath.anywhere $ XPaths.selectFile name)
    *> Feature.click (XPath.anywhere $ XPaths.removeFile name)
    *> Feature.expectNotPresented (XPath.anywhere $ XPath.nodeWithExactText XPath.any name)

shareFile ∷ String → SlamFeature Unit
shareFile name = do
  Feature.click (XPath.anywhere $ XPaths.selectFile name)
  tryRepeatedlyTo $ clickShareFile <|> clickShareWorkspace
  where
  clickShareFile =
    Feature.clickNotRepeatedly (XPath.anywhere $ XPaths.shareFile name)
  clickShareWorkspace =
    Feature.clickNotRepeatedly (XPath.anywhere $ XPaths.shareFile $ name <> ".slam")

renameFile ∷ String → String → SlamFeature Unit
renameFile oldName newName = do
  selectFile oldName
  clickMove oldName
  Feature.provideFieldValueWithProperties
    (Map.singleton "value" $ Just oldName)
    (XPath.anywhere "input")
    newName
  Feature.click $ XPath.anywhere XPaths.renameButton
  where
  oldWorkspaceName = oldName <> ".slam"

moveFile ∷ String → String → String → SlamFeature Unit
moveFile fileName oldLocation newLocation = do
  selectFile fileName
  clickMove fileName
  Feature.click $ XPath.anywhere XPaths.selectADestinationFolder
  Feature.click $ XPath.anywhere $ XPath.anyWithExactText newLocation
  Feature.click $ XPath.anywhere XPaths.renameButton

clickMove ∷ String → SlamFeature Unit
clickMove name =
  tryRepeatedlyTo $ clickMoveFile <|> clickMoveWorkspace
  where
  clickMoveFile =
    Feature.clickNotRepeatedly $ XPath.anywhere $ XPaths.moveFile name
  clickMoveWorkspace =
    Feature.clickNotRepeatedly $ XPath.anywhere $ XPaths.moveFile $ name <> ".slam"

uploadFile ∷ String → SlamFeature Unit
uploadFile =
  Feature.provideFileInputValue (XPath.anywhere $ XPaths.uploadFile)
    <=< appendToCwd

provideFileSearchString ∷ String → SlamFeature Unit
provideFileSearchString value =
  Feature.provideFieldValue (XPath.anywhere XPaths.fileSearchInput) value

selectFile ∷ String → SlamFeature Unit
selectFile name =
  tryRepeatedlyTo (selectFile' <|> selectWorkspace)
  where
  selectFile' =
    Feature.clickNotRepeatedly $ XPath.anywhere $ XPaths.selectFile name
  selectWorkspace =
    Feature.clickNotRepeatedly $ XPath.anywhere $ XPaths.selectFile $ name <> ".slam"

createWorkspaceInTestFolder ∷ String → SlamFeature Unit
createWorkspaceInTestFolder name = do
  browseTestFolder
  createWorkspace
  nameDeck name
  browseTestFolder
  renameFile "Untitled Workspace" name
  accessFile $ name <> ".slam"

createFolder ∷ SlamFeature Unit
createFolder = Feature.click $ XPath.anywhere XPaths.createFolder

deleteFileInTestFolder ∷ String → SlamFeature Unit
deleteFileInTestFolder name = browseTestFolder *> deleteFile name

reopenCurrentWorkspace ∷ SlamFeature Unit
reopenCurrentWorkspace = waitTime 2000 *> refresh

expandNewCardMenu ∷ SlamFeature Unit
expandNewCardMenu = Feature.click (XPath.anywhere XPaths.insertCard)

accessNextCardInLastDeck ∷ SlamFeature Unit
accessNextCardInLastDeck =
  Feature.dragAndDrop
    (XPath.last $ XPath.anywhere $ XPaths.enabledNextCardGripper)
    (XPath.last $ XPath.anywhere $ XPaths.previousCardGripper)

accessPreviousCardInLastDeck ∷ SlamFeature Unit
accessPreviousCardInLastDeck =
  Feature.dragAndDrop
    (XPath.last $ XPath.anywhere $ XPaths.enabledPreviousCardGripper)
    (XPath.last $ XPath.anywhere $ XPaths.nextCardGripper)

insertSearchCardInLastDeck ∷ SlamFeature Unit
insertSearchCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertSearchCard

insertQueryCardInLastDeck ∷ SlamFeature Unit
insertQueryCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertQueryCard

insertMdCardInLastDeck ∷ SlamFeature Unit
insertMdCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertMdCard

insertOpenCardInLastDeck ∷ SlamFeature Unit
insertOpenCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertOpenCard

insertChartOptionsCardInLastDeck ∷ SlamFeature Unit
insertChartOptionsCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertChartOptionsCard

insertDisplayMarkdownCardInLastDeck ∷ SlamFeature Unit
insertDisplayMarkdownCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertDisplayMarkdownCard

insertTableCardInLastDeck ∷ SlamFeature Unit
insertTableCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertTableCard

insertChartCardInLastDeck ∷ SlamFeature Unit
insertChartCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertChartCard

insertCacheCardInLastDeck ∷ SlamFeature Unit
insertCacheCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertCacheCard

insertVariablesCardInLastDeck ∷ SlamFeature Unit
insertVariablesCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertVariablesCard

insertTroubleshootCardInLastDeck ∷ SlamFeature Unit
insertTroubleshootCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertTroubleshootCard

selectBuildChart ∷ SlamFeature Unit
selectBuildChart =
  Feature.click $ followingLastPreviousCardGripper XPaths.selectBuildChart

insertPivotCard ∷ SlamFeature Unit
insertPivotCard =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertPivotCard

insertBuildBarChartCard ∷ SlamFeature Unit
insertBuildBarChartCard =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertBuildBarChartCard

addColumn ∷ String → SlamFeature Unit
addColumn str = do
  Feature.click $ XPath.last $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Add column"
  Feature.click $ XPath.last $ XPath.anywhere $ XPath.anyWithExactAriaLabel $ "Select " ⊕ str
  Feature.click $ XPath.last $ XPath.anywhere $ XPath.anyWithExactText "Confirm"

selectInMillerColumns ∷ Array String → SlamFeature Unit
selectInMillerColumns ps = do
  for_ (enumerate $ Arr.filter (\s → S.length s > 0) ps) \(ix × path) →
    Feature.click $ resourceXPath (ix + one) path
  where
  ariaLabel ∷ String → String
  ariaLabel rPath = "Select " ⊕ rPath

  resourceXPath ∷ Int → String → String
  resourceXPath ix rPath =
    XPath.last
      $ XPath.anywhere
      $ (XPath.nodeAtPosition ix $ XPath.anyWithExactAriaLabel "Column")
      ⊕ XPath.descendantString
      ⊕ (XPath.anyWithExactAriaLabel $ ariaLabel rPath)

selectFileForLastOpenCard ∷ String → SlamFeature Unit
selectFileForLastOpenCard s =
  selectInMillerColumns $ S.split (S.Pattern "/") s

selectInChartBuilder ∷ Array String → SlamFeature Unit
selectInChartBuilder ps = do
  selectInMillerColumns ps
  Feature.click $ XPath.last $ XPath.anywhere $ XPath.anyWithExactText "Confirm"

provideSearchStringInLastSearchCard ∷ String → SlamFeature Unit
provideSearchStringInLastSearchCard =
  Feature.provideFieldValue $ XPath.last $ XPath.anywhere XPaths.searchStringInput

provideMdInLastMdCard ∷ String → SlamFeature Unit
provideMdInLastMdCard =
  Feature.provideFieldValue
    $ XPath.last $ XPath.anywhere XPaths.aceEditor

provideQueryInLastQueryCard ∷ String → SlamFeature Unit
provideQueryInLastQueryCard =
  Feature.provideFieldValue
    $ XPath.last $ XPath.anywhere XPaths.aceEditor

provideSaveDestinationInLastCacheCard ∷ String → SlamFeature Unit
provideSaveDestinationInLastCacheCard =
  Feature.provideFieldValue (XPath.last $ XPath.anywhere XPaths.saveDestinationInput)

doSaveInLastCacheCard ∷ SlamFeature Unit
doSaveInLastCacheCard =
  Feature.click (XPath.last $ XPath.anywhere XPaths.saveSubmitButton)

provideFieldValueInLastDeck ∷ String → String → SlamFeature Unit
provideFieldValueInLastDeck labelText =
  Feature.provideFieldValue
    $ followingLastPreviousCardGripper
    $ "input" `XPath.withLabelWithExactText` labelText

checkFieldInLastDeck ∷ String → SlamFeature Unit
checkFieldInLastDeck labelText =
  Feature.check
    $ followingLastPreviousCardGripper
    $ "input" `XPath.withLabelWithExactText` labelText

uncheckFieldInLastDeck ∷ String → SlamFeature Unit
uncheckFieldInLastDeck labelText =
  Feature.uncheck
    $ followingLastPreviousCardGripper
    $ "input" `XPath.withLabelWithExactText` labelText

pushRadioButtonInLastDeck ∷ String → SlamFeature Unit
pushRadioButtonInLastDeck labelText =
  Feature.pushRadioButton
    $ followingLastPreviousCardGripper
    $ "input" `XPath.withLabelWithExactText` labelText

selectFromDropdownInLastDeck ∷ String → String → SlamFeature Unit
selectFromDropdownInLastDeck labelText =
  Feature.selectFromDropdown
    $ followingLastPreviousCardGripper
    $ "select" `XPath.withLabelWithExactText` labelText

accessSharingUrl ∷ SlamFeature Unit
accessSharingUrl = Feature.accessUrlFromFieldValue $ XPath.anywhere XPaths.sharingUrl

accessPublishingUrl ∷ SlamFeature Unit
accessPublishingUrl = Feature.accessUrlFromFieldValue $ XPath.anywhere XPaths.publishingUrl

downloadFileAsCSV ∷ String → SlamFeature Unit
downloadFileAsCSV fileName = do
  selectFile fileName
  Feature.click $ XPath.anywhere $ XPaths.downloadFile fileName
  Feature.click $ XPath.anywhere $ XPaths.downloadButton
  Feature.click $ XPath.anywhere $ XPaths.cancelButton

downloadFileAsJSON ∷ String → SlamFeature Unit
downloadFileAsJSON fileName = do
  selectFile fileName
  Feature.click $ XPath.anywhere $ XPaths.downloadFile fileName
  Feature.click $ XPath.anywhere $ XPath.anyWithText "JSON"
  Feature.click $ XPath.anywhere $ XPaths.downloadButton
  Feature.click $ XPath.anywhere $ XPaths.cancelButton

showHiddenFiles ∷ SlamFeature Unit
showHiddenFiles =
  Feature.click $ XPath.anywhere $ XPaths.showHiddenFiles

hideHiddenFiles ∷ SlamFeature Unit
hideHiddenFiles =
  Feature.click $ XPath.anywhere $ XPaths.hideHiddenFiles

type ApiVarName = String
type ApiVarType = String
type ApiVarValue = String

provideApiVariableBindingsForVariablesCard
  ∷ ApiVarName
  → ApiVarType
  → ApiVarValue
  → SlamFeature Unit
provideApiVariableBindingsForVariablesCard name ty val = do
  provideValueForVariablesCard
  provideTypeForVariablesCard
  provideDefaultValueForVariablesCard
  where
  provideValueForVariablesCard ∷ SlamFeature Unit
  provideValueForVariablesCard = do
    Feature.provideFieldValue
      (XPath.first $ XPath.anywhere $ XPaths.variablesCardVariableName)
      name
    Feature.pressEnter
  provideTypeForVariablesCard ∷ SlamFeature Unit
  provideTypeForVariablesCard = do
    Feature.selectFromDropdown
      (XPath.first $ XPath.anywhere $ XPaths.variablesCardVariableTypeFor name)
      ty
    Feature.pressEnter

  provideDefaultValueForVariablesCard ∷ SlamFeature Unit
  provideDefaultValueForVariablesCard = do
    Feature.provideFieldValue
      (XPath.first $ XPath.anywhere $ XPaths.variablesCardDefaultValueFor name)
      val
    Feature.pressEnter

activateCategoryForChartBuilder ∷ SlamFeature Unit
activateCategoryForChartBuilder =
  Feature.click $ XPath.last $ XPath.anywhere $ XPaths.chartCategorySelector

activateStackForChartBuilder ∷ SlamFeature Unit
activateStackForChartBuilder =
  Feature.click $ XPath.last $ XPath.anywhere $ XPaths.chartStackSelector

flipDeck ∷ SlamFeature Unit
flipDeck =
  Feature.click $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Flip deck"

trashActiveOrLastCard ∷ SlamFeature Unit
trashActiveOrLastCard =
  Feature.click $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Delete card"

shareDeck ∷ SlamFeature Unit
shareDeck =
  Feature.click $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Share deck"

publishDeck ∷ SlamFeature Unit
publishDeck =
  Feature.click $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Publish deck"

filterDeckAndCardActions ∷ String → SlamFeature Unit
filterDeckAndCardActions =
  Feature.provideFieldValue (XPath.anywhere $ XPath.anyWithExactAriaLabel "Filter deck and card actions")

filterNextActions ∷ String → SlamFeature Unit
filterNextActions =
  Feature.provideFieldValue (XPath.anywhere $ XPath.anyWithExactAriaLabel "Filter next actions")

confirmDeckAction ∷ SlamFeature Unit
confirmDeckAction =
  Feature.click $ XPath.anywhere $ XPath.anyWithExactText "Confirm"

runQuery ∷ SlamFeature Unit
runQuery =
  Feature.click $ XPath.last $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Run query"

setVarMapForDeck ∷ String → SM.StrMap String → SlamFeature Unit
setVarMapForDeck deckName vm = accessWorkspaceWithModifiedURL \urlStr →
  let
    varsValue =
      encodeURIComponent
      $ prettyJson
      $ encodeJson
      $ SM.singleton deckName vm
  in
   urlStr ⊕ "/?vars=" ⊕ varsValue

module Test.SlamData.Feature.Interactions where

import SlamData.Prelude

import Data.Argonaut (encodeJson)
import Data.Array as Arr
import Data.Map as Map
import Data.String as S
import Data.StrMap as SM

import Global (encodeURIComponent)

import Selenium.Monad (get, refresh, getCurrentUrl, tryRepeatedlyTo)

import Test.Feature as Feature
import Test.SlamData.Feature.Monad (SlamFeature, getConfig, waitTime)
import Test.SlamData.Feature.XPaths as XPaths
import Test.Utils (appendToCwd)

import XPath as XPath

import Utils (prettyJson)
import Utils.Array (enumerate)

followingLastPreviousCardGripper :: String -> String
followingLastPreviousCardGripper = XPath.following lastPreviousCardGripperXPath
  where
  lastPreviousCardGripperXPath = XPath.last $ XPath.anywhere XPaths.previousCardGripper

launchSlamData ∷ SlamFeature Unit
launchSlamData = get ∘ _.slamdataUrl =<< getConfig

accessWorkspaceWithModifiedURL ∷ (String → String) → SlamFeature Unit
accessWorkspaceWithModifiedURL modifier =
  getCurrentUrl >>= modifier >>> get

mountTestDatabase ∷ SlamFeature Unit
mountTestDatabase = do
  -- If we don't wait for "Configure database" to appear in the toolbar the
  -- wrong item will be clicked for "Mount database" due to a timing issue. Yay.
  Feature.expectPresented (XPath.anywhere XPaths.accessConfigureMount)
  Feature.click (XPath.anywhere XPaths.accessMountDatabase)
  Feature.provideFieldValue (XPath.anywhere XPaths.mountName) "test-mount"
  Feature.selectFromDropdown (XPath.anywhere XPaths.mountType) "MongoDB"
  Feature.click (XPath.anywhere $ XPaths.mountName)
  Feature.provideFieldValue (XPath.index (XPath.anywhere XPaths.mountPort) 1) "63174"
  Feature.provideFieldValue (XPath.index (XPath.anywhere XPaths.mountHost) 1) "localhost"
  Feature.provideFieldValue (XPath.anywhere XPaths.mountDatabase) "testDb"
  Feature.click (XPath.anywhere XPaths.mountButton)

skipGuide ∷ SlamFeature Unit
skipGuide =
  Feature.click $ XPath.anywhere $ XPath.anyWithText "Skip"

dismissHint ∷ SlamFeature Unit
dismissHint =
  Feature.click $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Dismiss"

accessFile ∷ String → SlamFeature Unit
accessFile =
  Feature.click ∘ XPath.anywhere ∘ XPaths.accessFile

exploreFile ∷ String → SlamFeature Unit
exploreFile name = do
  Feature.provideFieldValue (XPath.anywhere $ XPath.anyWithExactAriaLabel "New workspace name") name
  Feature.click $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Explore file"

accessBreadcrumb ∷ String → SlamFeature Unit
accessBreadcrumb = Feature.click ∘ XPath.anywhere ∘ XPaths.accessBreadcrumb

browseRootFolder ∷ SlamFeature Unit
browseRootFolder = do
  Feature.click $ XPath.anywhere XPaths.headerGripper
  Feature.click $ XPath.index (XPath.anywhere XPaths.browseRootFolder) 1

browseTestFolder ∷ SlamFeature Unit
browseTestFolder =
  browseRootFolder *> accessFile "test-mount" *> accessFile "testDb"

createWorkspace ∷ SlamFeature Unit
createWorkspace = Feature.click $ XPath.anywhere XPaths.createWorkspace

nameDeck ∷ String → SlamFeature Unit
nameDeck name = do
  flipDeck
  Feature.click $ XPath.anywhere XPaths.renameDeck
  Feature.provideFieldValue (XPath.anywhere $ XPath.nodeWithExactAriaLabel "input" "Deck name") name
  Feature.click $ XPath.anywhere $ XPath.anyWithExactText "Save"

deleteFile ∷ String → SlamFeature Unit
deleteFile name =
  Feature.click (XPath.anywhere $ XPaths.selectFile name)
    *> Feature.click (XPath.anywhere $ XPaths.removeFile name)
    *> Feature.expectNotPresented (XPath.anywhere $ XPaths.selectFile name)

shareFile ∷ String → SlamFeature Unit
shareFile name = do
  Feature.click (XPath.anywhere $ XPaths.selectFile name)
  tryRepeatedlyTo $ clickShareFile <|> clickShareWorkspace
  where
  clickShareFile =
    Feature.clickNotRepeatedly (XPath.anywhere $ XPaths.shareFile name)
  clickShareWorkspace =
    Feature.clickNotRepeatedly (XPath.anywhere $ XPaths.shareFile $ name <> ".slam")

renameFile ∷ String → String → SlamFeature Unit
renameFile oldName newName = do
  selectFile oldName
  clickMove oldName
  Feature.provideFieldValueWithProperties
    (Map.singleton "value" $ Just oldName)
    (XPath.anywhere "input")
    newName
  Feature.click $ XPath.anywhere XPaths.renameButton
  where
  oldWorkspaceName = oldName <> ".slam"

moveFile ∷ String → String → String → SlamFeature Unit
moveFile fileName oldLocation newLocation = do
  selectFile fileName
  clickMove fileName
  Feature.click $ XPath.anywhere XPaths.selectADestinationFolder
  Feature.click $ XPath.anywhere $ XPath.anyWithExactText newLocation
  Feature.click $ XPath.anywhere XPaths.renameButton

clickMove ∷ String → SlamFeature Unit
clickMove name =
  tryRepeatedlyTo $ clickMoveFile <|> clickMoveWorkspace
  where
  clickMoveFile =
    Feature.clickNotRepeatedly $ XPath.anywhere $ XPaths.moveFile name
  clickMoveWorkspace =
    Feature.clickNotRepeatedly $ XPath.anywhere $ XPaths.moveFile $ name <> ".slam"

uploadFile ∷ String → SlamFeature Unit
uploadFile =
  Feature.provideFileInputValue (XPath.anywhere $ XPaths.uploadFile)
    <=< appendToCwd

provideFileSearchString ∷ String → SlamFeature Unit
provideFileSearchString value =
  Feature.provideFieldValue (XPath.anywhere XPaths.fileSearchInput) value

selectFile ∷ String → SlamFeature Unit
selectFile name =
  tryRepeatedlyTo (selectFile' <|> selectWorkspace)
  where
  selectFile' =
    Feature.clickNotRepeatedly $ XPath.anywhere $ XPaths.selectFile name
  selectWorkspace =
    Feature.clickNotRepeatedly $ XPath.anywhere $ XPaths.selectFile $ name <> ".slam"

createWorkspaceInTestFolder ∷ String → SlamFeature Unit
createWorkspaceInTestFolder name = do
  browseTestFolder
  createWorkspace
  nameDeck name
  browseTestFolder
  renameFile "Untitled Workspace" name
  accessFile $ name <> ".slam"

createFolder ∷ SlamFeature Unit
createFolder = Feature.click $ XPath.anywhere XPaths.createFolder

deleteFileInTestFolder ∷ String → SlamFeature Unit
deleteFileInTestFolder name = browseTestFolder *> deleteFile name

reopenCurrentWorkspace ∷ SlamFeature Unit
reopenCurrentWorkspace = waitTime 2000 *> refresh

expandNewCardMenu ∷ SlamFeature Unit
expandNewCardMenu = Feature.click (XPath.anywhere XPaths.insertCard)

accessNextCardInLastDeck ∷ SlamFeature Unit
accessNextCardInLastDeck =
  Feature.dragAndDrop
    (XPath.last $ XPath.anywhere $ XPaths.enabledNextCardGripper)
    (XPath.last $ XPath.anywhere $ XPaths.previousCardGripper)

accessPreviousCardInLastDeck ∷ SlamFeature Unit
accessPreviousCardInLastDeck =
  Feature.dragAndDrop
    (XPath.last $ XPath.anywhere $ XPaths.enabledPreviousCardGripper)
    (XPath.last $ XPath.anywhere $ XPaths.nextCardGripper)

insertSearchCardInLastDeck ∷ SlamFeature Unit
insertSearchCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertSearchCard

insertQueryCardInLastDeck ∷ SlamFeature Unit
insertQueryCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertQueryCard

insertMdCardInLastDeck ∷ SlamFeature Unit
insertMdCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertMdCard

insertOpenCardInLastDeck ∷ SlamFeature Unit
insertOpenCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertOpenCard

insertChartOptionsCardInLastDeck ∷ SlamFeature Unit
insertChartOptionsCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertChartOptionsCard

insertDisplayMarkdownCardInLastDeck ∷ SlamFeature Unit
insertDisplayMarkdownCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertDisplayMarkdownCard

insertTableCardInLastDeck ∷ SlamFeature Unit
insertTableCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertTableCard

insertChartCardInLastDeck ∷ SlamFeature Unit
insertChartCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertChartCard

insertCacheCardInLastDeck ∷ SlamFeature Unit
insertCacheCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertCacheCard

insertVariablesCardInLastDeck ∷ SlamFeature Unit
insertVariablesCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertVariablesCard

insertTroubleshootCardInLastDeck ∷ SlamFeature Unit
insertTroubleshootCardInLastDeck =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertTroubleshootCard

selectBuildChart ∷ SlamFeature Unit
selectBuildChart =
  Feature.click $ followingLastPreviousCardGripper XPaths.selectBuildChart

insertPivotCard ∷ SlamFeature Unit
insertPivotCard =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertPivotCard

insertBuildBarChartCard ∷ SlamFeature Unit
insertBuildBarChartCard =
  Feature.click $ followingLastPreviousCardGripper XPaths.insertBuildBarChartCard

addColumn ∷ String → SlamFeature Unit
addColumn str = do
  Feature.click $ XPath.last $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Add column"
  Feature.click $ XPath.last $ XPath.anywhere $ XPath.anyWithExactAriaLabel $ "Select " ⊕ str
  Feature.click $ XPath.last $ XPath.anywhere $ XPath.anyWithExactText "Confirm"

selectInMillerColumns ∷ Array String → SlamFeature Unit
selectInMillerColumns ps = do
  for_ (enumerate $ Arr.filter (\s → S.length s > 0) ps) \(ix × path) →
    Feature.click $ resourceXPath (ix + one) path
  where
  ariaLabel ∷ String → String
  ariaLabel rPath = "Select " ⊕ rPath

  resourceXPath ∷ Int → String → String
  resourceXPath ix rPath =
    XPath.last
      $ XPath.anywhere
      $ (XPath.nodeAtPosition ix $ XPath.anyWithExactAriaLabel "Column")
      ⊕ XPath.descendantString
      ⊕ (XPath.anyWithExactAriaLabel $ ariaLabel rPath)

selectFileForLastOpenCard ∷ String → SlamFeature Unit
selectFileForLastOpenCard s =
  selectInMillerColumns $ S.split (S.Pattern "/") s

selectInChartBuilder ∷ Array String → SlamFeature Unit
selectInChartBuilder ps = do
  selectInMillerColumns ps
  Feature.click $ XPath.last $ XPath.anywhere $ XPath.anyWithExactText "Confirm"

provideSearchStringInLastSearchCard ∷ String → SlamFeature Unit
provideSearchStringInLastSearchCard =
  Feature.provideFieldValue $ XPath.last $ XPath.anywhere XPaths.searchStringInput

provideMdInLastMdCard ∷ String → SlamFeature Unit
provideMdInLastMdCard =
  Feature.provideFieldValue
    $ XPath.last $ XPath.anywhere XPaths.aceEditor

provideQueryInLastQueryCard ∷ String → SlamFeature Unit
provideQueryInLastQueryCard =
  Feature.provideFieldValue
    $ XPath.last $ XPath.anywhere XPaths.aceEditor

provideSaveDestinationInLastCacheCard ∷ String → SlamFeature Unit
provideSaveDestinationInLastCacheCard =
  Feature.provideFieldValue (XPath.last $ XPath.anywhere XPaths.saveDestinationInput)

doSaveInLastCacheCard ∷ SlamFeature Unit
doSaveInLastCacheCard =
  Feature.click (XPath.last $ XPath.anywhere XPaths.saveSubmitButton)

provideFieldValueInLastDeck ∷ String → String → SlamFeature Unit
provideFieldValueInLastDeck labelText =
  Feature.provideFieldValue
    $ followingLastPreviousCardGripper
    $ "input" `XPath.withLabelWithExactText` labelText

checkFieldInLastDeck ∷ String → SlamFeature Unit
checkFieldInLastDeck labelText =
  Feature.check
    $ followingLastPreviousCardGripper
    $ "input" `XPath.withLabelWithExactText` labelText

uncheckFieldInLastDeck ∷ String → SlamFeature Unit
uncheckFieldInLastDeck labelText =
  Feature.uncheck
    $ followingLastPreviousCardGripper
    $ "input" `XPath.withLabelWithExactText` labelText

pushRadioButtonInLastDeck ∷ String → SlamFeature Unit
pushRadioButtonInLastDeck labelText =
  Feature.pushRadioButton
    $ followingLastPreviousCardGripper
    $ "input" `XPath.withLabelWithExactText` labelText

selectFromDropdownInLastDeck ∷ String → String → SlamFeature Unit
selectFromDropdownInLastDeck labelText =
  Feature.selectFromDropdown
    $ followingLastPreviousCardGripper
    $ "select" `XPath.withLabelWithExactText` labelText

accessSharingUrl ∷ SlamFeature Unit
accessSharingUrl = Feature.accessUrlFromFieldValue $ XPath.anywhere XPaths.sharingUrl

accessPublishingUrl ∷ SlamFeature Unit
accessPublishingUrl = Feature.accessUrlFromFieldValue $ XPath.anywhere XPaths.publishingUrl

downloadFileAsCSV ∷ String → SlamFeature Unit
downloadFileAsCSV fileName = do
  selectFile fileName
  Feature.click $ XPath.anywhere $ XPaths.downloadFile fileName
  Feature.click $ XPath.anywhere $ XPaths.downloadButton
  Feature.click $ XPath.anywhere $ XPaths.cancelButton

downloadFileAsJSON ∷ String → SlamFeature Unit
downloadFileAsJSON fileName = do
  selectFile fileName
  Feature.click $ XPath.anywhere $ XPaths.downloadFile fileName
  Feature.click $ XPath.anywhere $ XPath.anyWithText "JSON"
  Feature.click $ XPath.anywhere $ XPaths.downloadButton
  Feature.click $ XPath.anywhere $ XPaths.cancelButton

showHiddenFiles ∷ SlamFeature Unit
showHiddenFiles =
  Feature.click $ XPath.anywhere $ XPaths.showHiddenFiles

hideHiddenFiles ∷ SlamFeature Unit
hideHiddenFiles =
  Feature.click $ XPath.anywhere $ XPaths.hideHiddenFiles

type ApiVarName = String
type ApiVarType = String
type ApiVarValue = String

provideApiVariableBindingsForVariablesCard
  ∷ ApiVarName
  → ApiVarType
  → ApiVarValue
  → SlamFeature Unit
provideApiVariableBindingsForVariablesCard name ty val = do
  provideValueForVariablesCard
  provideTypeForVariablesCard
  provideDefaultValueForVariablesCard
  where
  provideValueForVariablesCard ∷ SlamFeature Unit
  provideValueForVariablesCard = do
    Feature.provideFieldValue
      (XPath.first $ XPath.anywhere $ XPaths.variablesCardVariableName)
      name
    Feature.pressEnter
  provideTypeForVariablesCard ∷ SlamFeature Unit
  provideTypeForVariablesCard = do
    Feature.selectFromDropdown
      (XPath.first $ XPath.anywhere $ XPaths.variablesCardVariableTypeFor name)
      ty
    Feature.pressEnter

  provideDefaultValueForVariablesCard ∷ SlamFeature Unit
  provideDefaultValueForVariablesCard = do
    Feature.provideFieldValue
      (XPath.first $ XPath.anywhere $ XPaths.variablesCardDefaultValueFor name)
      val
    Feature.pressEnter

activateCategoryForChartBuilder ∷ SlamFeature Unit
activateCategoryForChartBuilder =
  Feature.click $ XPath.last $ XPath.anywhere $ XPaths.chartCategorySelector

activateStackForChartBuilder ∷ SlamFeature Unit
activateStackForChartBuilder =
  Feature.click $ XPath.last $ XPath.anywhere $ XPaths.chartStackSelector

flipDeck ∷ SlamFeature Unit
flipDeck =
  Feature.click $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Flip deck"

trashActiveOrLastCard ∷ SlamFeature Unit
trashActiveOrLastCard =
  Feature.click $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Delete card"

shareDeck ∷ SlamFeature Unit
shareDeck =
  Feature.click $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Share deck"

publishDeck ∷ SlamFeature Unit
publishDeck =
  Feature.click $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Publish deck"

filterDeckAndCardActions ∷ String → SlamFeature Unit
filterDeckAndCardActions =
  Feature.provideFieldValue (XPath.anywhere $ XPath.anyWithExactAriaLabel "Filter deck and card actions")

filterNextActions ∷ String → SlamFeature Unit
filterNextActions =
  Feature.provideFieldValue (XPath.anywhere $ XPath.anyWithExactAriaLabel "Filter next actions")

confirmDeckAction ∷ SlamFeature Unit
confirmDeckAction =
  Feature.click $ XPath.anywhere $ XPath.anyWithExactText "Confirm"

runQuery ∷ SlamFeature Unit
runQuery =
  Feature.click $ XPath.last $ XPath.anywhere $ XPath.anyWithExactAriaLabel "Run query"

setVarMapForDeck ∷ String → SM.StrMap String → SlamFeature Unit
setVarMapForDeck deckName vm = accessWorkspaceWithModifiedURL \urlStr →
  let
    varsValue =
      encodeURIComponent
      $ prettyJson
      $ encodeJson
      $ SM.singleton deckName vm
  in
   urlStr ⊕ "/?vars=" ⊕ varsValue


Adding displayName function

Adding displayName function

module Thermite
  ( simpleSpec
  , componentWillMount
  , createClass
  , render
  ) where

import DOM

import Data.Maybe

import Control.Monad.Eff

import Thermite.Html
import Thermite.Internal
import Thermite.Types
import Thermite.Action

simpleSpec :: forall m state props action. state -> PerformAction props action m -> Render state props action -> Spec m state props action
simpleSpec initialState performAction render = Spec { initialState: initialState
                                                    , performAction: performAction
                                                    , render: render
                                                    , componentWillMount: Nothing
                                                    , displayName: Nothing
                                                    }

componentWillMount :: forall m state props action. action -> Spec m state props action -> Spec m state props action
componentWillMount action (Spec spec) = Spec (spec { componentWillMount = Just action })

displayName :: forall m state props action. String -> Spec m state props action -> Spec m state props action
displayName name (Spec spec) = Spec (spec { displayName = Just name })

createClass :: forall eff state props action. Spec (Action eff state) state props action -> ComponentClass props eff
createClass = createClassImpl runAction maybe

render :: forall props eff. ComponentClass props eff -> props -> Eff (dom :: DOM | eff) Unit
render = renderImpl

module Thermite
  ( simpleSpec
  , componentWillMount
  , createClass
  , render
  ) where

import DOM

import Data.Maybe

import Control.Monad.Eff

import Thermite.Html
import Thermite.Internal
import Thermite.Types
import Thermite.Action

simpleSpec :: forall m state props action. state -> PerformAction props action m -> Render state props action -> Spec m state props action
simpleSpec initialState performAction render = Spec { initialState: initialState
                                                    , performAction: performAction
                                                    , render: render
                                                    , componentWillMount: Nothing
                                                    , displayName: Nothing
                                                    }

componentWillMount :: forall m state props action. action -> Spec m state props action -> Spec m state props action
componentWillMount action (Spec spec) = Spec (spec { componentWillMount = Just action })

createClass :: forall eff state props action. Spec (Action eff state) state props action -> ComponentClass props eff
createClass = createClassImpl runAction maybe

render :: forall props eff. ComponentClass props eff -> props -> Eff (dom :: DOM | eff) Unit
render = renderImpl


remove pathToNotebook serialization

remove pathToNotebook serialization

module Model.Notebook.Cell where

import Control.Alt ((<|>))
import Data.Argonaut.Combinators ((~>), (:=), (.?))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Argonaut.Decode (DecodeJson, decodeJson)
import Data.Argonaut.Encode (EncodeJson, encodeJson)
import Data.Date (Date())
import Data.Either (Either(..), either)
import Data.Maybe (Maybe(..), maybe)
import Data.Time (Milliseconds())
import Global (readInt, isNaN)
import Model.Notebook.Cell.FileInput
import Model.Notebook.Cell.JTableContent
import Model.Notebook.Port
import Model.Resource
import Optic.Core (lens, LensP(), prism', PrismP(), (..), (.~), (^.))
import Optic.Extended (TraversalP())
import Data.Path.Pathy (rootDir, parseAbsDir, sandbox, (</>), printPath, file)
import Model.Path (DirPath(), phantomNotebookPath)

import qualified Model.Notebook.Cell.Common as Cm
import qualified Model.Notebook.Cell.Explore as Ex
import qualified Model.Notebook.Cell.Markdown as Ma
import qualified Model.Notebook.Cell.Query as Qu
import qualified Model.Notebook.Cell.Search as Sr
import qualified Model.Notebook.Cell.Viz as Vz

type CellId = Number
type FailureMessage = String

string2cellId :: String -> Either String CellId
string2cellId str =
  let int = readInt 10 str
  in if isNaN int then Left "incorrect cell id" else Right int

newtype Cell =
  Cell { cellId :: CellId
       , parent :: Maybe CellId
       , input :: Port
       , output :: Port
       , content :: CellContent
       , expandedStatus :: Boolean
       , message :: String
       , failures :: [FailureMessage]
       , hiddenEditor :: Boolean
       , runState :: RunState
       , hasRun :: Boolean
       , pathToNotebook :: DirPath
       }

newCell :: CellId -> CellContent -> Cell
newCell cellId content =
  Cell { cellId: cellId
       , parent: Nothing
       , input: Closed
       , output: Closed
       , content: content
       , expandedStatus: false
       , failures: []
       , message: ""
       , hiddenEditor: false
       , runState: RunInitial
       , hasRun: false
       , pathToNotebook: rootDir
       }

_Cell :: LensP Cell _
_Cell = lens (\(Cell obj) -> obj) (const Cell)

_cellId :: LensP Cell CellId
_cellId = _Cell <<< lens _.cellId (_ { cellId = _ })

_parent :: LensP Cell (Maybe CellId)
_parent = _Cell <<< lens _.parent (_ { parent = _ })

_input :: LensP Cell Port
_input = _Cell <<< lens _.input (_ { input = _ })

_output :: LensP Cell Port
_output = _Cell <<< lens _.output (_ { output = _ })

_content :: LensP Cell CellContent
_content = _Cell <<< lens _.content (_ { content = _ })

_hiddenEditor :: LensP Cell Boolean
_hiddenEditor = _Cell <<< lens _.hiddenEditor (_ { hiddenEditor = _ })

_runState :: LensP Cell RunState
_runState = _Cell <<< lens _.runState (_ { runState = _ })

_expandedStatus :: LensP Cell Boolean
_expandedStatus = _Cell <<< lens _.expandedStatus (_ { expandedStatus = _ })

_failures :: LensP Cell [FailureMessage]
_failures = _Cell <<< lens _.failures (_ { failures = _ })

_message :: LensP Cell String
_message = _Cell <<< lens _.message _{message = _}

_hasRun :: LensP Cell Boolean
_hasRun = _Cell <<< lens _.hasRun _{hasRun = _}

_pathToNotebook :: LensP Cell DirPath
_pathToNotebook = _Cell <<< lens _.pathToNotebook _{pathToNotebook = _}

instance eqCell :: Eq Cell where
  (==) (Cell c) (Cell c') = c.cellId == c'.cellId
  (/=) a b = not $ a == b

instance ordCell :: Ord Cell where
  compare (Cell c) (Cell c') = compare c.cellId c'.cellId

instance encodeJsonCell :: EncodeJson Cell where
  encodeJson (Cell cell)
    =  "cellId" := cell.cellId
    ~> "parent" := cell.parent
    ~> "input" := cell.input
    ~> "output" := cell.output
    ~> "content" := cell.content
    ~> "hasRun" := cell.hasRun
    ~> jsonEmptyObject

instance decodeJsonCell :: DecodeJson Cell where
  decodeJson json = do
    obj <- decodeJson json
    cell <- newCell <$> obj .? "cellId"
                    <*> obj .? "content"
    parent <- obj .? "parent"
    input <- obj .? "input"
    output <- obj .? "output"
    let hasRun = either (const false) id (obj .? "hasRun")
    pure (cell # (_parent .~ parent)
              .. (_input  .~ input)
              .. (_output .~ output)
              .. (_hasRun .~ hasRun)
              .. (_pathToNotebook .~ phantomNotebookPath))

data CellContent
  = Search Sr.SearchRec
  | Explore Ex.ExploreRec
  | Visualize Vz.VizRec
  | Query Qu.QueryRec
  | Markdown Ma.MarkdownRec

cellContentType :: CellContent -> String
cellContentType (Explore _) = "explore"
cellContentType (Search _) = "search"
cellContentType (Query _) = "query"
cellContentType (Visualize _) = "visualize"
cellContentType (Markdown _) = "markdown"

newSearchContent :: Resource -> CellContent
newSearchContent res = Search (Sr.initialSearchRec # Sr._input .. _file .~ Right res)

newQueryContent :: Resource -> CellContent
newQueryContent res = Query (Qu.initialQueryRec # Qu._input .~ "SELECT * FROM \"" ++ resourceName res ++ "\"")

newVisualizeContent :: CellContent
newVisualizeContent = Visualize Vz.initialVizRec

_Explore :: PrismP CellContent Ex.ExploreRec
_Explore = prism' Explore $ \s -> case s of
  Explore r -> Just r
  _ -> Nothing

_Search :: PrismP CellContent Sr.SearchRec
_Search = prism' Search $ \s -> case s of
  Search s -> Just s
  _ -> Nothing

_Query :: PrismP CellContent Qu.QueryRec
_Query = prism' Query $ \s -> case s of
  Query s -> Just s
  _ -> Nothing

_Visualize :: PrismP CellContent Vz.VizRec
_Visualize = prism' Visualize $ \s -> case s of
  Visualize s -> Just s
  _ -> Nothing

_Markdown :: PrismP CellContent Ma.MarkdownRec
_Markdown = prism' Markdown $ \s -> case s of
  Markdown s -> Just s
  _ -> Nothing

_FileInput :: TraversalP CellContent FileInput
_FileInput f s = case s of
  Explore _ -> (_Explore .. Ex._input) f s
  Search _ -> (_Search .. Sr._input) f s
  _  -> _const f s

_JTableContent :: TraversalP CellContent JTableContent
_JTableContent f s = case s of
  Explore _ -> (_Explore .. Ex._table) f s
  Search _ -> (_Search .. Sr._table) f s
  Query _ -> (_Query .. Qu._table) f s
  _  -> _const f s

_AceContent :: TraversalP CellContent String
_AceContent f s = case s of
  Search _ -> (_Search .. Sr._buffer) f s
  Query _ -> (_Query .. Qu._input) f s
  Markdown _ -> (_Markdown .. Ma._input) f s
  _ -> _const f s

_const :: forall a b. TraversalP a b
_const _ s = pure s

instance encodeJsonCellContent :: EncodeJson CellContent where
  encodeJson cc
    =  "type" := cellContentType cc
    ~> case cc of
      Search rec -> encodeJson rec
      Explore rec -> encodeJson rec
      Query rec -> encodeJson rec
      Markdown rec -> encodeJson rec
      Visualize rec -> encodeJson rec
      _ -> jsonEmptyObject

instance decodeJsonExploreRec :: DecodeJson CellContent where
  decodeJson json = do
    obj <- decodeJson json
    cellType <- obj .? "type"
    case cellType of
      "search" -> Search <$> decodeJson json
      "explore" -> Explore <$> decodeJson json
      "query" -> Query <$> decodeJson json
      "markdown" -> Markdown <$> decodeJson json
      "visualize" -> Visualize <$> decodeJson json
      _ -> Left $ "Unknown CellContent type: '" ++ cellType ++ "'"

data RunState = RunInitial
              | RunningSince Date
              | RunFinished Milliseconds

_RunInitial :: PrismP RunState Unit
_RunInitial = prism' (const RunInitial) $ \r -> case r of
  RunInitial -> Just unit
  _ -> Nothing

_RunningSince :: PrismP RunState Date
_RunningSince = prism' RunningSince $ \r -> case r of
  RunningSince d -> Just d
  _ -> Nothing

_RunFinished :: PrismP RunState Milliseconds
_RunFinished = prism' RunFinished $ \r -> case r of
  RunFinished m -> Just m
  _ -> Nothing

outFile :: Cell -> Resource
outFile cell = mkFile $ Left $ (cell ^._pathToNotebook) </> file ("out" <> show (cell ^._cellId))

module Model.Notebook.Cell where

import Control.Alt ((<|>))
import Data.Argonaut.Combinators ((~>), (:=), (.?))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Argonaut.Decode (DecodeJson, decodeJson)
import Data.Argonaut.Encode (EncodeJson, encodeJson)
import Data.Date (Date())
import Data.Either (Either(..), either)
import Data.Maybe (Maybe(..), maybe)
import Data.Time (Milliseconds())
import Global (readInt, isNaN)
import Model.Notebook.Cell.FileInput
import Model.Notebook.Cell.JTableContent
import Model.Notebook.Port
import Model.Resource
import Optic.Core (lens, LensP(), prism', PrismP(), (..), (.~), (^.))
import Optic.Extended (TraversalP())
import Data.Path.Pathy (rootDir, parseAbsDir, sandbox, (</>), printPath, file)
import Model.Path (DirPath(), phantomNotebookPath)

import qualified Model.Notebook.Cell.Common as Cm
import qualified Model.Notebook.Cell.Explore as Ex
import qualified Model.Notebook.Cell.Markdown as Ma
import qualified Model.Notebook.Cell.Query as Qu
import qualified Model.Notebook.Cell.Search as Sr
import qualified Model.Notebook.Cell.Viz as Vz

type CellId = Number
type FailureMessage = String

string2cellId :: String -> Either String CellId
string2cellId str =
  let int = readInt 10 str
  in if isNaN int then Left "incorrect cell id" else Right int

newtype Cell =
  Cell { cellId :: CellId
       , parent :: Maybe CellId
       , input :: Port
       , output :: Port
       , content :: CellContent
       , expandedStatus :: Boolean
       , message :: String
       , failures :: [FailureMessage]
       , hiddenEditor :: Boolean
       , runState :: RunState
       , hasRun :: Boolean
       , pathToNotebook :: DirPath
       }

newCell :: CellId -> CellContent -> Cell
newCell cellId content =
  Cell { cellId: cellId
       , parent: Nothing
       , input: Closed
       , output: Closed
       , content: content
       , expandedStatus: false
       , failures: []
       , message: ""
       , hiddenEditor: false
       , runState: RunInitial
       , hasRun: false
       , pathToNotebook: rootDir
       }

_Cell :: LensP Cell _
_Cell = lens (\(Cell obj) -> obj) (const Cell)

_cellId :: LensP Cell CellId
_cellId = _Cell <<< lens _.cellId (_ { cellId = _ })

_parent :: LensP Cell (Maybe CellId)
_parent = _Cell <<< lens _.parent (_ { parent = _ })

_input :: LensP Cell Port
_input = _Cell <<< lens _.input (_ { input = _ })

_output :: LensP Cell Port
_output = _Cell <<< lens _.output (_ { output = _ })

_content :: LensP Cell CellContent
_content = _Cell <<< lens _.content (_ { content = _ })

_hiddenEditor :: LensP Cell Boolean
_hiddenEditor = _Cell <<< lens _.hiddenEditor (_ { hiddenEditor = _ })

_runState :: LensP Cell RunState
_runState = _Cell <<< lens _.runState (_ { runState = _ })

_expandedStatus :: LensP Cell Boolean
_expandedStatus = _Cell <<< lens _.expandedStatus (_ { expandedStatus = _ })

_failures :: LensP Cell [FailureMessage]
_failures = _Cell <<< lens _.failures (_ { failures = _ })

_message :: LensP Cell String
_message = _Cell <<< lens _.message _{message = _}

_hasRun :: LensP Cell Boolean
_hasRun = _Cell <<< lens _.hasRun _{hasRun = _}

_pathToNotebook :: LensP Cell DirPath
_pathToNotebook = _Cell <<< lens _.pathToNotebook _{pathToNotebook = _}

instance eqCell :: Eq Cell where
  (==) (Cell c) (Cell c') = c.cellId == c'.cellId
  (/=) a b = not $ a == b

instance ordCell :: Ord Cell where
  compare (Cell c) (Cell c') = compare c.cellId c'.cellId

instance encodeJsonCell :: EncodeJson Cell where
  encodeJson (Cell cell)
    =  "cellId" := cell.cellId
    ~> "parent" := cell.parent
    ~> "input" := cell.input
    ~> "output" := cell.output
    ~> "content" := cell.content
    ~> "hasRun" := cell.hasRun
    ~> "pathToNotebook" := printPath cell.pathToNotebook
    ~> jsonEmptyObject

instance decodeJsonCell :: DecodeJson Cell where
  decodeJson json = do
    obj <- decodeJson json
    cell <- newCell <$> obj .? "cellId"
                    <*> obj .? "content"
    parent <- obj .? "parent"
    input <- obj .? "input"
    output <- obj .? "output"
    pathToNotebook <- case obj .? "pathToNotebook" of
      Left _ -> pure rootDir
      Right str -> pure $
                   maybe phantomNotebookPath (rootDir </>)
                   (parseAbsDir str >>= sandbox rootDir)
    let hasRun = either (const false) id (obj .? "hasRun")
    pure (cell # (_parent .~ parent)
              .. (_input  .~ input)
              .. (_output .~ output)
              .. (_hasRun .~ hasRun)
              .. (_pathToNotebook .~ pathToNotebook))

data CellContent
  = Search Sr.SearchRec
  | Explore Ex.ExploreRec
  | Visualize Vz.VizRec
  | Query Qu.QueryRec
  | Markdown Ma.MarkdownRec

cellContentType :: CellContent -> String
cellContentType (Explore _) = "explore"
cellContentType (Search _) = "search"
cellContentType (Query _) = "query"
cellContentType (Visualize _) = "visualize"
cellContentType (Markdown _) = "markdown"

newSearchContent :: Resource -> CellContent
newSearchContent res = Search (Sr.initialSearchRec # Sr._input .. _file .~ Right res)

newQueryContent :: Resource -> CellContent
newQueryContent res = Query (Qu.initialQueryRec # Qu._input .~ "SELECT * FROM \"" ++ resourceName res ++ "\"")

newVisualizeContent :: CellContent
newVisualizeContent = Visualize Vz.initialVizRec

_Explore :: PrismP CellContent Ex.ExploreRec
_Explore = prism' Explore $ \s -> case s of
  Explore r -> Just r
  _ -> Nothing

_Search :: PrismP CellContent Sr.SearchRec
_Search = prism' Search $ \s -> case s of
  Search s -> Just s
  _ -> Nothing

_Query :: PrismP CellContent Qu.QueryRec
_Query = prism' Query $ \s -> case s of
  Query s -> Just s
  _ -> Nothing

_Visualize :: PrismP CellContent Vz.VizRec
_Visualize = prism' Visualize $ \s -> case s of
  Visualize s -> Just s
  _ -> Nothing

_Markdown :: PrismP CellContent Ma.MarkdownRec
_Markdown = prism' Markdown $ \s -> case s of
  Markdown s -> Just s
  _ -> Nothing

_FileInput :: TraversalP CellContent FileInput
_FileInput f s = case s of
  Explore _ -> (_Explore .. Ex._input) f s
  Search _ -> (_Search .. Sr._input) f s
  _  -> _const f s

_JTableContent :: TraversalP CellContent JTableContent
_JTableContent f s = case s of
  Explore _ -> (_Explore .. Ex._table) f s
  Search _ -> (_Search .. Sr._table) f s
  Query _ -> (_Query .. Qu._table) f s
  _  -> _const f s

_AceContent :: TraversalP CellContent String
_AceContent f s = case s of
  Search _ -> (_Search .. Sr._buffer) f s
  Query _ -> (_Query .. Qu._input) f s
  Markdown _ -> (_Markdown .. Ma._input) f s
  _ -> _const f s

_const :: forall a b. TraversalP a b
_const _ s = pure s

instance encodeJsonCellContent :: EncodeJson CellContent where
  encodeJson cc
    =  "type" := cellContentType cc
    ~> case cc of
      Search rec -> encodeJson rec
      Explore rec -> encodeJson rec
      Query rec -> encodeJson rec
      Markdown rec -> encodeJson rec
      Visualize rec -> encodeJson rec
      _ -> jsonEmptyObject

instance decodeJsonExploreRec :: DecodeJson CellContent where
  decodeJson json = do
    obj <- decodeJson json
    cellType <- obj .? "type"
    case cellType of
      "search" -> Search <$> decodeJson json
      "explore" -> Explore <$> decodeJson json
      "query" -> Query <$> decodeJson json
      "markdown" -> Markdown <$> decodeJson json
      "visualize" -> Visualize <$> decodeJson json
      _ -> Left $ "Unknown CellContent type: '" ++ cellType ++ "'"

data RunState = RunInitial
              | RunningSince Date
              | RunFinished Milliseconds

_RunInitial :: PrismP RunState Unit
_RunInitial = prism' (const RunInitial) $ \r -> case r of
  RunInitial -> Just unit
  _ -> Nothing

_RunningSince :: PrismP RunState Date
_RunningSince = prism' RunningSince $ \r -> case r of
  RunningSince d -> Just d
  _ -> Nothing

_RunFinished :: PrismP RunState Milliseconds
_RunFinished = prism' RunFinished $ \r -> case r of
  RunFinished m -> Just m
  _ -> Nothing

outFile :: Cell -> Resource
outFile cell = mkFile $ Left $ (cell ^._pathToNotebook) </> file ("out" <> show (cell ^._cellId))


Fix random seed generation

Fix random seed generation

module Test.QuickCheck.LCG
  ( Seed()
  , lcgM
  , lcgC
  , lcgN
  , lcgNext
  , randomSeed
  ) where

import Prelude

import Math ((%))
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Random (RANDOM(), randomInt)
import Data.Int (fromNumber, toNumber)
import Data.Int.Bits (shl, (.|.))
import Data.Array (replicate)
import Data.Foldable (product)
import qualified Data.Maybe.Unsafe as U

type Seed = Int

-- | The *multiplier*: a magic constant for the linear congruential generator
lcgM :: Int
lcgM = 48271

-- | The *increment*: a magic constant for the linear congruential generator
lcgC :: Int
lcgC = 0

-- | The *modulus*: a magic constant for the linear congruential generator
lcgN :: Int
lcgN = product (replicate 31 2) - 1

-- | Step the linear congruential generator
lcgNext :: Int -> Int
lcgNext n = U.fromJust $ fromNumber $ (toNumber lcgM * toNumber n + toNumber lcgC) % toNumber lcgN

-- | Create a random seed
randomSeed :: forall e. Eff (random :: RANDOM | e) Seed
randomSeed = randomInt 1 lcgM

module Test.QuickCheck.LCG
  ( Seed()
  , lcgM
  , lcgC
  , lcgN
  , lcgNext
  , randomSeed
  ) where

import Prelude

import Math ((%))
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Random (RANDOM(), randomInt)
import Data.Int (fromNumber, toNumber)
import Data.Int.Bits (shl, (.|.))
import Data.Array (replicate)
import Data.Foldable (product)
import qualified Data.Maybe.Unsafe as U

type Seed = Int

-- | The *multiplier*: a magic constant for the linear congruential generator
lcgM :: Int
lcgM = 48271

-- | The *increment*: a magic constant for the linear congruential generator
lcgC :: Int
lcgC = 0

-- | The *modulus*: a magic constant for the linear congruential generator
lcgN :: Int
lcgN = product (replicate 31 2) - 1

-- | Step the linear congruential generator
lcgNext :: Int -> Int
lcgNext n = U.fromJust $ fromNumber $ (toNumber lcgM * toNumber n + toNumber lcgC) % toNumber lcgN

-- | Create a random seed
randomSeed :: forall e. Eff (random :: RANDOM | e) Seed
randomSeed =
  -- Because the increment is 0, we must ensure that any seed is coprime to the
  -- modulus. Luckily, this is easy: the modulus has just one prime factor, 2,
  -- so this means our seed will be coprime to the modulus iff it is odd.
  -- We ensure oddness by perfoming a bitwise OR with 1.
  randomInt 0 lcgM <#> (.|. 1)