Export renderForeignError

Export renderForeignError

Fixes #53

-- | This module defines types and functions for working with _foreign_
-- | data.

module Data.Foreign
  ( Foreign
  , ForeignError(..)
  , MultipleErrors(..)
  , Prop(..)
  , F
  , renderForeignError
  , parseJSON
  , toForeign
  , unsafeFromForeign
  , unsafeReadTagged
  , typeOf
  , tagOf
  , isNull
  , isUndefined
  , isArray
  , readString
  , readChar
  , readBoolean
  , readNumber
  , readInt
  , readArray
  , fail
  , writeObject
  ) where

import Prelude

import Control.Monad.Except (Except, throwError, mapExcept)

import Data.Either (Either(..), either)
import Data.Function.Uncurried (Fn3, runFn3)
import Data.Int as Int
import Data.List.NonEmpty (NonEmptyList)
import Data.List.NonEmpty as NEL
import Data.Maybe (maybe)
import Data.String (toChar)

-- | A type for _foreign data_.
-- |
-- | Foreign data is data from any external _unknown_ or _unreliable_
-- | source, for which it cannot be guaranteed that the runtime representation
-- | conforms to that of any particular type.
-- |
-- | Suitable applications of `Foreign` are
-- |
-- | - To represent responses from web services
-- | - To integrate with external JavaScript libraries.
foreign import data Foreign :: *

-- | A type for foreign type errors
data ForeignError
  = ForeignError String
  | TypeMismatch String String
  | ErrorAtIndex Int ForeignError
  | ErrorAtProperty String ForeignError
  | JSONError String

derive instance eqForeignError :: Eq ForeignError
derive instance ordForeignError :: Ord ForeignError

instance showForeignError :: Show ForeignError where
  show (ForeignError msg) = "(ForeignError " <> msg <> ")"
  show (ErrorAtIndex i e) = "(ErrorAtIndex " <> show i <> " " <> show e <> ")"
  show (ErrorAtProperty prop e) = "(ErrorAtProperty " <> show prop <> " " <> show e <> ")"
  show (JSONError s) = "(JSONError " <> show s <> ")"
  show (TypeMismatch exps act) = "(TypeMismatch " <> show exps <> " " <> show act <> ")"

-- | A type for accumulating multiple `ForeignError`s.
type MultipleErrors = NonEmptyList ForeignError

renderForeignError :: ForeignError -> String
renderForeignError (ForeignError msg) = msg
renderForeignError (ErrorAtIndex i e) = "Error at array index " <> show i <> ": " <> show e
renderForeignError (ErrorAtProperty prop e) = "Error at property " <> show prop <> ": " <> show e
renderForeignError (JSONError s) = "JSON error: " <> s
renderForeignError (TypeMismatch exp act) = "Type mismatch: expected " <> exp <> ", found " <> act

-- | An error monad, used in this library to encode possible failures when
-- | dealing with foreign data.
type F a = Except MultipleErrors a

foreign import parseJSONImpl :: forall r. Fn3 (String -> r) (Foreign -> r) String r

-- | Attempt to parse a JSON string, returning the result as foreign data.
parseJSON :: String -> F Foreign
parseJSON json = runFn3 parseJSONImpl (fail <<< JSONError) pure json

-- | Coerce any value to the a `Foreign` value.
foreign import toForeign :: forall a. a -> Foreign

-- | Unsafely coerce a `Foreign` value.
foreign import unsafeFromForeign :: forall a. Foreign -> a

-- | Read the Javascript _type_ of a value
foreign import typeOf :: Foreign -> String

-- | Read the Javascript _tag_ of a value.
-- |
-- | This function wraps the `Object.toString` method.
foreign import tagOf :: Foreign -> String

-- | Unsafely coerce a `Foreign` value when the value has a particular `tagOf`
-- | value.
unsafeReadTagged :: forall a. String -> Foreign -> F a
unsafeReadTagged tag value
  | tagOf value == tag = pure (unsafeFromForeign value)
  | otherwise = fail $ TypeMismatch tag (tagOf value)

-- | Test whether a foreign value is null
foreign import isNull :: Foreign -> Boolean

-- | Test whether a foreign value is undefined
foreign import isUndefined :: Foreign -> Boolean

-- | Test whether a foreign value is an array
foreign import isArray :: Foreign -> Boolean

-- | Attempt to coerce a foreign value to a `String`.
readString :: Foreign -> F String
readString = unsafeReadTagged "String"

-- | Attempt to coerce a foreign value to a `Char`.
readChar :: Foreign -> F Char
readChar value = mapExcept (either (const error) fromString) (readString value)
  where
  fromString = maybe error pure <<< toChar
  error = Left $ NEL.singleton $ TypeMismatch "Char" (tagOf value)

-- | Attempt to coerce a foreign value to a `Boolean`.
readBoolean :: Foreign -> F Boolean
readBoolean = unsafeReadTagged "Boolean"

-- | Attempt to coerce a foreign value to a `Number`.
readNumber :: Foreign -> F Number
readNumber = unsafeReadTagged "Number"

-- | Attempt to coerce a foreign value to an `Int`.
readInt :: Foreign -> F Int
readInt value = mapExcept (either (const error) fromNumber) (readNumber value)
  where
  fromNumber = maybe error pure <<< Int.fromNumber
  error = Left $ NEL.singleton $ TypeMismatch "Int" (tagOf value)

-- | Attempt to coerce a foreign value to an array.
readArray :: Foreign -> F (Array Foreign)
readArray value
  | isArray value = pure $ unsafeFromForeign value
  | otherwise = fail $ TypeMismatch "array" (tagOf value)

-- | Throws a failure error in `F`.
fail :: forall a. ForeignError -> F a
fail = throwError <<< NEL.singleton

-- | A key/value pair for an object to be written as a `Foreign` value.
newtype Prop = Prop { key :: String, value :: Foreign }

-- | Constructs a JavaScript `Object` value (typed as `Foreign`) from an array
-- | of `Prop`s.
foreign import writeObject :: Array Prop -> Foreign

-- | This module defines types and functions for working with _foreign_
-- | data.

module Data.Foreign
  ( Foreign
  , ForeignError(..)
  , MultipleErrors(..)
  , Prop(..)
  , F
  , parseJSON
  , toForeign
  , unsafeFromForeign
  , unsafeReadTagged
  , typeOf
  , tagOf
  , isNull
  , isUndefined
  , isArray
  , readString
  , readChar
  , readBoolean
  , readNumber
  , readInt
  , readArray
  , fail
  , writeObject
  ) where

import Prelude

import Control.Monad.Except (Except, throwError, mapExcept)

import Data.Either (Either(..), either)
import Data.Function.Uncurried (Fn3, runFn3)
import Data.Int as Int
import Data.List.NonEmpty (NonEmptyList)
import Data.List.NonEmpty as NEL
import Data.Maybe (maybe)
import Data.String (toChar)

-- | A type for _foreign data_.
-- |
-- | Foreign data is data from any external _unknown_ or _unreliable_
-- | source, for which it cannot be guaranteed that the runtime representation
-- | conforms to that of any particular type.
-- |
-- | Suitable applications of `Foreign` are
-- |
-- | - To represent responses from web services
-- | - To integrate with external JavaScript libraries.
foreign import data Foreign :: *

-- | A type for foreign type errors
data ForeignError
  = ForeignError String
  | TypeMismatch String String
  | ErrorAtIndex Int ForeignError
  | ErrorAtProperty String ForeignError
  | JSONError String

derive instance eqForeignError :: Eq ForeignError
derive instance ordForeignError :: Ord ForeignError

instance showForeignError :: Show ForeignError where
  show (ForeignError msg) = "(ForeignError " <> msg <> ")"
  show (ErrorAtIndex i e) = "(ErrorAtIndex " <> show i <> " " <> show e <> ")"
  show (ErrorAtProperty prop e) = "(ErrorAtProperty " <> show prop <> " " <> show e <> ")"
  show (JSONError s) = "(JSONError " <> show s <> ")"
  show (TypeMismatch exps act) = "(TypeMismatch " <> show exps <> " " <> show act <> ")"

-- | A type for accumulating multiple `ForeignError`s.
type MultipleErrors = NonEmptyList ForeignError

renderForeignError :: ForeignError -> String
renderForeignError (ForeignError msg) = msg
renderForeignError (ErrorAtIndex i e) = "Error at array index " <> show i <> ": " <> show e
renderForeignError (ErrorAtProperty prop e) = "Error at property " <> show prop <> ": " <> show e
renderForeignError (JSONError s) = "JSON error: " <> s
renderForeignError (TypeMismatch exp act) = "Type mismatch: expected " <> exp <> ", found " <> act

-- | An error monad, used in this library to encode possible failures when
-- | dealing with foreign data.
type F a = Except MultipleErrors a

foreign import parseJSONImpl :: forall r. Fn3 (String -> r) (Foreign -> r) String r

-- | Attempt to parse a JSON string, returning the result as foreign data.
parseJSON :: String -> F Foreign
parseJSON json = runFn3 parseJSONImpl (fail <<< JSONError) pure json

-- | Coerce any value to the a `Foreign` value.
foreign import toForeign :: forall a. a -> Foreign

-- | Unsafely coerce a `Foreign` value.
foreign import unsafeFromForeign :: forall a. Foreign -> a

-- | Read the Javascript _type_ of a value
foreign import typeOf :: Foreign -> String

-- | Read the Javascript _tag_ of a value.
-- |
-- | This function wraps the `Object.toString` method.
foreign import tagOf :: Foreign -> String

-- | Unsafely coerce a `Foreign` value when the value has a particular `tagOf`
-- | value.
unsafeReadTagged :: forall a. String -> Foreign -> F a
unsafeReadTagged tag value
  | tagOf value == tag = pure (unsafeFromForeign value)
  | otherwise = fail $ TypeMismatch tag (tagOf value)

-- | Test whether a foreign value is null
foreign import isNull :: Foreign -> Boolean

-- | Test whether a foreign value is undefined
foreign import isUndefined :: Foreign -> Boolean

-- | Test whether a foreign value is an array
foreign import isArray :: Foreign -> Boolean

-- | Attempt to coerce a foreign value to a `String`.
readString :: Foreign -> F String
readString = unsafeReadTagged "String"

-- | Attempt to coerce a foreign value to a `Char`.
readChar :: Foreign -> F Char
readChar value = mapExcept (either (const error) fromString) (readString value)
  where
  fromString = maybe error pure <<< toChar
  error = Left $ NEL.singleton $ TypeMismatch "Char" (tagOf value)

-- | Attempt to coerce a foreign value to a `Boolean`.
readBoolean :: Foreign -> F Boolean
readBoolean = unsafeReadTagged "Boolean"

-- | Attempt to coerce a foreign value to a `Number`.
readNumber :: Foreign -> F Number
readNumber = unsafeReadTagged "Number"

-- | Attempt to coerce a foreign value to an `Int`.
readInt :: Foreign -> F Int
readInt value = mapExcept (either (const error) fromNumber) (readNumber value)
  where
  fromNumber = maybe error pure <<< Int.fromNumber
  error = Left $ NEL.singleton $ TypeMismatch "Int" (tagOf value)

-- | Attempt to coerce a foreign value to an array.
readArray :: Foreign -> F (Array Foreign)
readArray value
  | isArray value = pure $ unsafeFromForeign value
  | otherwise = fail $ TypeMismatch "array" (tagOf value)

-- | Throws a failure error in `F`.
fail :: forall a. ForeignError -> F a
fail = throwError <<< NEL.singleton

-- | A key/value pair for an object to be written as a `Foreign` value.
newtype Prop = Prop { key :: String, value :: Foreign }

-- | Constructs a JavaScript `Object` value (typed as `Foreign`) from an array
-- | of `Prop`s.
foreign import writeObject :: Array Prop -> Foreign


Update example

Update example

module Main where

import Prelude
import Control.Alt ((<|>))
import Control.Monad.Aff (liftEff', launchAff, delay)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.Exception (EXCEPTION)
import Control.Monad.Eff.Ref (REF)
import DOM (DOM)
import DOM.HTML.Types (HISTORY)
import Data.Maybe (fromMaybe)
import Data.Time.Duration (Milliseconds(..))
import Data.Tuple.Nested ((/\))
import Rout (match, lit, int, end)
import VOM (VNode, h, t, (:=), (~>), stringTo, noneTo)
import Cherry (mount)
import Cherry.Store as S
import Cherry.Renderer as R
import Cherry.Router (router, navigateTo, goBack)
import PureStyle (getStyle)
import Style (sheet, link)

-- Initialize app
main :: Eff (dom :: DOM, console :: CONSOLE, ref :: REF, exception :: EXCEPTION, history :: HISTORY) Unit
main = do
  renderer <- R.createRenderer "#app" view
  mount store renderer [ route ]

-- Initialize core

store :: forall e. S.Store (ref :: REF | e) State
store = S.createStore initialState

select :: forall e a. (State -> a) -> Eff (ref :: REF | e) a
select = S.select store

reduce :: forall e. (State -> State) -> Eff (ref :: REF | e) Unit
reduce = S.reduce store

-- Router

data Route
  = Home
  | Item Int
  | NotFound

detectRoute :: String -> Route
detectRoute url = fromMaybe NotFound $ match url $
  Home <$ end
  <|>
  Item <$> (lit "items" *> int) <* end

route :: forall e. Eff (dom :: DOM, ref :: REF | e) Unit
route = router (\url -> reduce (\s -> s { route = detectRoute url }))

-- View

view :: forall e. State -> VNode (exception :: EXCEPTION, dom :: DOM, history :: HISTORY, ref :: REF, console :: CONSOLE | e)
view state =
  h "div" []
    [ scene
    , style
    ]
  where
    scene =
      case state.route of
        Home -> home state.message
        Item id -> item id state.count
        NotFound -> notFound

style :: forall e. VNode e
style = h "style" [] [ t styleStr ]
  where
    styleStr = getStyle sheet

home :: forall e. String -> VNode (dom :: DOM, console :: CONSOLE, ref :: REF, history :: HISTORY | e)
home message =
  h "div" []
    [ h "h1" [] [ t "Home" ]
    , h "div" [] [ t message ]
    , h "input"
        [ "type" := "text"
        , "value" := message
        , "onInput" ~> stringTo changeMessage
        ]
        []
    , h "a" [ "class" := link, "onClick" ~> (noneTo $ navigateTo "/items/1") ] [ t "Item 1 " ]
    , h "a" [ "class" := link, "onClick" ~> (noneTo $ navigateTo "/items/2") ] [ t "Item 2 " ]
    , h "a" [ "class" := link, "onClick" ~> (noneTo $ navigateTo "/not_found") ] [ t "404 Not Found" ]
    ]

item :: forall e. Int -> Int -> VNode (dom :: DOM, exception :: EXCEPTION, ref :: REF, history :: HISTORY | e)
item id count =
  h "div" []
    [ h "h1" [] [ t $ "Item " <> show id ]
    , h "div" [ "onClick" ~> noneTo increment ] [ t $ show (count :: Int) ]
    , h "a" [ "onClick" ~> noneTo goBack ] [ t "Back" ]
    ]

notFound :: forall e. VNode e
notFound =
  h "div" []
    [ h "h1" [ "style" := "color: red;" ] [ t "404" ]
    , h "a" [ "href" := "https://github.com/oreshinya/purescript-cherry", "target" := "_blank" ] [ t "Github" ]
    ]

-- Action

increment :: forall e. Eff (ref :: REF, exception :: EXCEPTION | e) Unit
increment = do
  _ <- launchAff $ do
    delay $ Milliseconds 1500.0
    liftEff' $ reduce incr
  pure unit

changeMessage :: forall e. String -> Eff (console :: CONSOLE, ref :: REF | e) Unit
changeMessage content = do
  reduce $ updateMsg content
  cnt <- select _.count
  reduce \s -> s { count = cnt + 1 }
  log "bar"

-- Reducer

incr :: State -> State
incr s = s { count = s.count + 1 }

updateMsg :: String -> State -> State
updateMsg content s = s { message = content }

-- State

type State =
  { route :: Route
  , count :: Int
  , message :: String
  }

initialState :: State
initialState =
  { route: Home
  , count: 0
  , message: ""
  }

module Main where

import Prelude
import Control.Alt ((<|>))
import Control.Monad.Aff (liftEff', launchAff, delay)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.Exception (EXCEPTION)
import Control.Monad.Eff.Ref (REF)
import DOM (DOM)
import DOM.HTML.Types (HISTORY)
import Data.Maybe (fromMaybe)
import Data.Time.Duration (Milliseconds(..))
import Data.Tuple.Nested ((/\))
import Rout (match, lit, int, end)
import VOM (VNode, h, t, (:=), (:|), (~>), stringTo, noneTo)
import Cherry (mount)
import Cherry.Store as S
import Cherry.Renderer as R
import Cherry.Router (router, navigateTo, goBack)
import PureStyle (getStyle)
import Style (sheet, link)

-- Initialize app
main :: Eff (dom :: DOM, console :: CONSOLE, ref :: REF, exception :: EXCEPTION, history :: HISTORY) Unit
main = do
  renderer <- R.createRenderer "#app" view
  mount store renderer [ route ]

-- Initialize core

store :: forall e. S.Store (ref :: REF | e) State
store = S.createStore initialState

select :: forall e a. (State -> a) -> Eff (ref :: REF | e) a
select = S.select store

reduce :: forall e. (State -> State) -> Eff (ref :: REF | e) Unit
reduce = S.reduce store

-- Router

data Route
  = Home
  | Item Int
  | NotFound

detectRoute :: String -> Route
detectRoute url = fromMaybe NotFound $ match url $
  Home <$ end
  <|>
  Item <$> (lit "items" *> int) <* end

route :: forall e. Eff (dom :: DOM, ref :: REF | e) Unit
route = router (\url -> reduce (\s -> s { route = detectRoute url }))

-- View

view :: forall e. State -> VNode (exception :: EXCEPTION, dom :: DOM, history :: HISTORY, ref :: REF, console :: CONSOLE | e)
view state =
  h "div" []
    [ scene
    , style
    ]
  where
    scene =
      case state.route of
        Home -> home state.message
        Item id -> item id state.count
        NotFound -> notFound

style :: forall e. VNode e
style = h "style" [] [ t styleStr ]
  where
    styleStr = getStyle sheet

home :: forall e. String -> VNode (dom :: DOM, console :: CONSOLE, ref :: REF, history :: HISTORY | e)
home message =
  h "div" []
    [ h "h1" [] [ t "Home" ]
    , h "div" [] [ t message ]
    , h "input"
        [ "type" := "text"
        , "value" := message
        , "onInput" ~> stringTo changeMessage
        ]
        []
    , h "a" [ "class" := link, "onClick" ~> (noneTo $ navigateTo "/items/1") ] [ t "Item 1 " ]
    , h "a" [ "class" := link, "onClick" ~> (noneTo $ navigateTo "/items/2") ] [ t "Item 2 " ]
    , h "a" [ "class" := link, "onClick" ~> (noneTo $ navigateTo "/not_found") ] [ t "404 Not Found" ]
    ]

item :: forall e. Int -> Int -> VNode (dom :: DOM, exception :: EXCEPTION, ref :: REF, history :: HISTORY | e)
item id count =
  h "div" []
    [ h "h1" [] [ t $ "Item " <> show id ]
    , h "div" [ "onClick" ~> noneTo increment ] [ t $ show (count :: Int) ]
    , h "a" [ "onClick" ~> noneTo goBack ] [ t "Back" ]
    ]

notFound :: forall e. VNode e
notFound =
  h "div" []
    [ h "h1" [ "style" :| [ "color" /\ "red" ] ] [ t "404" ]
    , h "a" [ "href" := "https://github.com/oreshinya/purescript-cherry", "target" := "_blank" ] [ t "Github" ]
    ]

-- Action

increment :: forall e. Eff (ref :: REF, exception :: EXCEPTION | e) Unit
increment = do
  _ <- launchAff $ do
    delay $ Milliseconds 1500.0
    liftEff' $ reduce incr
  pure unit

changeMessage :: forall e. String -> Eff (console :: CONSOLE, ref :: REF | e) Unit
changeMessage content = do
  reduce $ updateMsg content
  cnt <- select _.count
  reduce \s -> s { count = cnt + 1 }
  log "bar"

-- Reducer

incr :: State -> State
incr s = s { count = s.count + 1 }

updateMsg :: String -> State -> State
updateMsg content s = s { message = content }

-- State

type State =
  { route :: Route
  , count :: Int
  , message :: String
  }

initialState :: State
initialState =
  { route: Home
  , count: 0
  , message: ""
  }


license dialog classes

license dialog classes

{-
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.Dialog.License where

import SlamData.Prelude

import Halogen.HTML as H
import Halogen.HTML.Properties as HP

import SlamData.Render.ClassName as CN
import SlamData.Dialog.Render as DR

data LaunchedBy = App | Other

licenseDialogClasses ∷ Array H.ClassName
licenseDialogClasses =
  [ CN.dialog, H.ClassName "license-dialog" ]

advancedLicenseExpired ∷ ∀ f p. H.HTML p (f Unit)
advancedLicenseExpired =
  H.div
    [ HP.classes licenseDialogClasses ]
    [ H.div_
        [ H.img [ HP.src "img/logo-center.svg" ]
        , DR.modalHeader "Your license has expired"
        , DR.modalBody
            $ H.div_
                [ H.p_
                    [ H.text "Thanks for using SlamData Advanced!" ]
                , H.p_
                    [ H.text "Get in touch with us today to purchase SlamData Advanced or an extended trial period with raining for your team, configuration and optimization assistance and support ith queries, sharing and distribution." ]
              ]
        , DR.modalFooter
            [ H.a
                [ HP.classes [ CN.btn, CN.btnPrimary ]
                , HP.href "https://slamdata.com/contact-us/"
                ]
                [ H.text "Contact SlamData" ]
            , H.a
                [ HP.classes [ CN.btn, CN.btnDefault ]
                , HP.href "https://slamdata.com/slamdata-jump-start/"
                ]
                [ H.text "Request training" ]
            ]
        ]
  ]

advancedTrialLicenseExpired ∷ ∀ f p. H.HTML p (f Unit)
advancedTrialLicenseExpired =
  H.div
    [ HP.classes licenseDialogClasses ]
    [ H.div_
        [ H.img [ HP.src "img/logo-center.svg" ]
        , DR.modalHeader "Your trial has expired"
        , DR.modalBody
            $ H.div_
                [ H.p_
                    [ H.text "Thanks for trying SlamData Advanced!" ]
                , H.p_
                    [ H.text "Get in touch with us today to purchase a SlamData license or an extended trial period with training for your team, configuration, query optimization and support." ]
              ]
        , DR.modalFooter
            [ H.a
                [ HP.classes [ CN.btn, CN.btnPrimary ]
                , HP.href "https://slamdata.com/contact-us/"
                ]
                [ H.text "Contact SlamData" ]
            , H.a
                [ HP.classes [ CN.btn, CN.btnDefault ]
                , HP.href "https://slamdata.com/slamdata-jump-start/"
                ]
                [ H.text "Request training" ]
            ]
        ]
  ]

licenseInvalid ∷ ∀ f p. H.HTML p (f Unit)
licenseInvalid =
  H.div
    [ HP.classes licenseDialogClasses ]
    [ H.div_
        [ H.img [ HP.src "img/logo-center.svg" ]
        , DR.modalHeader "Your license is invalid"
        , DR.modalBody
            $ H.div_
                [ H.p_
                    [ H.text
                        $ "Try double checking your license information and "
                        <> howToFix App
                        <> " before restarting SlamData. If you are still experiencing problems with your license after trying this please contact support." ]
              ]
        , DR.modalFooter
            [ H.a
                [ HP.classes [ CN.btn, CN.btnPrimary ]
                , HP.href "https://slamdata.com/contact-us/"
                ]
                [ H.text "Contact SlamData" ]
            , H.a
                [ HP.classes [ CN.btn, CN.btnDefault ]
                , HP.href "https://slamdata.com/slamdata-jump-start/"
                ]
                [ H.text "Request training" ]
            ]
        ]
    ]
  where
  howToFix ∷ LaunchedBy → String
  howToFix = case _ of
    App → "reinstalling"
    Other → "providing your Java system properties"

{-
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.Dialog.License where

import SlamData.Prelude

import Halogen.HTML as H
import Halogen.HTML.Properties as HP

import SlamData.Render.ClassName as CN
import SlamData.Dialog.Render as DR

data LaunchedBy = App | Other

advancedLicenseExpired ∷ ∀ f p. H.HTML p (f Unit)
advancedLicenseExpired =
  H.div
    [ HP.classes [ H.ClassName "deck-dialog", H.ClassName "license-dialog" ] ]
    [ H.div_
        [ H.img [ HP.src "img/logo-center.svg" ]
        , DR.modalHeader "Your license has expired"
        , DR.modalBody
            $ H.div_
                [ H.p_
                    [ H.text "Thanks for using SlamData Advanced!" ]
                , H.p_
                    [ H.text "Get in touch with us today to purchase SlamData Advanced or an extended trial period with raining for your team, configuration and optimization assistance and support ith queries, sharing and distribution." ]
              ]
        , DR.modalFooter
            [ H.a
                [ HP.classes [ CN.btn, CN.btnPrimary ]
                , HP.href "https://slamdata.com/contact-us/"
                ]
                [ H.text "Contact SlamData" ]
            , H.a
                [ HP.classes [ CN.btn, CN.btnDefault ]
                , HP.href "https://slamdata.com/slamdata-jump-start/"
                ]
                [ H.text "Request training" ]
            ]
        ]
  ]

advancedTrialLicenseExpired ∷ ∀ f p. H.HTML p (f Unit)
advancedTrialLicenseExpired =
  H.div
    [ HP.classes [ H.ClassName "deck-dialog", H.ClassName "license-dialog" ] ]
    [ H.div_
        [ H.img [ HP.src "img/logo-center.svg" ]
        , DR.modalHeader "Your trial has expired"
        , DR.modalBody
            $ H.div_
                [ H.p_
                    [ H.text "Thanks for trying SlamData Advanced!" ]
                , H.p_
                    [ H.text "Get in touch with us today to purchase a SlamData license or an extended trial period with training for your team, configuration, query optimization and support." ]
              ]
        , DR.modalFooter
            [ H.a
                [ HP.classes [ CN.btn, CN.btnPrimary ]
                , HP.href "https://slamdata.com/contact-us/"
                ]
                [ H.text "Contact SlamData" ]
            , H.a
                [ HP.classes [ CN.btn, CN.btnDefault ]
                , HP.href "https://slamdata.com/slamdata-jump-start/"
                ]
                [ H.text "Request training" ]
            ]
        ]
  ]

licenseInvalid ∷ ∀ f p. H.HTML p (f Unit)
licenseInvalid =
  H.div
    [ HP.classes [ H.ClassName "deck-dialog", H.ClassName "license-dialog" ] ]
    [ H.div_
        [ H.img [ HP.src "img/logo-center.svg" ]
        , DR.modalHeader "Your license is invalid"
        , DR.modalBody
            $ H.div_
                [ H.p_
                    [ H.text
                        $ "Try double checking your license information and "
                        <> howToFix App
                        <> " before restarting SlamData. If you are still experiencing problems with your license after trying this please contact support." ]
              ]
        , DR.modalFooter
            [ H.a
                [ HP.classes [ CN.btn, CN.btnPrimary ]
                , HP.href "https://slamdata.com/contact-us/"
                ]
                [ H.text "Contact SlamData" ]
            , H.a
                [ HP.classes [ CN.btn, CN.btnDefault ]
                , HP.href "https://slamdata.com/slamdata-jump-start/"
                ]
                [ H.text "Request training" ]
            ]
        ]
    ]
  where
  howToFix ∷ LaunchedBy → String
  howToFix = case _ of
    App → "reinstalling"
    Other → "providing your Java system properties"


Improve pretty printing of option

Improve pretty printing of option

module Neodoc.Data.SolvedLayout where

import Prelude
import Data.Generic
import Data.Either (Either(..))
import Data.Pretty (class Pretty, pretty)
import Data.Maybe (Maybe(..), maybe)
import Data.Bifunctor (lmap)
import Data.Tuple.Nested ((/\))
import Data.Foldable (intercalate, all)
import Data.String as String
import Data.List (List)
import Data.String (singleton) as String
import Data.NonEmpty (NonEmpty)
import Data.Foreign as F
import Data.Foreign.Class as F
import Data.Foreign.Index as F
import Data.Foreign.Index ((!))
import Data.Foreign.Class
import Data.Foreign.Extra as F
import Neodoc.Data.Layout
import Neodoc.OptionAlias
import Neodoc.ArgKey (ArgKey(..))
import Neodoc.ArgKey.Class (class ToArgKey)
import Neodoc.Data.OptionArgument
import Data.Function (on)

-- This type can be specialized for elements of a usage section
type SolvedLayout = Layout SolvedLayoutArg
data SolvedLayoutArg
  = Command     String Boolean
  | Positional  String Boolean
  | Option      OptionAlias (Maybe OptionArgument) Boolean
  | EOA
  | Stdin

derive instance eqSolvedLayoutArg :: Eq SolvedLayoutArg
derive instance ordSolvedLayoutArg :: Ord SolvedLayoutArg
derive instance genericSolvedLayoutArg :: Generic SolvedLayoutArg

instance showSolvedLayoutArg :: Show SolvedLayoutArg where
  show = gShow

instance toArgKeySolvedLayoutArg :: ToArgKey SolvedLayoutArg where
  toArgKey (Command     n   _) = CommandKey n
  toArgKey (Positional  n   _) = PositionalKey n
  toArgKey (Option      a _ _) = OptionKey a
  toArgKey (EOA              ) = EOAKey
  toArgKey (Stdin            ) = StdinKey

instance prettySolvedLayoutArg :: Pretty SolvedLayoutArg where
  pretty = go
    where
    go (Command n r) = n <> rep r
    go (Positional n r) = n <> rep r
    go EOA = "--"
    go Stdin = "-"
    go (Option n mA r) = pretty n <> maybe "" prettyOA mA <> rep r
    rep r = if r then "..." else ""
    prettyOA (OptionArgument n o)
      = (if o then "[=" else "=") <> n <> (if o then "]" else "")

instance asForeignSolvedLayoutArg :: AsForeign SolvedLayoutArg where
  write (Command n r) = F.toForeign {
      type: "Command"
    , name: F.write n
    , repeatable: F.write r
    }
  write (Positional n r) = F.toForeign {
      type: "Positional"
    , name: F.write n
    , repeatable: F.write r
    }
  write (Option n mArg r) = F.toForeign {
      type: "Option"
    , name: F.write n
    , argument: maybe F.undefined F.write mArg
    , repeatable: F.write r
    }
  write Stdin = F.toForeign { type: "Stdin" }
  write EOA = F.toForeign { type: "EOA" }

instance isForeignSolvedLayoutArg :: IsForeign SolvedLayoutArg where
  read v = do
    typ :: String <- String.toUpper <$> F.readProp "type" v

    case typ of
      "EOA" -> pure EOA
      "STDIN" -> pure Stdin
      "COMMAND" ->
        Command
          <$> F.readProp "name"       v
          <*> F.readProp "repeatable" v
      "POSITIONAL" ->
        Positional
          <$> F.readProp "name"       v
          <*> F.readProp "repeatable" v
      "OPTION" ->
        Option
          <$> F.readProp "name" v
          <*> F.readPropMaybe "argument" v
          <*> F.readProp "repeatable" v
      _ -> Left $ F.errorAt "type" (F.JSONError $ "unknown type: " <> typ)

isRepeatable :: SolvedLayout -> Boolean
isRepeatable (Group           _ r _) = r
isRepeatable (Elem (Command    _ r)) = r
isRepeatable (Elem (Positional _ r)) = r
isRepeatable (Elem (Option   _ _ r)) = r
isRepeatable _ = false

setRepeatable :: Boolean -> SolvedLayout -> SolvedLayout
setRepeatable r (Group           o _ xs) = Group o r xs
setRepeatable r (Elem (Command     n _)) = Elem (Command n r)
setRepeatable r (Elem (Positional  n _)) = Elem (Positional n r)
setRepeatable r (Elem (Option   a mA _)) = Elem (Option a mA r)
setRepeatable _ x = x

setRepeatableOr :: Boolean -> SolvedLayout -> SolvedLayout
setRepeatableOr r (Group           o r' xs) = Group o (r || r') xs
setRepeatableOr r (Elem (Command     n r')) = Elem (Command n (r || r'))
setRepeatableOr r (Elem (Positional  n r')) = Elem (Positional n (r || r'))
setRepeatableOr r (Elem (Option   a mA r')) = Elem (Option a mA (r || r'))
setRepeatableOr _ x = x

isOptional :: SolvedLayout -> Boolean
isOptional (Group o _ _) = o
isOptional _ = false

isPositional :: SolvedLayoutArg -> Boolean
isPositional (Positional _ _) = true
isPositional _ = false

isCommand :: SolvedLayoutArg -> Boolean
isCommand (Command _ _) = true
isCommand _ = false

isOption :: SolvedLayoutArg -> Boolean
isOption (Option _ _ _) = true
isOption _ = false

isFlag :: SolvedLayoutArg -> Boolean
isFlag (Option _ Nothing _) = true
isFlag _ = false

isGroup :: SolvedLayout -> Boolean
isGroup (Group _ _ _) = true
isGroup _ = false

-- Is this layout considered "free"?
isFreeLayout :: SolvedLayout -> Boolean
isFreeLayout (Elem (Option _ _ _)) = true
isFreeLayout (Elem _) = false
isFreeLayout (Group _ _ xs) = all (all isFreeLayout) xs

module Neodoc.Data.SolvedLayout where

import Prelude
import Data.Generic
import Data.Either (Either(..))
import Data.Pretty (class Pretty, pretty)
import Data.Maybe (Maybe(..), maybe)
import Data.Bifunctor (lmap)
import Data.Tuple.Nested ((/\))
import Data.Foldable (intercalate, all)
import Data.String as String
import Data.List (List)
import Data.String (singleton) as String
import Data.NonEmpty (NonEmpty)
import Data.Foreign as F
import Data.Foreign.Class as F
import Data.Foreign.Index as F
import Data.Foreign.Index ((!))
import Data.Foreign.Class
import Data.Foreign.Extra as F
import Neodoc.Data.Layout
import Neodoc.OptionAlias
import Neodoc.ArgKey (ArgKey(..))
import Neodoc.ArgKey.Class (class ToArgKey)
import Neodoc.Data.OptionArgument
import Data.Function (on)

-- This type can be specialized for elements of a usage section
type SolvedLayout = Layout SolvedLayoutArg
data SolvedLayoutArg
  = Command     String Boolean
  | Positional  String Boolean
  | Option      OptionAlias (Maybe OptionArgument) Boolean
  | EOA
  | Stdin

derive instance eqSolvedLayoutArg :: Eq SolvedLayoutArg
derive instance ordSolvedLayoutArg :: Ord SolvedLayoutArg
derive instance genericSolvedLayoutArg :: Generic SolvedLayoutArg

instance showSolvedLayoutArg :: Show SolvedLayoutArg where
  show = gShow

instance toArgKeySolvedLayoutArg :: ToArgKey SolvedLayoutArg where
  toArgKey (Command     n   _) = CommandKey n
  toArgKey (Positional  n   _) = PositionalKey n
  toArgKey (Option      a _ _) = OptionKey a
  toArgKey (EOA              ) = EOAKey
  toArgKey (Stdin            ) = StdinKey

instance prettySolvedLayoutArg :: Pretty SolvedLayoutArg where
  pretty = go
    where
    go (Command n r) = n <> rep r
    go (Positional n r) = n <> rep r
    go EOA = "--"
    go Stdin = "-"
    go (Option n mA r) = pretty n <> maybe "" pretty mA <> rep r
    rep r = if r then "..." else ""

instance asForeignSolvedLayoutArg :: AsForeign SolvedLayoutArg where
  write (Command n r) = F.toForeign {
      type: "Command"
    , name: F.write n
    , repeatable: F.write r
    }
  write (Positional n r) = F.toForeign {
      type: "Positional"
    , name: F.write n
    , repeatable: F.write r
    }
  write (Option n mArg r) = F.toForeign {
      type: "Option"
    , name: F.write n
    , argument: maybe F.undefined F.write mArg
    , repeatable: F.write r
    }
  write Stdin = F.toForeign { type: "Stdin" }
  write EOA = F.toForeign { type: "EOA" }

instance isForeignSolvedLayoutArg :: IsForeign SolvedLayoutArg where
  read v = do
    typ :: String <- String.toUpper <$> F.readProp "type" v

    case typ of
      "EOA" -> pure EOA
      "STDIN" -> pure Stdin
      "COMMAND" ->
        Command
          <$> F.readProp "name"       v
          <*> F.readProp "repeatable" v
      "POSITIONAL" ->
        Positional
          <$> F.readProp "name"       v
          <*> F.readProp "repeatable" v
      "OPTION" ->
        Option
          <$> F.readProp "name" v
          <*> F.readPropMaybe "argument" v
          <*> F.readProp "repeatable" v
      _ -> Left $ F.errorAt "type" (F.JSONError $ "unknown type: " <> typ)

isRepeatable :: SolvedLayout -> Boolean
isRepeatable (Group           _ r _) = r
isRepeatable (Elem (Command    _ r)) = r
isRepeatable (Elem (Positional _ r)) = r
isRepeatable (Elem (Option   _ _ r)) = r
isRepeatable _ = false

setRepeatable :: Boolean -> SolvedLayout -> SolvedLayout
setRepeatable r (Group           o _ xs) = Group o r xs
setRepeatable r (Elem (Command     n _)) = Elem (Command n r)
setRepeatable r (Elem (Positional  n _)) = Elem (Positional n r)
setRepeatable r (Elem (Option   a mA _)) = Elem (Option a mA r)
setRepeatable _ x = x

setRepeatableOr :: Boolean -> SolvedLayout -> SolvedLayout
setRepeatableOr r (Group           o r' xs) = Group o (r || r') xs
setRepeatableOr r (Elem (Command     n r')) = Elem (Command n (r || r'))
setRepeatableOr r (Elem (Positional  n r')) = Elem (Positional n (r || r'))
setRepeatableOr r (Elem (Option   a mA r')) = Elem (Option a mA (r || r'))
setRepeatableOr _ x = x

isOptional :: SolvedLayout -> Boolean
isOptional (Group o _ _) = o
isOptional _ = false

isPositional :: SolvedLayoutArg -> Boolean
isPositional (Positional _ _) = true
isPositional _ = false

isCommand :: SolvedLayoutArg -> Boolean
isCommand (Command _ _) = true
isCommand _ = false

isOption :: SolvedLayoutArg -> Boolean
isOption (Option _ _ _) = true
isOption _ = false

isFlag :: SolvedLayoutArg -> Boolean
isFlag (Option _ Nothing _) = true
isFlag _ = false

isGroup :: SolvedLayout -> Boolean
isGroup (Group _ _ _) = true
isGroup _ = false

-- Is this layout considered "free"?
isFreeLayout :: SolvedLayout -> Boolean
isFreeLayout (Elem (Option _ _ _)) = true
isFreeLayout (Elem _) = false
isFreeLayout (Group _ _ xs) = all (all isFreeLayout) xs