Improve layout

Improve layout

-- | Resolve ambiguities by combining the parsed usage section with any parsed
-- | Option sections, as well as some best effort guessing.
-- |
-- | ===
-- |
-- | Thoughts:
-- |    * It appears there is never a reason to fail hard. It would be nice if
-- |      we could produce warnings, however -> Write monad?

module Language.Docopt.Solver where

import Prelude
import Debug.Trace
import Data.Either (Either(..))
import Data.Maybe.Unsafe (fromJust)
import Data.Maybe (Maybe(..), isJust, maybe, maybe', isNothing)
import Data.List (List(..), filter, head, foldM, concat, (:), singleton
                , catMaybes, toList, last, init, length)
import Data.Traversable (traverse)
import Data.Tuple (Tuple(..), fst, snd)
import Data.Foldable (foldl)
import Control.MonadPlus (guard)
import Control.Plus (empty)
import Control.Alt ((<|>))
import Data.Monoid (mempty)
import Control.Monad.Error.Class (throwError)
import qualified Data.Array as A
import qualified Data.String as Str

import Language.Docopt.Errors
import Language.Docopt.Argument
import Language.Docopt.Usage
import Language.Docopt.Parser.Desc (Desc(..))
import Language.Docopt.Value (Value(..))
import qualified Language.Docopt.Option                as O
import qualified Language.Docopt.Parser.Desc           as Desc
import qualified Language.Docopt.Parser.Usage          as U
import qualified Language.Docopt.Parser.Usage.Argument as U
import qualified Language.Docopt.Parser.Usage.Option   as UO

data Result = Consumed (List Argument) | Unconsumed (List Argument)

solveBranch :: U.Branch -> List Desc -> Either SolveError Branch
solveBranch as ds = Branch <$> f as
  where f :: U.Branch -> Either SolveError (List Argument)
        f Nil = return Nil
        f (Cons x Nil) = do
          m <- solveArgs x Nothing
          return $ case m of
            Unconsumed zs -> zs
            Consumed   zs -> zs
        f (Cons x (Cons y xs)) = do
          m <- solveArgs x (Just y)
          case m of
            Unconsumed zs -> (zs ++) <$> f (y:xs)
            Consumed   zs -> (zs ++) <$> f xs

        -- | Solve two adjacent arguments.
        -- | Should the first argument be an option with an argument that
        -- | matches an adjacent command or positional, consume the adjacent
        -- | argument from the input (consume).
        solveArgs :: U.Argument
                  -> Maybe U.Argument
                  -> Either SolveError Result

        solveArgs (U.EOA) _
          = Unconsumed <<< singleton <$> return (EOA)

        solveArgs (U.Command s) _
          = Unconsumed <<< singleton <$> return (Command s)

        solveArgs (U.Positional s r) _
          = Unconsumed <<< singleton <$> return (Positional s r)

        solveArgs (U.Group o bs r) _
          = Unconsumed <<< singleton <$> do
            flip (Group o) r <$> do
              flip solveBranch ds `traverse` bs

        solveArgs (U.Option (UO.LOpt o)) y = do

          -- XXX: Is `head` the right thing to do here? What if there are more
          -- matches? That would indicate ambigiutiy and needs to be treated,
          -- possibly with an error?
          let opt = flip maybe' id
                      (\_ -> lopt' o.name
                                   (toArg o.arg)
                                   (o.repeatable))
                      (head $ catMaybes $ convert <$> ds)

          case opt of
            -- XXX: Non-exhaustive on purpose. How to improve?
            (Option (O.Option o')) ->
              if (argMatches o.arg o'.arg)
                then return unit
                else throwError $ DescriptionError $ ArgumentMismatchError {
                        option: {
                          flag: o'.flag
                        , name: o'.name
                        , arg:  o.arg
                        }
                      , description: {
                          arg: o'.arg <#> \(O.Argument an _) -> an
                        }
                      }

          -- Look ahead if any of the following arguments should be consumed.
          -- Return either `Nothing` to signify that nothing should be consumed
          -- or a value signifieng that it should be consumed, and the
          -- `isRepeated` should be inherited.
          let adjArg = if o.repeatable
                then Nothing
                else
                  case y of
                    Just (U.Positional n r) ->
                      case opt of
                        (Option (O.Option { arg: Just (O.Argument n' _) }))
                          | n == n' -> Just r
                        _ -> Nothing
                    Just (U.Command n) ->
                      case opt of
                        (Option (O.Option { arg: Just (O.Argument n' _) }))
                          | n == n' -> Just false
                        _ -> Nothing
                    _ -> Nothing

          -- Apply adjacent argument
          return $ maybe'
            (\_ -> Unconsumed $ singleton opt)
            (\r -> case opt of
              -- XXX: non-exhaustive, because doesn't need to be...
              (Option (O.Option o)) -> do
                Consumed $ singleton $ Option (O.Option o { repeatable = r })
            )
            adjArg

          where
            convert :: Desc -> Maybe Argument
            convert (Desc.OptionDesc (Desc.Option {
                      name=Desc.Long n'
                    , arg=a'
                    }))
              | Str.toUpper n' == Str.toUpper o.name
              = return $ lopt' o.name
                               (resolveOptArg o.arg a')
                               (o.repeatable)
            convert (Desc.OptionDesc (Desc.Option {
                      name=Desc.Full f n'
                    , arg=a'
                    }))
              | Str.toUpper n' == Str.toUpper o.name
              = return $ opt' (Just f)
                              (Just o.name)
                              (resolveOptArg o.arg a')
                              (o.repeatable)
            convert _ = Nothing

        solveArgs (U.OptionStack (UO.SOpt o)) y = do

          -- Figure out trailing flag, in order to couple it with an adjacent
          -- option where needed.
          let fs' = toList o.stack
              x   = case last fs' of
                      Just f' -> Tuple (o.flag:(fromJust $ init fs')) f'
                      Nothing -> Tuple Nil o.flag
              fs'' = fst x
              f''  = snd x

          xs <- match false `traverse` fs''
          x  <- match true f''

          case x of
            -- XXX: Non-exhaustive on purpose. How to improve?
            (Option (O.Option o')) ->
              if (argMatches o.arg o'.arg)
                then return unit
                else throwError $ DescriptionError $ ArgumentMismatchError {
                        option: {
                          flag: o'.flag
                        , name: o'.name
                        , arg:  o.arg
                        }
                      , description: {
                          arg: o'.arg <#> \(O.Argument an _) -> an
                        }
                      }

          -- Look ahead if any of the following arguments should be consumed.
          -- Return either `Nothing` to signify that nothing should be consumed
          -- or a value signifieng that it should be consumed, and the
          -- `isRepeated` should be inherited.
          let adjArg = if (isRepeatable x)
                then Nothing
                else
                  case y of
                    Just (U.Positional n r) ->
                      case x of
                        (Option (O.Option { arg: Just (O.Argument n' _) } ))
                          | Str.toUpper n == Str.toUpper n' -> Just r
                        _ -> Nothing
                    Just (U.Command n) ->
                      case x of
                        (Option (O.Option { arg: Just (O.Argument n' _) } ))
                          | Str.toUpper n == Str.toUpper n' -> Just false
                        _ -> Nothing
                    _ -> Nothing

          -- Apply adjacent argument
          return $ maybe'
            (\_ -> Unconsumed $ xs ++ singleton x)
            (\r -> case x of
              -- XXX: Non-exhaustive on purpose. How to improve?
              (Option (O.Option o')) -> do
                Consumed $ xs ++ (singleton $ Option $ O.Option o' {
                                                        repeatable = r
                                                       })
            )
            adjArg

          where
            match :: Boolean -> Char -> Either SolveError Argument
            match isTrailing f = do
              return $ flip maybe' id
                        (\_ -> sopt' f
                                     (toArg o.arg)
                                     o.repeatable)
                        (head $ catMaybes $ convert f isTrailing <$> ds)

            convert :: Char -> Boolean -> Desc -> Maybe Argument
            convert f isTrailing (Desc.OptionDesc (Desc.Option {
                                  name=Desc.Flag f'
                                , arg=a'
                                }))
              | (f == f')
                && (isTrailing || isNothing a')
              = return $ sopt' f
                               (resolveOptArg o.arg a')
                               o.repeatable
            convert f isTrailing (Desc.OptionDesc (Desc.Option {
                                  name=Desc.Full f' n
                                , arg=a'
                                }))
              | (f == f')
                && (isTrailing || isNothing a')
              = return $ opt' (Just f)
                              (Just n)
                              (resolveOptArg o.arg a')
                              o.repeatable
            convert _ _ _ = Nothing

        -- | Resolve an option's argument name against that given in the
        -- | description, returning the most complete argument known.
        resolveOptArg :: Maybe String
                      -> Maybe Desc.Argument
                      -> Maybe O.Argument
        resolveOptArg (Just n) Nothing = return $ O.Argument n Nothing
        resolveOptArg Nothing (Just (Desc.Argument a))
          = do
          -- XXX: The conversion to `StringValue` should not be needed,
          -- `Desc.Argument` should be of type `Maybe Value`.
          return $ O.Argument a.name (StringValue <$> a.default)
        resolveOptArg (Just an) (Just (Desc.Argument a))
          = do
          -- XXX: Do we need to guard that `an == a.name` here?
          -- XXX: The conversion to `StringValue` should not be needed,
          -- `Desc.Argument` should be of type `Maybe Value`.
          return $ O.Argument a.name (StringValue <$> a.default)
        resolveOptArg _ _ = Nothing

        toArg:: Maybe String -> Maybe O.Argument
        toArg a = a >>= \an -> return $ O.Argument an Nothing

        argMatches :: Maybe String
                   -> Maybe O.Argument
                   -> Boolean
        argMatches a a'
          =  (isNothing a)
          || (isNothing a && isNothing a')
          || (maybe false id do
              a' >>= \(O.Argument an' _) -> do
                an <- a
                return (Str.toUpper an == Str.toUpper an')
            )

solveUsage :: U.Usage -> List Desc -> Either SolveError Usage
solveUsage (U.Usage _ bs) ds = Usage <$> do
  traverse (flip solveBranch ds) bs

solve :: (List U.Usage)
      -> (List Desc)
      -> Either SolveError (List Usage)
solve us ds = traverse (flip solveUsage ds) us

-- | Resolve ambiguities by combining the parsed usage section with any parsed
-- | Option sections, as well as some best effort guessing.
-- |
-- | ===
-- |
-- | Thoughts:
-- |    * It appears there is never a reason to fail hard. It would be nice if
-- |      we could produce warnings, however -> Write monad?

module Language.Docopt.Solver where

import Prelude
import Debug.Trace
import Data.Either (Either(..))
import Data.Maybe.Unsafe (fromJust)
import Data.Maybe (Maybe(..), isJust, maybe, maybe', isNothing)
import Data.List (List(..), filter, head, foldM, concat, (:), singleton
                , catMaybes, toList, last, init, length)
import Data.Traversable (traverse)
import Data.Tuple (Tuple(..), fst, snd)
import Data.Foldable (foldl)
import Control.MonadPlus (guard)
import Control.Plus (empty)
import Control.Alt ((<|>))
import Data.Monoid (mempty)
import Control.Monad.Error.Class (throwError)
import qualified Data.Array as A
import qualified Data.String as Str

import Language.Docopt.Errors
import Language.Docopt.Argument
import Language.Docopt.Usage
import Language.Docopt.Parser.Desc (Desc(..))
import Language.Docopt.Value (Value(..))
import qualified Language.Docopt.Option                as O
import qualified Language.Docopt.Parser.Desc           as Desc
import qualified Language.Docopt.Parser.Usage          as U
import qualified Language.Docopt.Parser.Usage.Argument as U
import qualified Language.Docopt.Parser.Usage.Option   as UO

data Result = Consumed (List Argument) | Unconsumed (List Argument)

solveBranch :: U.Branch -> List Desc -> Either SolveError Branch
solveBranch as ds = Branch <$> f as
  where f :: U.Branch -> Either SolveError (List Argument)
        f Nil = return Nil
        f (Cons x Nil) = do
          m <- solveArgs x Nothing
          return $ case m of
            Unconsumed zs -> zs
            Consumed   zs -> zs
        f (Cons x (Cons y xs)) = do
          m <- solveArgs x (Just y)
          case m of
            Unconsumed zs -> (zs ++) <$> f (y:xs)
            Consumed   zs -> (zs ++) <$> f xs

        -- | Solve two adjacent arguments.
        -- | Should the first argument be an option with an argument that
        -- | matches an adjacent command or positional, consume the adjacent
        -- | argument from the input (consume).
        solveArgs :: U.Argument
                  -> Maybe U.Argument
                  -> Either SolveError Result

        solveArgs (U.EOA) _
          = Unconsumed <<< singleton <$> return (EOA)

        solveArgs (U.Command s) _
          = Unconsumed <<< singleton <$> return (Command s)

        solveArgs (U.Positional s r) _
          = Unconsumed <<< singleton <$> return (Positional s r)

        solveArgs (U.Group o bs r) _
          = Unconsumed <<< singleton <$> do
            flip (Group o) r <$> do
              flip solveBranch ds `traverse` bs

        solveArgs (U.Option (UO.LOpt o)) y = do

          -- XXX: Is `head` the right thing to do here? What if there are more
          -- matches? That would indicate ambigiutiy and needs to be treated,
          -- possibly with an error?
          let opt = flip maybe' id
                      (\_ -> lopt' o.name
                                   (toArg o.arg)
                                   (o.repeatable))
                      (head $ catMaybes $ convert <$> ds)

          case opt of
            -- XXX: Non-exhaustive on purpose. How to improve?
            (Option (O.Option o')) ->
              if (argMatches o.arg o'.arg)
                then return unit
                else throwError $ DescriptionError $ ArgumentMismatchError {
                        option: {
                          flag: o'.flag
                        , name: o'.name
                        , arg:  o.arg
                        }
                      , description: {
                          arg: o'.arg <#> \(O.Argument an _) -> an
                        }
                      }

          -- Look ahead if any of the following arguments should be consumed.
          -- Return either `Nothing` to signify that nothing should be consumed
          -- or a value signifieng that it should be consumed, and the
          -- `isRepeated` should be inherited.
          let adjArg = if o.repeatable
                then Nothing
                else
                  case y of
                    Just (U.Positional n r) ->
                      case opt of
                        (Option (O.Option { arg: Just (O.Argument n' _) }))
                          | n == n' -> Just r
                        _ -> Nothing
                    Just (U.Command n) ->
                      case opt of
                        (Option (O.Option { arg: Just (O.Argument n' _) }))
                          | n == n' -> Just false
                        _ -> Nothing
                    _ -> Nothing

          -- Apply adjacent argument
          return $ maybe'
            (\_ -> Unconsumed $ singleton opt)
            (\r -> case opt of
              -- XXX: non-exhaustive, because doesn't need to be...
              (Option (O.Option o)) -> do
                Consumed $ singleton $ Option (O.Option o { repeatable = r })
            )
            adjArg

          where
            convert :: Desc -> Maybe Argument
            convert (Desc.OptionDesc (Desc.Option { name=Desc.Long n', arg=a' }))
              | Str.toUpper n' == Str.toUpper o.name
              = return $ lopt' o.name
                               (resolveOptArg o.arg a')
                               (o.repeatable)
            convert (Desc.OptionDesc (Desc.Option { name=Desc.Full f n', arg=a' }))
              | Str.toUpper n' == Str.toUpper o.name
              = return $ opt' (Just f)
                              (Just o.name)
                              (resolveOptArg o.arg a')
                              (o.repeatable)
            convert _ = Nothing

        solveArgs (U.OptionStack (UO.SOpt o)) y = do

          -- Figure out trailing flag, in order to couple it with an adjacent
          -- option where needed.
          let fs' = toList o.stack
              x   = case last fs' of
                      Just f' -> Tuple (o.flag:(fromJust $ init fs')) f'
                      Nothing -> Tuple Nil o.flag
              fs'' = fst x
              f''  = snd x

          xs <- match false `traverse` fs''
          x  <- match true f''

          case x of
            -- XXX: Non-exhaustive on purpose. How to improve?
            (Option (O.Option o')) ->
              if (argMatches o.arg o'.arg)
                then return unit
                else throwError $ DescriptionError $ ArgumentMismatchError {
                        option: {
                          flag: o'.flag
                        , name: o'.name
                        , arg:  o.arg
                        }
                      , description: {
                          arg: o'.arg <#> \(O.Argument an _) -> an
                        }
                      }

          -- Look ahead if any of the following arguments should be consumed.
          -- Return either `Nothing` to signify that nothing should be consumed
          -- or a value signifieng that it should be consumed, and the
          -- `isRepeated` should be inherited.
          let adjArg = if (isRepeatable x)
                then Nothing
                else
                  case y of
                    Just (U.Positional n r) ->
                      case x of
                        (Option (O.Option { arg: Just (O.Argument n' _) } ))
                          | Str.toUpper n == Str.toUpper n' -> Just r
                        _ -> Nothing
                    Just (U.Command n) ->
                      case x of
                        (Option (O.Option { arg: Just (O.Argument n' _) } ))
                          | Str.toUpper n == Str.toUpper n' -> Just false
                        _ -> Nothing
                    _ -> Nothing

          -- Apply adjacent argument
          return $ maybe'
            (\_ -> Unconsumed $ xs ++ singleton x)
            (\r -> case x of
              -- XXX: Non-exhaustive on purpose. How to improve?
              (Option (O.Option o')) -> do
                Consumed $ xs ++ (singleton $ Option $ O.Option o' {
                                                        repeatable = r
                                                       })
            )
            adjArg

          where
            match :: Boolean -> Char -> Either SolveError Argument
            match isTrailing f = do
              return $ flip maybe' id
                        (\_ -> sopt' f
                                     (toArg o.arg)
                                     o.repeatable)
                        (head $ catMaybes $ convert f isTrailing <$> ds)

            convert :: Char -> Boolean -> Desc -> Maybe Argument
            convert f isTrailing (Desc.OptionDesc (Desc.Option { name=Desc.Flag f', arg=a' }))
              | (f == f')
                && (isTrailing || isNothing a')
              = return $ sopt' f
                               (resolveOptArg o.arg a')
                               o.repeatable
            convert f isTrailing (Desc.OptionDesc (Desc.Option { name=Desc.Full f' n, arg=a' }))
              | (f == f')
                && (isTrailing || isNothing a')
              = return $ opt' (Just f)
                              (Just n)
                              (resolveOptArg o.arg a')
                              o.repeatable
            convert _ _ _ = Nothing

        -- | Resolve an option's argument name against that given in the
        -- | description, returning the most complete argument known.
        resolveOptArg :: Maybe String
                      -> Maybe Desc.Argument
                      -> Maybe O.Argument
        resolveOptArg (Just n) Nothing = return $ O.Argument n Nothing
        resolveOptArg Nothing (Just (Desc.Argument a))
          = do
          -- XXX: The conversion to `StringValue` should not be needed,
          -- `Desc.Argument` should be of type `Maybe Value`.
          return $ O.Argument a.name (StringValue <$> a.default)
        resolveOptArg (Just an) (Just (Desc.Argument a))
          = do
          -- XXX: Do we need to guard that `an == a.name` here?
          -- XXX: The conversion to `StringValue` should not be needed,
          -- `Desc.Argument` should be of type `Maybe Value`.
          return $ O.Argument a.name (StringValue <$> a.default)
        resolveOptArg _ _ = Nothing

        toArg:: Maybe String -> Maybe O.Argument
        toArg a = a >>= \an -> return $ O.Argument an Nothing

        argMatches :: Maybe String
                   -> Maybe O.Argument
                   -> Boolean
        argMatches a a'
          =  (isNothing a)
          || (isNothing a && isNothing a')
          || (maybe false id do
              a' >>= \(O.Argument an' _) -> do
                an <- a
                return (Str.toUpper an == Str.toUpper an')
            )

solveUsage :: U.Usage -> List Desc -> Either SolveError Usage
solveUsage (U.Usage _ bs) ds = Usage <$> do
  traverse (flip solveBranch ds) bs

solve :: (List U.Usage)
      -> (List Desc)
      -> Either SolveError (List Usage)
solve us ds = traverse (flip solveUsage ds) us


Added known issue to FT

Added known issue to FT

{-
Copyright 2015 SlamData, Inc.

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-}

module Test.SlamData.Feature.Test.FlexibleVisualation where

import SlamData.Prelude

import Data.String as Str
import Data.StrMap as SM

import Test.Feature.Log (successMsg)
import Test.Feature.Scenario (scenario)
import Test.SlamData.Feature.Expectations as Expect
import Test.SlamData.Feature.Interactions as Interact
import Test.SlamData.Feature.Monad (SlamFeature)

import Selenium.Monad (script, tryRepeatedlyTo)

variablesChartScenario ∷ String → Array String → SlamFeature Unit → SlamFeature Unit
variablesChartScenario =
  scenario
    "Flexible Visualization"
    (Interact.createWorkspaceInTestFolder "Flexible Visualization")
    (Interact.deleteFileInTestFolder "Flexible Visualization.slam")

test ∷ SlamFeature Unit
test =
  variablesChartScenario "Make embeddable patients-city charts" ["https://github.com/slamdata/slamdata/issues/1197"] do
    tryRepeatedlyTo $ script """
      var run = function() {
        var __init = echarts.init;
        echarts.init = function (el) {
          var chart = __init.call(echarts, el);
          chart.setOption = function (options) {
            delete options.grid;
            el.innerHTML = "<pre>" + JSON.stringify(options) + "</pre>";
          };
          return chart;
        };
      };
      run();
    """
    Interact.insertVariablesCardInLastDeck
    successMsg "Inserted Variables Card"
    Interact.provideApiVariableBindingsForVariablesCard "state" "Text" "CO"
    successMsg "Provided variables; Will access next card"
    Interact.accessNextCardInLastDeck
    successMsg "Accessed next card, will insert Troubleshoot card"
    Interact.insertTroubleshootCardInLastDeck
    Expect.troubleshootCardPresented
    successMsg "Presented Troubleshoot card, will access next card"
    Interact.accessNextCardInLastDeck
    successMsg "Will insert query card"
    Interact.insertQueryCardInLastDeck
    Interact.provideQueryInLastQueryCard $ Str.joinWith " "
      $ [ "SELECT count(*) as ct, city, gender"
        , "FROM `/test-mount/testDb/patients`"
        , "WHERE state = :state"
        , "GROUP BY city, gender"
        , "ORDER BY ct DESC"
        , "LIMIT 30"
        ]
    Interact.runQuery
    Interact.accessNextCardInLastDeck
    Interact.selectBuildChart
    Interact.insertBuildBarChartCard
    Expect.categoryEnabledInLastBuildChartCard
    successMsg "Ok, category field is enabled"
    Interact.activateCategoryForChartBuilder
    Interact.selectInChartBuilder [".city"]
    Expect.measureInLastChartCard ".ct"
    Interact.accessNextCardInLastDeck
    successMsg "Will insert chart options card"
    Interact.insertChartCardInLastDeck

    Expect.lastEChart chart_CO
    Interact.accessPreviousCardInLastDeck
    Interact.activateStackForChartBuilder
    Interact.selectInChartBuilder [".gender"]

    Interact.accessNextCardInLastDeck

    Expect.lastEChart chart_CO_gender

    Interact.setVarMapForCurrentDeck $ SM.singleton "state" "\"NE\""

    Expect.lastEChart chart_NE_gender
    Interact.accessWorkspaceWithModifiedURL $ Str.replace "NE" "CO"

    Expect.lastEChart chart_CO_gender

    successMsg "Successfully created flexible patient chart"

chart_CO ∷ String
chart_CO =
  """{"series":[{"stack":"default stack","data":[{"value":["ANTONITO",1],"name":"ANTONITO"},{"value":["ARVADA",1],"name":"ARVADA"},{"value":["DEL NORTE",1],"name":"DEL NORTE"},{"value":["DENVER",1],"name":"DENVER"},{"value":["HENDERSON",1],"name":"HENDERSON"},{"value":["JOHNSTOWN",1],"name":"JOHNSTOWN"},{"value":["KIOWA",1],"name":"KIOWA"},{"value":["LITTLETON",2],"name":"LITTLETON"},{"value":["LONGMONT",1],"name":"LONGMONT"},{"value":["MANZANOLA",1],"name":"MANZANOLA"},{"value":["PITKIN",1],"name":"PITKIN"},{"value":["ROCKVALE",1],"name":"ROCKVALE"},{"value":["SILVERTHORNE",1],"name":"SILVERTHORNE"},{"value":["VERNON",1],"name":"VERNON"},{"value":["WALSH",1],"name":"WALSH"}],"type":"bar"}],"legend":{"top":"bottom","left":"left","data":[],"textStyle":{"fontFamily":"Ubuntu, sans"}},"yAxis":{"splitLine":{"lineStyle":{"width":1}},"axisLine":{"lineStyle":{"width":1}},"axisLabel":{"textStyle":{"fontFamily":"Ubuntu, sans"}},"type":"value"},"xAxis":{"axisLabel":{"textStyle":{"fontFamily":"Ubuntu, sans"},"rotate":0},"data":["ANTONITO","ARVADA","DEL NORTE","DENVER","HENDERSON","JOHNSTOWN","KIOWA","LITTLETON","LONGMONT","MANZANOLA","PITKIN","ROCKVALE","SILVERTHORNE","VERNON","WALSH"],"interval":0,"type":"category"},"color":["#93a9a6","#cda71f","#eb6f76","#66b35b","#bd97e2","#5b5925","#884a6f","#51b3f6","#cca067","#398465","#3c607a","#81463c","#b65f33","#9aae31","#ce8b9e","#6c6356","#95a779","#44aecb","#e987c2","#8a7ea0","#3d6c2f","#40b994","#87984a","#c1a088","#9b6e2d","#428c8d","#b8766a","#eb8666","#df883e","#bb6273","#c994bf","#929de0","#7ba5cb","#ae9093","#66557b","#936370","#3c6d64","#84693f","#c19744","#e77aa1","#5d555f","#4078a2","#3fafaf","#698b99","#486a4c","#7ea48b","#b57e57","#8c72aa","#609050","#56b379","#489f8b","#714d4a","#9a8867","#93b66b","#7da93f","#877424","#c75d56","#b774ac","#7b7a3e","#73581c","#398ea3","#964734","#df8d89","#af97cc","#96951f","#a37791","#7c4d2e","#78865f","#216b74","#935524","#6fafb6","#75ab76","#a48b50","#d28dd0","#be9aaf","#ad8d22","#d89576","#964860","#9b9a61","#4daadb","#a9628d","#98943b","#486366","#6d7e2b","#cf9a2f","#827a8b","#876a69","#495f23","#677f45","#805845","#a2544d","#8c5157","#6b6c9e","#236443","#919b82","#cc8e55","#3e8555","#a08a7a","#767870","#6d9643","#87658f","#3bb069","#6a5d42","#586249","#1f7769","#6daf8e","#8fa7be","#b7a82c","#a09da0","#7d8aa6","#78a3e0","#719186","#765771","#a37ea7","#8e8cbc","#a76840","#49934b","#a27c62","#3da27b","#a9ac53","#6685b4","#5f728a","#cb6b4a","#9f8dd3","#b7a66e","#a998b3","#85a362","#595146"],"tooltip":{"trigger":"axis"}}"""

chart_CO_gender ∷ String
chart_CO_gender =
  """{"series":[{"name":"female","stack":"default stack","data":[{"value":["ANTONITO",1],"name":"ANTONITO"},null,{"value":["DEL NORTE",1],"name":"DEL NORTE"},null,{"value":["HENDERSON",1],"name":"HENDERSON"},{"value":["JOHNSTOWN",1],"name":"JOHNSTOWN"},null,{"value":["LITTLETON",1],"name":"LITTLETON"},{"value":["LONGMONT",1],"name":"LONGMONT"},{"value":["MANZANOLA",1],"name":"MANZANOLA"},null,null,null,null,{"value":["WALSH",1],"name":"WALSH"}],"type":"bar"},{"name":"male","stack":"default stack","data":[null,{"value":["ARVADA",1],"name":"ARVADA"},null,{"value":["DENVER",1],"name":"DENVER"},null,null,{"value":["KIOWA",1],"name":"KIOWA"},{"value":["LITTLETON",1],"name":"LITTLETON"},null,null,{"value":["PITKIN",1],"name":"PITKIN"},{"value":["ROCKVALE",1],"name":"ROCKVALE"},{"value":["SILVERTHORNE",1],"name":"SILVERTHORNE"},{"value":["VERNON",1],"name":"VERNON"},null],"type":"bar"}],"legend":{"top":"bottom","left":"left","data":["female","male"],"textStyle":{"fontFamily":"Ubuntu, sans"}},"yAxis":{"splitLine":{"lineStyle":{"width":1}},"axisLine":{"lineStyle":{"width":1}},"axisLabel":{"textStyle":{"fontFamily":"Ubuntu, sans"}},"type":"value"},"xAxis":{"axisLabel":{"textStyle":{"fontFamily":"Ubuntu, sans"},"rotate":0},"data":["ANTONITO","ARVADA","DEL NORTE","DENVER","HENDERSON","JOHNSTOWN","KIOWA","LITTLETON","LONGMONT","MANZANOLA","PITKIN","ROCKVALE","SILVERTHORNE","VERNON","WALSH"],"interval":0,"type":"category"},"color":["#93a9a6","#cda71f","#eb6f76","#66b35b","#bd97e2","#5b5925","#884a6f","#51b3f6","#cca067","#398465","#3c607a","#81463c","#b65f33","#9aae31","#ce8b9e","#6c6356","#95a779","#44aecb","#e987c2","#8a7ea0","#3d6c2f","#40b994","#87984a","#c1a088","#9b6e2d","#428c8d","#b8766a","#eb8666","#df883e","#bb6273","#c994bf","#929de0","#7ba5cb","#ae9093","#66557b","#936370","#3c6d64","#84693f","#c19744","#e77aa1","#5d555f","#4078a2","#3fafaf","#698b99","#486a4c","#7ea48b","#b57e57","#8c72aa","#609050","#56b379","#489f8b","#714d4a","#9a8867","#93b66b","#7da93f","#877424","#c75d56","#b774ac","#7b7a3e","#73581c","#398ea3","#964734","#df8d89","#af97cc","#96951f","#a37791","#7c4d2e","#78865f","#216b74","#935524","#6fafb6","#75ab76","#a48b50","#d28dd0","#be9aaf","#ad8d22","#d89576","#964860","#9b9a61","#4daadb","#a9628d","#98943b","#486366","#6d7e2b","#cf9a2f","#827a8b","#876a69","#495f23","#677f45","#805845","#a2544d","#8c5157","#6b6c9e","#236443","#919b82","#cc8e55","#3e8555","#a08a7a","#767870","#6d9643","#87658f","#3bb069","#6a5d42","#586249","#1f7769","#6daf8e","#8fa7be","#b7a82c","#a09da0","#7d8aa6","#78a3e0","#719186","#765771","#a37ea7","#8e8cbc","#a76840","#49934b","#a27c62","#3da27b","#a9ac53","#6685b4","#5f728a","#cb6b4a","#9f8dd3","#b7a66e","#a998b3","#85a362","#595146"],"tooltip":{"trigger":"axis"}}"""

chart_NE_gender ∷ String
chart_NE_gender =
  """{"series":[{"name":"female","stack":"default stack","data":[{"value":["BEE",1],"name":"BEE"},{"value":["BLAIR",1],"name":"BLAIR"},null,null,null,null,{"value":["OMAHA",2],"name":"OMAHA"},null,null,{"value":["PIERCE",1],"name":"PIERCE"},null,null,{"value":["WOOD LAKE",1],"name":"WOOD LAKE"},{"value":["WYNOT",1],"name":"WYNOT"}],"type":"bar"},{"name":"male","stack":"default stack","data":[{"value":["BEE",1],"name":"BEE"},null,{"value":["CAIRO",1],"name":"CAIRO"},{"value":["CRAIG",1],"name":"CRAIG"},{"value":["GOTHENBURG",1],"name":"GOTHENBURG"},{"value":["LINCOLN",1],"name":"LINCOLN"},{"value":["OMAHA",2],"name":"OMAHA"},{"value":["ORD",1],"name":"ORD"},{"value":["OSHKOSH",1],"name":"OSHKOSH"},{"value":["PIERCE",1],"name":"PIERCE"},{"value":["SAINT EDWARD",1],"name":"SAINT EDWARD"},{"value":["WILLOW ISLAND",1],"name":"WILLOW ISLAND"},null,null],"type":"bar"}],"legend":{"top":"bottom","left":"left","data":["female","male"],"textStyle":{"fontFamily":"Ubuntu, sans"}},"yAxis":{"splitLine":{"lineStyle":{"width":1}},"axisLine":{"lineStyle":{"width":1}},"axisLabel":{"textStyle":{"fontFamily":"Ubuntu, sans"}},"type":"value"},"xAxis":{"axisLabel":{"textStyle":{"fontFamily":"Ubuntu, sans"},"rotate":0},"data":["BEE","BLAIR","CAIRO","CRAIG","GOTHENBURG","LINCOLN","OMAHA","ORD","OSHKOSH","PIERCE","SAINT EDWARD","WILLOW ISLAND","WOOD LAKE","WYNOT"],"interval":0,"type":"category"},"color":["#93a9a6","#cda71f","#eb6f76","#66b35b","#bd97e2","#5b5925","#884a6f","#51b3f6","#cca067","#398465","#3c607a","#81463c","#b65f33","#9aae31","#ce8b9e","#6c6356","#95a779","#44aecb","#e987c2","#8a7ea0","#3d6c2f","#40b994","#87984a","#c1a088","#9b6e2d","#428c8d","#b8766a","#eb8666","#df883e","#bb6273","#c994bf","#929de0","#7ba5cb","#ae9093","#66557b","#936370","#3c6d64","#84693f","#c19744","#e77aa1","#5d555f","#4078a2","#3fafaf","#698b99","#486a4c","#7ea48b","#b57e57","#8c72aa","#609050","#56b379","#489f8b","#714d4a","#9a8867","#93b66b","#7da93f","#877424","#c75d56","#b774ac","#7b7a3e","#73581c","#398ea3","#964734","#df8d89","#af97cc","#96951f","#a37791","#7c4d2e","#78865f","#216b74","#935524","#6fafb6","#75ab76","#a48b50","#d28dd0","#be9aaf","#ad8d22","#d89576","#964860","#9b9a61","#4daadb","#a9628d","#98943b","#486366","#6d7e2b","#cf9a2f","#827a8b","#876a69","#495f23","#677f45","#805845","#a2544d","#8c5157","#6b6c9e","#236443","#919b82","#cc8e55","#3e8555","#a08a7a","#767870","#6d9643","#87658f","#3bb069","#6a5d42","#586249","#1f7769","#6daf8e","#8fa7be","#b7a82c","#a09da0","#7d8aa6","#78a3e0","#719186","#765771","#a37ea7","#8e8cbc","#a76840","#49934b","#a27c62","#3da27b","#a9ac53","#6685b4","#5f728a","#cb6b4a","#9f8dd3","#b7a66e","#a998b3","#85a362","#595146"],"tooltip":{"trigger":"axis"}}"""

{-
Copyright 2015 SlamData, Inc.

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-}

module Test.SlamData.Feature.Test.FlexibleVisualation where

import SlamData.Prelude

import Data.String as Str
import Data.StrMap as SM

import Test.Feature.Log (successMsg)
import Test.Feature.Scenario (scenario)
import Test.SlamData.Feature.Expectations as Expect
import Test.SlamData.Feature.Interactions as Interact
import Test.SlamData.Feature.Monad (SlamFeature)

import Selenium.Monad (script, tryRepeatedlyTo)

variablesChartScenario ∷ String → Array String → SlamFeature Unit → SlamFeature Unit
variablesChartScenario =
  scenario
    "Flexible Visualization"
    (Interact.createWorkspaceInTestFolder "Flexible Visualization")
    (Interact.deleteFileInTestFolder "Flexible Visualization.slam")

test ∷ SlamFeature Unit
test =
  variablesChartScenario "Make embeddable patients-city charts" [] do
    tryRepeatedlyTo $ script """
      var run = function() {
        var __init = echarts.init;
        echarts.init = function (el) {
          var chart = __init.call(echarts, el);
          chart.setOption = function (options) {
            delete options.grid;
            el.innerHTML = "<pre>" + JSON.stringify(options) + "</pre>";
          };
          return chart;
        };
      };
      run();
    """
    Interact.insertVariablesCardInLastDeck
    successMsg "Inserted Variables Card"
    Interact.provideApiVariableBindingsForVariablesCard "state" "Text" "CO"
    successMsg "Provided variables; Will access next card"
    Interact.accessNextCardInLastDeck
    successMsg "Accessed next card, will insert Troubleshoot card"
    Interact.insertTroubleshootCardInLastDeck
    Expect.troubleshootCardPresented
    successMsg "Presented Troubleshoot card, will access next card"
    Interact.accessNextCardInLastDeck
    successMsg "Will insert query card"
    Interact.insertQueryCardInLastDeck
    Interact.provideQueryInLastQueryCard $ Str.joinWith " "
      $ [ "SELECT count(*) as ct, city, gender"
        , "FROM `/test-mount/testDb/patients`"
        , "WHERE state = :state"
        , "GROUP BY city, gender"
        , "ORDER BY ct DESC"
        , "LIMIT 30"
        ]
    Interact.runQuery
    Interact.accessNextCardInLastDeck
    Interact.selectBuildChart
    Interact.insertBuildBarChartCard
    Expect.categoryEnabledInLastBuildChartCard
    successMsg "Ok, category field is enabled"
    Interact.activateCategoryForChartBuilder
    Interact.selectInChartBuilder [".city"]
    Expect.measureInLastChartCard ".ct"
    Interact.accessNextCardInLastDeck
    successMsg "Will insert chart options card"
    Interact.insertChartCardInLastDeck

    Expect.lastEChart chart_CO
    Interact.accessPreviousCardInLastDeck
    Interact.activateStackForChartBuilder
    Interact.selectInChartBuilder [".gender"]

    Interact.accessNextCardInLastDeck

    Expect.lastEChart chart_CO_gender

    Interact.setVarMapForCurrentDeck $ SM.singleton "state" "\"NE\""

    Expect.lastEChart chart_NE_gender
    Interact.accessWorkspaceWithModifiedURL $ Str.replace "NE" "CO"

    Expect.lastEChart chart_CO_gender

    successMsg "Successfully created flexible patient chart"

chart_CO ∷ String
chart_CO =
  """{"series":[{"stack":"default stack","data":[{"value":["ANTONITO",1],"name":"ANTONITO"},{"value":["ARVADA",1],"name":"ARVADA"},{"value":["DEL NORTE",1],"name":"DEL NORTE"},{"value":["DENVER",1],"name":"DENVER"},{"value":["HENDERSON",1],"name":"HENDERSON"},{"value":["JOHNSTOWN",1],"name":"JOHNSTOWN"},{"value":["KIOWA",1],"name":"KIOWA"},{"value":["LITTLETON",2],"name":"LITTLETON"},{"value":["LONGMONT",1],"name":"LONGMONT"},{"value":["MANZANOLA",1],"name":"MANZANOLA"},{"value":["PITKIN",1],"name":"PITKIN"},{"value":["ROCKVALE",1],"name":"ROCKVALE"},{"value":["SILVERTHORNE",1],"name":"SILVERTHORNE"},{"value":["VERNON",1],"name":"VERNON"},{"value":["WALSH",1],"name":"WALSH"}],"type":"bar"}],"legend":{"top":"bottom","left":"left","data":[],"textStyle":{"fontFamily":"Ubuntu, sans"}},"yAxis":{"splitLine":{"lineStyle":{"width":1}},"axisLine":{"lineStyle":{"width":1}},"axisLabel":{"textStyle":{"fontFamily":"Ubuntu, sans"}},"type":"value"},"xAxis":{"axisLabel":{"textStyle":{"fontFamily":"Ubuntu, sans"},"rotate":0},"data":["ANTONITO","ARVADA","DEL NORTE","DENVER","HENDERSON","JOHNSTOWN","KIOWA","LITTLETON","LONGMONT","MANZANOLA","PITKIN","ROCKVALE","SILVERTHORNE","VERNON","WALSH"],"interval":0,"type":"category"},"color":["#93a9a6","#cda71f","#eb6f76","#66b35b","#bd97e2","#5b5925","#884a6f","#51b3f6","#cca067","#398465","#3c607a","#81463c","#b65f33","#9aae31","#ce8b9e","#6c6356","#95a779","#44aecb","#e987c2","#8a7ea0","#3d6c2f","#40b994","#87984a","#c1a088","#9b6e2d","#428c8d","#b8766a","#eb8666","#df883e","#bb6273","#c994bf","#929de0","#7ba5cb","#ae9093","#66557b","#936370","#3c6d64","#84693f","#c19744","#e77aa1","#5d555f","#4078a2","#3fafaf","#698b99","#486a4c","#7ea48b","#b57e57","#8c72aa","#609050","#56b379","#489f8b","#714d4a","#9a8867","#93b66b","#7da93f","#877424","#c75d56","#b774ac","#7b7a3e","#73581c","#398ea3","#964734","#df8d89","#af97cc","#96951f","#a37791","#7c4d2e","#78865f","#216b74","#935524","#6fafb6","#75ab76","#a48b50","#d28dd0","#be9aaf","#ad8d22","#d89576","#964860","#9b9a61","#4daadb","#a9628d","#98943b","#486366","#6d7e2b","#cf9a2f","#827a8b","#876a69","#495f23","#677f45","#805845","#a2544d","#8c5157","#6b6c9e","#236443","#919b82","#cc8e55","#3e8555","#a08a7a","#767870","#6d9643","#87658f","#3bb069","#6a5d42","#586249","#1f7769","#6daf8e","#8fa7be","#b7a82c","#a09da0","#7d8aa6","#78a3e0","#719186","#765771","#a37ea7","#8e8cbc","#a76840","#49934b","#a27c62","#3da27b","#a9ac53","#6685b4","#5f728a","#cb6b4a","#9f8dd3","#b7a66e","#a998b3","#85a362","#595146"],"tooltip":{"trigger":"axis"}}"""

chart_CO_gender ∷ String
chart_CO_gender =
  """{"series":[{"name":"female","stack":"default stack","data":[{"value":["ANTONITO",1],"name":"ANTONITO"},null,{"value":["DEL NORTE",1],"name":"DEL NORTE"},null,{"value":["HENDERSON",1],"name":"HENDERSON"},{"value":["JOHNSTOWN",1],"name":"JOHNSTOWN"},null,{"value":["LITTLETON",1],"name":"LITTLETON"},{"value":["LONGMONT",1],"name":"LONGMONT"},{"value":["MANZANOLA",1],"name":"MANZANOLA"},null,null,null,null,{"value":["WALSH",1],"name":"WALSH"}],"type":"bar"},{"name":"male","stack":"default stack","data":[null,{"value":["ARVADA",1],"name":"ARVADA"},null,{"value":["DENVER",1],"name":"DENVER"},null,null,{"value":["KIOWA",1],"name":"KIOWA"},{"value":["LITTLETON",1],"name":"LITTLETON"},null,null,{"value":["PITKIN",1],"name":"PITKIN"},{"value":["ROCKVALE",1],"name":"ROCKVALE"},{"value":["SILVERTHORNE",1],"name":"SILVERTHORNE"},{"value":["VERNON",1],"name":"VERNON"},null],"type":"bar"}],"legend":{"top":"bottom","left":"left","data":["female","male"],"textStyle":{"fontFamily":"Ubuntu, sans"}},"yAxis":{"splitLine":{"lineStyle":{"width":1}},"axisLine":{"lineStyle":{"width":1}},"axisLabel":{"textStyle":{"fontFamily":"Ubuntu, sans"}},"type":"value"},"xAxis":{"axisLabel":{"textStyle":{"fontFamily":"Ubuntu, sans"},"rotate":0},"data":["ANTONITO","ARVADA","DEL NORTE","DENVER","HENDERSON","JOHNSTOWN","KIOWA","LITTLETON","LONGMONT","MANZANOLA","PITKIN","ROCKVALE","SILVERTHORNE","VERNON","WALSH"],"interval":0,"type":"category"},"color":["#93a9a6","#cda71f","#eb6f76","#66b35b","#bd97e2","#5b5925","#884a6f","#51b3f6","#cca067","#398465","#3c607a","#81463c","#b65f33","#9aae31","#ce8b9e","#6c6356","#95a779","#44aecb","#e987c2","#8a7ea0","#3d6c2f","#40b994","#87984a","#c1a088","#9b6e2d","#428c8d","#b8766a","#eb8666","#df883e","#bb6273","#c994bf","#929de0","#7ba5cb","#ae9093","#66557b","#936370","#3c6d64","#84693f","#c19744","#e77aa1","#5d555f","#4078a2","#3fafaf","#698b99","#486a4c","#7ea48b","#b57e57","#8c72aa","#609050","#56b379","#489f8b","#714d4a","#9a8867","#93b66b","#7da93f","#877424","#c75d56","#b774ac","#7b7a3e","#73581c","#398ea3","#964734","#df8d89","#af97cc","#96951f","#a37791","#7c4d2e","#78865f","#216b74","#935524","#6fafb6","#75ab76","#a48b50","#d28dd0","#be9aaf","#ad8d22","#d89576","#964860","#9b9a61","#4daadb","#a9628d","#98943b","#486366","#6d7e2b","#cf9a2f","#827a8b","#876a69","#495f23","#677f45","#805845","#a2544d","#8c5157","#6b6c9e","#236443","#919b82","#cc8e55","#3e8555","#a08a7a","#767870","#6d9643","#87658f","#3bb069","#6a5d42","#586249","#1f7769","#6daf8e","#8fa7be","#b7a82c","#a09da0","#7d8aa6","#78a3e0","#719186","#765771","#a37ea7","#8e8cbc","#a76840","#49934b","#a27c62","#3da27b","#a9ac53","#6685b4","#5f728a","#cb6b4a","#9f8dd3","#b7a66e","#a998b3","#85a362","#595146"],"tooltip":{"trigger":"axis"}}"""

chart_NE_gender ∷ String
chart_NE_gender =
  """{"series":[{"name":"female","stack":"default stack","data":[{"value":["BEE",1],"name":"BEE"},{"value":["BLAIR",1],"name":"BLAIR"},null,null,null,null,{"value":["OMAHA",2],"name":"OMAHA"},null,null,{"value":["PIERCE",1],"name":"PIERCE"},null,null,{"value":["WOOD LAKE",1],"name":"WOOD LAKE"},{"value":["WYNOT",1],"name":"WYNOT"}],"type":"bar"},{"name":"male","stack":"default stack","data":[{"value":["BEE",1],"name":"BEE"},null,{"value":["CAIRO",1],"name":"CAIRO"},{"value":["CRAIG",1],"name":"CRAIG"},{"value":["GOTHENBURG",1],"name":"GOTHENBURG"},{"value":["LINCOLN",1],"name":"LINCOLN"},{"value":["OMAHA",2],"name":"OMAHA"},{"value":["ORD",1],"name":"ORD"},{"value":["OSHKOSH",1],"name":"OSHKOSH"},{"value":["PIERCE",1],"name":"PIERCE"},{"value":["SAINT EDWARD",1],"name":"SAINT EDWARD"},{"value":["WILLOW ISLAND",1],"name":"WILLOW ISLAND"},null,null],"type":"bar"}],"legend":{"top":"bottom","left":"left","data":["female","male"],"textStyle":{"fontFamily":"Ubuntu, sans"}},"yAxis":{"splitLine":{"lineStyle":{"width":1}},"axisLine":{"lineStyle":{"width":1}},"axisLabel":{"textStyle":{"fontFamily":"Ubuntu, sans"}},"type":"value"},"xAxis":{"axisLabel":{"textStyle":{"fontFamily":"Ubuntu, sans"},"rotate":0},"data":["BEE","BLAIR","CAIRO","CRAIG","GOTHENBURG","LINCOLN","OMAHA","ORD","OSHKOSH","PIERCE","SAINT EDWARD","WILLOW ISLAND","WOOD LAKE","WYNOT"],"interval":0,"type":"category"},"color":["#93a9a6","#cda71f","#eb6f76","#66b35b","#bd97e2","#5b5925","#884a6f","#51b3f6","#cca067","#398465","#3c607a","#81463c","#b65f33","#9aae31","#ce8b9e","#6c6356","#95a779","#44aecb","#e987c2","#8a7ea0","#3d6c2f","#40b994","#87984a","#c1a088","#9b6e2d","#428c8d","#b8766a","#eb8666","#df883e","#bb6273","#c994bf","#929de0","#7ba5cb","#ae9093","#66557b","#936370","#3c6d64","#84693f","#c19744","#e77aa1","#5d555f","#4078a2","#3fafaf","#698b99","#486a4c","#7ea48b","#b57e57","#8c72aa","#609050","#56b379","#489f8b","#714d4a","#9a8867","#93b66b","#7da93f","#877424","#c75d56","#b774ac","#7b7a3e","#73581c","#398ea3","#964734","#df8d89","#af97cc","#96951f","#a37791","#7c4d2e","#78865f","#216b74","#935524","#6fafb6","#75ab76","#a48b50","#d28dd0","#be9aaf","#ad8d22","#d89576","#964860","#9b9a61","#4daadb","#a9628d","#98943b","#486366","#6d7e2b","#cf9a2f","#827a8b","#876a69","#495f23","#677f45","#805845","#a2544d","#8c5157","#6b6c9e","#236443","#919b82","#cc8e55","#3e8555","#a08a7a","#767870","#6d9643","#87658f","#3bb069","#6a5d42","#586249","#1f7769","#6daf8e","#8fa7be","#b7a82c","#a09da0","#7d8aa6","#78a3e0","#719186","#765771","#a37ea7","#8e8cbc","#a76840","#49934b","#a27c62","#3da27b","#a9ac53","#6685b4","#5f728a","#cb6b4a","#9f8dd3","#b7a66e","#a998b3","#85a362","#595146"],"tooltip":{"trigger":"axis"}}"""


Show some formatting for all error types

{-
Copyright 2017 SlamData, Inc.

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-}

module SlamData.Workspace.Card.Error.Component
  ( errorCardComponent
  , module SlamData.Workspace.Card.Error.Component.Query
  , module SlamData.Workspace.Card.Error.Component.State
  ) where

import SlamData.Prelude

import Data.Argonaut as J
import Data.Path.Pathy as Path
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Quasar.Advanced.QuasarAF as QA
import SlamData.GlobalError as GE
import SlamData.Monad (Slam)
import SlamData.Render.Icon as I
import SlamData.Wiring as Wiring
import SlamData.Workspace.AccessType (AccessType(..))
import SlamData.Workspace.Card.CardType.FormInputType as FIT
import SlamData.Workspace.Card.Error as CE
import SlamData.Workspace.Card.Error (CardError(..), cardToGlobalError)
import SlamData.Workspace.Card.Error.Component.Query (Query(..))
import SlamData.Workspace.Card.Error.Component.State (State, initialState)
import Utils (prettyJson)

type DSL = H.ComponentDSL State Query Void Slam
type HTML = H.ComponentHTML Query

errorCardComponent ∷ H.Component HH.HTML Query CardError Void Slam
errorCardComponent =
  H.lifecycleComponent
    { initialState: initialState
    , render
    , eval
    -- TODO: check whether the card needs to be able to respond to input changes
    -- it may be unnecessary, as I think the error card disappears between runs -gb
    , receiver: const Nothing
    , initializer: Just (H.action Init)
    , finalizer: Nothing
    }

render ∷ State → HTML
render st =
  HH.div
    [ HP.class_ (H.ClassName "sd-error-container") ]
    [ prettyPrintCardError st st.error ]

errorTitle ∷ Array HTML → HTML
errorTitle title =
  HH.h1_
    [ I.warningSm
    , HH.span_ title
    ]

eval ∷ Query ~> DSL
eval = case _ of
  Init next → do
    { accessType } ← Wiring.expose
    H.modify (_ { accessType = accessType })
    pure next
  ToggleExpanded b next → do
    H.modify (_ { expanded = b })
    pure next

printQErrorWithDetails ∷ QA.QError → HTML
printQErrorWithDetails = case _ of
  err → HH.text (QA.printQError err)

printQErrorDetails ∷ QA.QError → HTML
printQErrorDetails = case _ of
  QA.ErrorMessage { raw } → printQErrorRaw raw
  err → HH.text (QA.printQError err)

printQErrorRaw ∷ J.JObject → HTML
printQErrorRaw raw = HH.pre_ [ HH.text (prettyJson (J.fromObject raw)) ]

prettyPrintCardError ∷ State → CardError → HTML
prettyPrintCardError state ce = case cardToGlobalError ce of
  Just ge →
    HH.div_
      [ errorTitle [ HH.text (GE.print ge) ] ]
  Nothing → case ce of
    QuasarError qError →
      HH.div_
        [ errorTitle [ HH.text "An error occurred." ]
        , printQErrorWithDetails qError
        ]
    StringlyTypedError err →
      HH.div_
        [ errorTitle [ HH.text err ] ]
    CacheCardError cce → cacheErrorMessage state cce
    QueryCardError qce → queryErrorMessage state qce
    MarkdownCardError mde → markdownErrorMessage state mde
    DownloadOptionsCardError dloe → downloadOptionsErrorMessage state dloe
    OpenCardError oce → openErrorMessage state oce
    TableCardError tce → tableErrorMessage state tce
    FormInputStaticCardError fise → formInputStaticErrorMessage state fise
    FormInputLabeledCardError file → formInputLabeledErrorMessage state file

collapsible ∷ String → HTML → Boolean → HTML
collapsible title content expanded =
  HH.div
    [ HP.classes [ H.ClassName "sd-collapsible-error" ] ]
    $ join
      [ pure $
          HH.button
            [ HE.onClick $ HE.input_ (ToggleExpanded (not expanded)) ]
            [ if expanded then I.chevronDownSm else I.chevronRightSm
            , HH.span_ [ HH.text title ]
            ]
      , guard expanded $>
          HH.div
            [ HP.class_ (H.ClassName "sd-collapsible-error-content") ]
            [ content ]
      ]

queryErrorMessage ∷ State → CE.QueryError → HTML
queryErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the query card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  renderDetails = case _ of
    CE.QueryCompileError qErr →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An error occurred during query compilation." ]
          , renderMore qErr
          ]
    CE.QueryRetrieveResultError qErr →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An error occurred when retrieving the query result." ]
          , renderMore qErr
          ]
  renderMore = case _ of
    QA.ErrorMessage {title, message, raw} →
      pure $ HH.div_
        $ join
          [ foldMap (\t -> pure $ HH.p_ [ HH.text t ]) title
          , pure $ HH.p_ [ HH.text message ]
          , guard (accessType == Editable) $> collapsible "Quasar error details" (printQErrorRaw raw) expanded
          ]
    err' →
      guard (accessType == Editable) $> collapsible "Quasar error details" (printQErrorDetails err') expanded

cacheErrorMessage ∷ State → CE.CacheError → HTML
cacheErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the cache card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  renderDetails = case _ of
    CE.CacheInvalidFilepath fp →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "There is a problem in the configuration of the cache card." ]
          , pure $ HH.p_
              [ HH.text "The provided path "
              , HH.code_ [ HH.text fp ]
              , HH.text " is not a valid location to store the cache result."
              ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.CacheQuasarError qe →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "Caching the result of a query failed." ]
          , pure $ HH.p_ [ HH.text "The Quasar analytics engine returned an error while verifying the cache result." ]
          , guard (accessType == Editable) $> collapsible "Quasar error details" (printQErrorDetails qe) expanded
          ]
    CE.CacheErrorSavingFile fp →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "Caching the result of a query failed." ]
          , pure $ HH.p_
              [ HH.text "The file "
              , HH.code_ [ HH.text (Path.printPath fp) ]
              , HH.text " could not be written to."
              ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and provide an alternative path to fix this error." ]
          ]
    CE.CacheResourceNotModified →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "Caching the result of a query failed." ]
          , pure $ HH.p_ [ HH.text "Caching can only be applied to queries that perform at least one transformation on an existing data set." ]
          -- TODO: only show this solution when there are no following cards?
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and delete it to fix this error." ]
          ]

markdownErrorMessage ∷ State → CE.MarkdownError → HTML
markdownErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the Markdown card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  -- TODO: explain which field for all these cases? -gb
  renderDetails = case _ of
    CE.MarkdownParseError {markdown, error} →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "Parsing the provided Markdown failed." ]
          , pure $ HH.p_
              [ HH.text "We encountered the following parse error: "
              , HH.code_ [ HH.text error ]
              ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.MarkdownSqlParseError {sql, error} →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "Parsing SQL embedded inside Markdown failed." ]
          , pure $ renderParseError error sql
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.MarkdownNoTextBoxResults →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "A text box field did not return any results." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.MarkdownInvalidTimeValue { time, error } →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An invalid time value was provided." ]
          , pure $ renderParseError error time
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.MarkdownInvalidDateValue { date, error } →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An invalid date value was provided." ]
          , pure $ renderParseError error date
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.MarkdownInvalidDateTimeValue { datetime, error } →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An invalid timestamp value was provided." ]
          , pure $ renderParseError error datetime
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.MarkdownTypeError t1 t2 →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "A type mismatch occurred when populating a field in the Markdown card." ]
          , pure $ HH.p_
              [ HH.text "We encountered the following type:"
              , HH.br_
              , HH.code_ [ HH.text t1 ]
              , HH.text " where we expected:"
              , HH.br_
              , HH.code_ [ HH.text t2 ]
              ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    where
      renderParseError error value =
        HH.p_
          [ HH.text "We encountered the following error:"
          , HH.br_
          , HH.code_ [ HH.text error ]
          , HH.text " when trying to parse:"
          , HH.br_
          , HH.code_ [ HH.text value ]
          ]

downloadOptionsErrorMessage ∷ State → CE.DownloadOptionsError → HTML
downloadOptionsErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the Download Options card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  renderDetails = case _ of
    CE.DownloadOptionsFilenameRequired →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "No filename was provided in the Download Options card." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.DownloadOptionsFilenameInvalid fn →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "The filename provided in the Download Options card is invalid." ]
          , pure $ HH.p_
              [ HH.code_ [ HH.text fn ], HH.text " is not a valid filepath." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]

openErrorMessage ∷ State → CE.OpenError → HTML
openErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the Open card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  renderDetails = case _ of
    CE.OpenFileNotFound fp →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "A file that was selected in the Open card could not be found." ]
          , pure $ HH.p_
              [ HH.code_ [ HH.text fp ], HH.text " does not exist." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and make a new selection to fix this error." ]
          ]
    CE.OpenNoResourceSelected →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "No resource was selected in the Open card." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select either a file or a variable to fix this error." ]
          ]
    CE.OpenNoFileSelected →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "The resource selected in the Open card is of an invalid type" ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select a file or variable to fix this error." ]
          ]

tableErrorMessage ∷ State → CE.TableError → HTML
tableErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the Preview Table card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  renderDetails = case _ of
    CE.TableMissingResourceInputError →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "Expected a TaggedResource input." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.TableCountQuasarError qErr →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "A error occured when counting the preview data." ]
          , pure $ printQErrorWithDetails qErr
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.TableSampleQuasarError qErr →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "A error occured during sampling of the preview data." ]
          , pure $ printQErrorWithDetails qErr
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]

formInputStaticErrorMessage ∷ State → CE.FormInputStaticError → HTML
formInputStaticErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the Forminput static card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  renderDetails = case _ of
    CE.FIStaticNoAxis →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An error occured when setting up the Forminput static card." ]
          , pure $ HH.p_
              [ HH.text "No axis was selected" ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select an axis to fix this error." ]
          ]
    CE.FIStaticMissingAxis axis →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An error occured when setting up the Forminput static card." ]
          , pure $ HH.p_
              [ HH.text "The selected axis was not present in the data." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]

formInputLabeledErrorMessage ∷ State → CE.FormInputLabeledError → HTML
formInputLabeledErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the Forminput labeled card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  renderDetails = case _ of
    CE.FILabeledNoAxisError →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An error occured when setting up the Forminput labeled card." ]
          , pure $ HH.p_
              [ HH.text "No axis was selected" ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select an axis to fix this error." ]
          ]
    CE.FILabeledEmptyResourceError →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An error occured when setting up the Forminput labeled card." ]
          , pure $ HH.p_
              [ HH.text "The selected resource was empty." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select an axis to fix this error." ]
          ]
    CE.FILabeledTooManyEntries { formInputType, maximum, entryCount } →
      let
        errorText =
          "The " <> FIT.printFormInputType formInputType
          <> " form input can't take more than "
          <> show (FIT.maximumCountOfEntries formInputType)
          <> "entries, but there were: "
          <> show entryCount
          <> ". Please use 'limit' or 'group by'"
      in
        HH.div_
          $ join
            [ pure $ errorTitle [ HH.text "An error occured when setting up the Forminput labeled card." ]
            , pure $ HH.p_
                [ HH.text errorText ]
            , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select an axis to fix this error." ]
            ]
    CE.FILabeledTooManySelected { formInputType, maximum, selectedCount } →
      let
        errorText =
          "The " <> FIT.printFormInputType formInputType
          <> " form input can't have more than "
          <> show (FIT.maximumCountOfSelectedValues formInputType)
          <> " selected values, but there were: "
          <> show selectedCount
          <> ". Please, use another axis"
      in
        HH.div_
          $ join
            [ pure $ errorTitle [ HH.text "An error occured when setting up the Forminput labeled card." ]
            , pure $ HH.p_
                [ HH.text errorText ]
            , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select an axis to fix this error." ]
            ]
    -- TODO: Use the label argument for a better error message
    CE.FILabeledNonUniqueLabelError label →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An error occured when setting up the Forminput labeled card." ]
          , pure $ HH.p_
              [ HH.text "Labels must be unique. Please, use other axis." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select an axis to fix this error." ]
          ]

{-
Copyright 2017 SlamData, Inc.

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-}

module SlamData.Workspace.Card.Error.Component
  ( errorCardComponent
  , module SlamData.Workspace.Card.Error.Component.Query
  , module SlamData.Workspace.Card.Error.Component.State
  ) where

import SlamData.Prelude

import Data.Argonaut as J
import Data.Path.Pathy as Path
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Quasar.Advanced.QuasarAF as QA
import SlamData.GlobalError as GE
import SlamData.Monad (Slam)
import SlamData.Render.Icon as I
import SlamData.Wiring as Wiring
import SlamData.Workspace.AccessType (AccessType(..))
import SlamData.Workspace.Card.CardType.FormInputType as FIT
import SlamData.Workspace.Card.Error as CE
import SlamData.Workspace.Card.Error (CardError(..), cardToGlobalError)
import SlamData.Workspace.Card.Error.Component.Query (Query(..))
import SlamData.Workspace.Card.Error.Component.State (State, initialState)
import Utils (prettyJson)

type DSL = H.ComponentDSL State Query Void Slam
type HTML = H.ComponentHTML Query

errorCardComponent ∷ H.Component HH.HTML Query CardError Void Slam
errorCardComponent =
  H.lifecycleComponent
    { initialState: initialState
    , render
    , eval
    -- TODO: check whether the card needs to be able to respond to input changes
    -- it may be unnecessary, as I think the error card disappears between runs -gb
    , receiver: const Nothing
    , initializer: Just (H.action Init)
    , finalizer: Nothing
    }

render ∷ State → HTML
render st =
  HH.div
    [ HP.class_ (H.ClassName "sd-error-container") ]
    [ prettyPrintCardError st st.error ]

errorTitle ∷ Array HTML → HTML
errorTitle title =
  HH.h1_
    [ I.warningSm
    , HH.span_ title
    ]

eval ∷ Query ~> DSL
eval = case _ of
  Init next → do
    { accessType } ← Wiring.expose
    H.modify (_ { accessType = accessType })
    pure next
  ToggleExpanded b next → do
    H.modify (_ { expanded = b })
    pure next

printQErrorWithDetails ∷ QA.QError → HTML
printQErrorWithDetails = case _ of
  err → HH.text (QA.printQError err)

printQErrorDetails ∷ QA.QError → HTML
printQErrorDetails = case _ of
  QA.ErrorMessage { raw } → printQErrorRaw raw
  err → HH.text (QA.printQError err)

printQErrorRaw ∷ J.JObject → HTML
printQErrorRaw raw = HH.pre_ [ HH.text (prettyJson (J.fromObject raw)) ]

prettyPrintCardError ∷ State → CardError → HTML
prettyPrintCardError state ce = case cardToGlobalError ce of
  Just ge → HH.text (GE.print ge)
  Nothing → case ce of
    QuasarError qError → printQErrorWithDetails qError
    StringlyTypedError err → HH.text err
    CacheCardError cce → cacheErrorMessage state cce
    QueryCardError qce → queryErrorMessage state qce
    MarkdownCardError mde → markdownErrorMessage state mde
    DownloadOptionsCardError dloe → downloadOptionsErrorMessage state dloe
    OpenCardError oce → openErrorMessage state oce
    TableCardError tce → tableErrorMessage state tce
    FormInputStaticCardError fise → formInputStaticErrorMessage state fise
    FormInputLabeledCardError file → formInputLabeledErrorMessage state file

collapsible ∷ String → HTML → Boolean → HTML
collapsible title content expanded =
  HH.div
    [ HP.classes [ H.ClassName "sd-collapsible-error" ] ]
    $ join
      [ pure $
          HH.button
            [ HE.onClick $ HE.input_ (ToggleExpanded (not expanded)) ]
            [ if expanded then I.chevronDownSm else I.chevronRightSm
            , HH.span_ [ HH.text title ]
            ]
      , guard expanded $>
          HH.div
            [ HP.class_ (H.ClassName "sd-collapsible-error-content") ]
            [ content ]
      ]

queryErrorMessage ∷ State → CE.QueryError → HTML
queryErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the query card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  renderDetails = case _ of
    CE.QueryCompileError qErr →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An error occurred during query compilation." ]
          , renderMore qErr
          ]
    CE.QueryRetrieveResultError qErr →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An error occurred when retrieving the query result." ]
          , renderMore qErr
          ]
  renderMore = case _ of
    QA.ErrorMessage {title, message, raw} →
      pure $ HH.div_
        $ join
          [ foldMap (\t -> pure $ HH.p_ [ HH.text t ]) title
          , pure $ HH.p_ [ HH.text message ]
          , guard (accessType == Editable) $> collapsible "Quasar error details" (printQErrorRaw raw) expanded
          ]
    err' →
      guard (accessType == Editable) $> collapsible "Quasar error details" (printQErrorDetails err') expanded

cacheErrorMessage ∷ State → CE.CacheError → HTML
cacheErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the cache card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  renderDetails = case _ of
    CE.CacheInvalidFilepath fp →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "There is a problem in the configuration of the cache card." ]
          , pure $ HH.p_
              [ HH.text "The provided path "
              , HH.code_ [ HH.text fp ]
              , HH.text " is not a valid location to store the cache result."
              ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.CacheQuasarError qe →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "Caching the result of a query failed." ]
          , pure $ HH.p_ [ HH.text "The Quasar analytics engine returned an error while verifying the cache result." ]
          , guard (accessType == Editable) $> collapsible "Quasar error details" (printQErrorDetails qe) expanded
          ]
    CE.CacheErrorSavingFile fp →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "Caching the result of a query failed." ]
          , pure $ HH.p_
              [ HH.text "The file "
              , HH.code_ [ HH.text (Path.printPath fp) ]
              , HH.text " could not be written to."
              ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and provide an alternative path to fix this error." ]
          ]
    CE.CacheResourceNotModified →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "Caching the result of a query failed." ]
          , pure $ HH.p_ [ HH.text "Caching can only be applied to queries that perform at least one transformation on an existing data set." ]
          -- TODO: only show this solution when there are no following cards?
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and delete it to fix this error." ]
          ]

markdownErrorMessage ∷ State → CE.MarkdownError → HTML
markdownErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the Markdown card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  -- TODO: explain which field for all these cases? -gb
  renderDetails = case _ of
    CE.MarkdownParseError {markdown, error} →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "Parsing the provided Markdown failed." ]
          , pure $ HH.p_
              [ HH.text "We encountered the following parse error: "
              , HH.code_ [ HH.text error ]
              ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.MarkdownSqlParseError {sql, error} →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "Parsing SQL embedded inside Markdown failed." ]
          , pure $ renderParseError error sql
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.MarkdownNoTextBoxResults →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "A text box field did not return any results." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.MarkdownInvalidTimeValue { time, error } →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An invalid time value was provided." ]
          , pure $ renderParseError error time
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.MarkdownInvalidDateValue { date, error } →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An invalid date value was provided." ]
          , pure $ renderParseError error date
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.MarkdownInvalidDateTimeValue { datetime, error } →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An invalid timestamp value was provided." ]
          , pure $ renderParseError error datetime
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.MarkdownTypeError t1 t2 →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "A type mismatch occurred when populating a field in the Markdown card." ]
          , pure $ HH.p_
              [ HH.text "We encountered the following type:"
              , HH.br_
              , HH.code_ [ HH.text t1 ]
              , HH.text " where we expected:"
              , HH.br_
              , HH.code_ [ HH.text t2 ]
              ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    where
      renderParseError error value =
        HH.p_
          [ HH.text "We encountered the following error:"
          , HH.br_
          , HH.code_ [ HH.text error ]
          , HH.text " when trying to parse:"
          , HH.br_
          , HH.code_ [ HH.text value ]
          ]

downloadOptionsErrorMessage ∷ State → CE.DownloadOptionsError → HTML
downloadOptionsErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the Download Options card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  renderDetails = case _ of
    CE.DownloadOptionsFilenameRequired →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "No filename was provided in the Download Options card." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.DownloadOptionsFilenameInvalid fn →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "The filename provided in the Download Options card is invalid." ]
          , pure $ HH.p_
              [ HH.code_ [ HH.text fn ], HH.text " is not a valid filepath." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]

openErrorMessage ∷ State → CE.OpenError → HTML
openErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the Open card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  renderDetails = case _ of
    CE.OpenFileNotFound fp →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "A file that was selected in the Open card could not be found." ]
          , pure $ HH.p_
              [ HH.code_ [ HH.text fp ], HH.text " does not exist." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and make a new selection to fix this error." ]
          ]
    CE.OpenNoResourceSelected →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "No resource was selected in the Open card." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select either a file or a variable to fix this error." ]
          ]
    CE.OpenNoFileSelected →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "The resource selected in the Open card is of an invalid type" ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select a file or variable to fix this error." ]
          ]

tableErrorMessage ∷ State → CE.TableError → HTML
tableErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the Preview Table card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  renderDetails = case _ of
    CE.TableMissingResourceInputError →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "Expected a TaggedResource input." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.TableCountQuasarError qErr →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "A error occured when counting the preview data." ]
          , pure $ printQErrorWithDetails qErr
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]
    CE.TableSampleQuasarError qErr →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "A error occured during sampling of the preview data." ]
          , pure $ printQErrorWithDetails qErr
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]

formInputStaticErrorMessage ∷ State → CE.FormInputStaticError → HTML
formInputStaticErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the Forminput static card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  renderDetails = case _ of
    CE.FIStaticNoAxis →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An error occured when setting up the Forminput static card." ]
          , pure $ HH.p_
              [ HH.text "No axis was selected" ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select an axis to fix this error." ]
          ]
    CE.FIStaticMissingAxis axis →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An error occured when setting up the Forminput static card." ]
          , pure $ HH.p_
              [ HH.text "The selected axis was not present in the data." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card to fix this error." ]
          ]

formInputLabeledErrorMessage ∷ State → CE.FormInputLabeledError → HTML
formInputLabeledErrorMessage { accessType, expanded } err =
  case accessType of
    Editable → renderDetails err
    ReadOnly →
      HH.div_
        [ HH.p_ [ HH.text "A problem occurred in the Forminput labeled card, please notify the author of this workspace." ]
        , collapsible "Error details" (renderDetails err) expanded
        ]
  where
  renderDetails = case _ of
    CE.FILabeledNoAxisError →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An error occured when setting up the Forminput labeled card." ]
          , pure $ HH.p_
              [ HH.text "No axis was selected" ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select an axis to fix this error." ]
          ]
    CE.FILabeledEmptyResourceError →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An error occured when setting up the Forminput labeled card." ]
          , pure $ HH.p_
              [ HH.text "The selected resource was empty." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select an axis to fix this error." ]
          ]
    CE.FILabeledTooManyEntries { formInputType, maximum, entryCount } →
      let
        errorText =
          "The " <> FIT.printFormInputType formInputType
          <> " form input can't take more than "
          <> show (FIT.maximumCountOfEntries formInputType)
          <> "entries, but there were: "
          <> show entryCount
          <> ". Please use 'limit' or 'group by'"
      in
        HH.div_
          $ join
            [ pure $ errorTitle [ HH.text "An error occured when setting up the Forminput labeled card." ]
            , pure $ HH.p_
                [ HH.text errorText ]
            , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select an axis to fix this error." ]
            ]
    CE.FILabeledTooManySelected { formInputType, maximum, selectedCount } →
      let
        errorText =
          "The " <> FIT.printFormInputType formInputType
          <> " form input can't have more than "
          <> show (FIT.maximumCountOfSelectedValues formInputType)
          <> " selected values, but there were: "
          <> show selectedCount
          <> ". Please, use another axis"
      in
        HH.div_
          $ join
            [ pure $ errorTitle [ HH.text "An error occured when setting up the Forminput labeled card." ]
            , pure $ HH.p_
                [ HH.text errorText ]
            , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select an axis to fix this error." ]
            ]
    -- TODO: Use the label argument for a better error message
    CE.FILabeledNonUniqueLabelError label →
      HH.div_
        $ join
          [ pure $ errorTitle [ HH.text "An error occured when setting up the Forminput labeled card." ]
          , pure $ HH.p_
              [ HH.text "Labels must be unique. Please, use other axis." ]
          , guard (accessType == Editable) $> HH.p_ [ HH.text "Go back to the previous card and select an axis to fix this error." ]
          ]


remove white space

remove white space

module React.Redox
  ( ConnectState(..)
  , DispatchFn
  , RedoxContext
  , RedoxSpec
  , withStore
  , connect'
  , connect
  , withDispatch
  , dispatch
  , asReactClass
  , overRedoxSpec
  , unsafeShallowEqual
  , unsafeStrictEqual
  ) where

import Prelude

import Control.Monad.Aff (Canceler)
import Control.Monad.Eff (Eff, kind Effect)
import Control.Monad.Eff.Uncurried (EffFn1, EffFn2, runEffFn1, runEffFn2)
import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
import Control.Monad.Free (Free)
import Data.Function.Uncurried (Fn2, Fn3, mkFn2, runFn2, runFn3)
import Data.Lens (Getter', view)
import Data.Maybe (Maybe(Just, Nothing))
import Data.Newtype (class Newtype, over)
import React (ReactClass, ReactElement, ReactSpec, ReactThis, createClass, createClassStateless', createElement, getProps, readState, writeState)
import React as R
import ReactHocs (CONTEXT, withContext, accessContext, readContext, getDisplayName)
import Redox as Redox
import Redox.Store (ReadRedox, RedoxStore, Store, SubscribeRedox, SubscriptionId)
import Type.Proxy (Proxy(..))
import Unsafe.Coerce (unsafeCoerce)

type DispatchFn state dsl reff eff = Free dsl (state -> state) -> Eff (redox :: RedoxStore reff | eff) (Canceler (redox :: RedoxStore reff | eff))

-- | Shallowly compare two objects.  If the first argument is true it skips
-- | comparing the `key` property which should not be accessed on a property
-- | object.
foreign import unsafeShallowEqual :: forall a. Fn3 Boolean a a Boolean

-- | Compare two objects using strict equality `===`
foreign import unsafeStrictEqual :: forall a. Fn2 a a Boolean

foreign import writeIsMountedImpl
  :: forall props state e
   . EffFn2 e (ReactThis props state) Boolean Unit

writeIsMounted :: forall props state e. ReactThis props state -> Boolean -> Eff e Unit
writeIsMounted this isMounted = runEffFn2 writeIsMountedImpl this isMounted

foreign import readIsMountedImpl
  :: forall props state e
   . EffFn1 e (ReactThis props state) Boolean

readIsMounted :: forall props state e. ReactThis props state -> Eff e Boolean
readIsMounted this = runEffFn1 readIsMountedImpl this

foreign import forceUpdateImpl :: forall eff props state.
  EffFn1 eff (ReactThis props state) Unit

-- | Force render of a react component.
forceUpdate :: forall eff props state.
  ReactThis props state -> Eff eff Unit
forceUpdate this = runEffFn1 forceUpdateImpl this

createClassStatelessWithContext
  :: forall props ctx
   . (props -> Array ReactElement -> ctx -> ReactElement)
  -> ReactClass props
createClassStatelessWithContext fn = unsafeCoerce f
  where
    -- using createClassStateless' ensures that children are coerced to `Array ReactElement`
    cls :: ctx -> ReactClass props
    cls ctx = createClassStateless' \props children -> fn props children ctx

    f :: Fn2 props { ctx :: ctx } ReactElement
    f = mkFn2 (\props { ctx } -> createElement (cls ctx) props (unsafeCoerce props).children)

newtype RedoxContext state dsl reff eff = RedoxContext
  { store :: Store state
  , dispatch :: DispatchFn state dsl reff eff
  }

-- | You need to wrap your most top-level component with `withStore`.  It makes
-- | the store and the bound dispatch function available through React context.
-- | Then you can connect a component with `connect` (or `connect'`) and get
-- | access to the store and the dispatch function.
withStore
  :: forall state props dsl reff eff
  -- redox store
   . Store state
  -- bound redox dispatch function
  -> (Store state -> DispatchFn state dsl reff eff)
  -> ReactClass props
  -> Eff eff (ReactClass props)
withStore store dispatch_ cls =
  pure $ withContext cls { redox: RedoxContext { store, dispatch: dispatch_ store } }

newtype ConnectState state = ConnectState { state :: state, sid :: Maybe SubscriptionId }

derive instance newtypeConnectState :: Newtype (ConnectState state) _

_connect
  :: forall state state' dsl props props' reff eff
   . (ReactThis props' (ConnectState state')
      -> Eff
        (context :: CONTEXT, redox :: RedoxStore (read :: ReadRedox, subscribe :: SubscribeRedox | reff) | eff)
        (RedoxContext state dsl (read :: ReadRedox, subscribe :: SubscribeRedox | reff) eff)
     )
  -> Getter' state state'
  -> ((DispatchFn state dsl (read :: ReadRedox, subscribe :: SubscribeRedox | reff) eff) -> state' -> props' -> props)
  -> ReactClass props
  -> ReactSpec props' (ConnectState state')
      ( context :: CONTEXT
      , redox :: RedoxStore (read :: ReadRedox, subscribe :: SubscribeRedox | reff)
      | eff
      )
_connect ctxEff _lns _iso cls = (R.spec' getInitialState renderFn)
    { displayName = getDisplayName cls <> "Connect"
    , componentDidMount = componentDidMount
    , componentWillUnmount = componentWillUnmount
    , shouldComponentUpdate = shouldComponentUpdate
    }
  where

    -- Connect the child component to the context, this is required for the
    -- `dispatch` function.
    cls_ :: ReactClass props
    cls_ = accessContext cls

    update this state = do
      st <- readState this
      isMounted <- readIsMounted this
      when isMounted do
        void $ writeState this $ over ConnectState (_ { state = view _lns state }) st

    getInitialState this = do
      -- unsafeCoerceEff is used to add react effects to ctxEff
      RedoxContext ctx <- unsafeCoerceEff $ ctxEff this
      state <- Redox.getState ctx.store
      pure (ConnectState { state: view _lns state, sid: Nothing })

    -- | Subscription to redox store happens in `componentDidMount`, rather than
    -- | on `componentWillMount`.  This is because `componentWillUnmount` and
    -- | `componentDidMount` do not fire in SSR. Otherwise we'd have a memory
    -- | leak.
    componentDidMount this = do
      writeIsMounted this true
      RedoxContext { store } <- unsafeCoerceEff $ ctxEff this
      st@ConnectState { state } <- readState this
      sid <- Redox.subscribe store $ update this
      _ <- writeState this (over ConnectState (_ { sid = Just sid }) st)
      state' <- view _lns <$> Redox.getState store
      when
        (runFn2 unsafeStrictEqual state state')
        (forceUpdate this)

    componentWillUnmount this = do
      writeIsMounted this false
      RedoxContext ctx <- unsafeCoerceEff $ ctxEff this
      ConnectState { sid: msid } <- R.readState this
      case msid of
        Nothing -> pure unit
        Just sid -> Redox.unsubscribe ctx.store sid

    shouldComponentUpdate this nPr (ConnectState nSt) = do
      pr <- getProps this
      ConnectState st <- readState this
      -- Take care only of `st.state` changes, `st.sid` is not used for
      -- rendering.
      let stateChanged = not $ runFn2 unsafeStrictEqual st.state nSt.state
          propsChanged = not $ runFn3 unsafeShallowEqual true pr nPr
      pure $ stateChanged || propsChanged

    renderFn this = do
      props' <- R.getProps this
      children <- R.getChildren this
      RedoxContext ctx <- unsafeCoerceEff $ ctxEff this
      ConnectState { state } <- R.readState this
      pure $ R.createElement cls_ (_iso ctx.dispatch state props') children

-- | Newtype wrapper around `ReactSpec`.  Use  `overRedoxSpec` to change the
-- | underlying spec and `asReactClass` to create a react class.
newtype RedoxSpec props state eff = RedoxSpec (ReactSpec props state eff)

overRedoxSpec
  :: forall props state eff
   . (ReactSpec props state eff ->  ReactSpec props state eff)
  -> RedoxSpec props state eff
  -> RedoxSpec props state eff
overRedoxSpec f (RedoxSpec spec) = RedoxSpec <<< f $ spec

asReactClass :: forall props state eff. RedoxSpec props state eff -> ReactClass props
asReactClass (RedoxSpec spec) = accessContext <<< createClass $ spec

-- | This function makes the redox store and dispatch function available
-- | through context.  The first argument is a lens that identifies the part
-- | of redox store's state that you want to subscribe for.  The view on this
-- | lens will be checked for changes, so if you want to optimise your code,
-- | return as 'tight' lens as possible.
-- |
-- | Use `asReactClass` function to create react class from `RedoxSpec` that
-- | this function returns and `overRedoxSpec` to possibly change the spec, for
-- | example by changing the `shouldComponentUpdate` react life cycle method.
-- |
-- | The second argument let you combine state and additional properties
-- | `props'` to get props of the class that you are connecting to the store.
-- | You can read the context with:
-- | ```purescript
-- | ReactHocs.readContext this >>= pure <<< _.redox :: Eff eff (RedoxContext state (Free dsl (state -> state))  eff)
-- | ```
connect'
  :: forall state state' dsl props props' reff eff
   . Proxy state
  -> Getter' state state'
  -> (DispatchFn state dsl (read :: ReadRedox, subscribe :: SubscribeRedox | reff) eff -> state' -> props' -> props)
  -> ReactClass props
  -> RedoxSpec props' (ConnectState state') ( context :: CONTEXT, redox :: RedoxStore (read :: ReadRedox, subscribe :: SubscribeRedox | reff) | eff )
connect' _ _lns _iso cls = RedoxSpec $ _connect ctxEff _lns _iso cls
  where
    proxy :: Proxy ({ redox :: RedoxContext state dsl (read :: ReadRedox, subscribe :: SubscribeRedox | reff) eff })
    proxy = Proxy

    ctxEff this = _.redox <$> readContext proxy this

-- | Like `connect'` but for `ReactClass`-es.
connect
  :: forall state state' dsl props props' reff eff'
   . Proxy state
  -> Getter' state state'
  -> (DispatchFn state dsl (read :: ReadRedox, subscribe :: SubscribeRedox | reff) eff' -> state' -> props' -> props)
  -> ReactClass props
  -> ReactClass props'
connect p _lns _iso cls = asReactClass $ connect' p _lns _iso cls

-- | If you just want to wrap your actions with a dispatch function use this
-- | function.  Unlike `connect'` (and `connect`) it does not wrap your
-- | component inside another component.
withDispatch
  :: forall state props props' dsl reff eff'
   . (DispatchFn state dsl (read :: ReadRedox, subscribe :: SubscribeRedox | reff) eff' -> props' -> props)
  -> ReactClass props
  -> ReactClass props'
withDispatch fn cls = accessContext $ createClassStatelessWithContext
  \props' children { redox: RedoxContext { dispatch: disp }} -> createElement cls (fn disp props') children

-- | Light weight version of `connect`.  It does not require wrapping a parent
-- | with `withStore` since it is not using react context to access the store.
-- | You just need to provide the store with your first argument.
-- |
-- | Note: it is not safe to do server side rendering and keep the store as
-- | a global reference.  However, you can safely use this method if you are
-- | passing the store explicitly through props.
connectStore
  :: forall state state' dsl props props' reff eff
   . Store state
  -> DispatchFn state dsl (read :: ReadRedox, subscribe :: SubscribeRedox | reff) eff
  -> Getter' state state'
  -> (DispatchFn state dsl (read :: ReadRedox, subscribe :: SubscribeRedox | reff) eff -> state' -> props' -> props)
  -> ReactClass props
  -> ReactSpec props' (ConnectState state') ( context :: CONTEXT, redox :: RedoxStore (read :: ReadRedox, subscribe :: SubscribeRedox | reff) | eff )
connectStore store dispatch_ _lns _iso cls = _connect (const $ pure (RedoxContext {store, dispatch: dispatch_})) _lns _iso cls

-- | If you wrapped your component with `connect` or `connect'` you can use
-- | this `dispatch` function to run your actions.
dispatch
  :: forall dsl rProps rState state reff eff
   . ReactThis rProps rState
  -> Free dsl (state -> state)
  -> Eff (context :: CONTEXT, redox :: RedoxStore reff | eff) (Canceler (context :: CONTEXT, redox :: RedoxStore reff | eff))
dispatch this dsl =
  let proxy :: Proxy ({ redox :: RedoxContext state dsl reff (context :: CONTEXT | eff) })
      proxy = Proxy
  in do
    { redox: RedoxContext { dispatch: disp } } <- readContext proxy this
    disp dsl