fixes #1693

fixes #1693

{-
Copyright 2016 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.Setups.Inputs where

import SlamData.Prelude

import Data.Argonaut as J
import Data.Array as Array
import Data.Lens ((^.))
import Data.List as List

import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.HTML.Properties.ARIA as ARIA
import Halogen.Themes.Bootstrap3 as B

import SlamData.Form.Select (Select(..), stringVal, class OptionVal)
import SlamData.Render.Icon as I
import SlamData.Workspace.Card.Setups.Dimension as D
import SlamData.Workspace.Card.Setups.DimensionPicker.Component as DPC
import SlamData.Workspace.Card.Setups.DimensionPicker.JCursor (groupJCursors, showJCursorTip)
import SlamData.Workspace.Card.Setups.Transform as T

import Utils (showPrettyJCursor)
import Utils.DOM as DOM

type Select' a = Boolean × Select a

data SelectAction a
  = Open (Array a)
  | Choose (Maybe a)

type PickerConfig a i =
  SelectConfig
    ( showValue ∷ a → String
    , query ∷ SelectAction a → H.Action i
    )

type PickerOptions a f =
  { options ∷ Array a
  , select ∷ f (Const Unit)
  }

type AggregationConfig a i =
  SelectConfig
    ( query ∷ SelectAction a → H.Action i
    )

type SelectConfig r =
  { disableWhen ∷ Int → Boolean
  , defaultWhen ∷ Int → Boolean
  , ariaLabel ∷ Maybe String
  , defaultOption ∷ String
  | r
  }

primary
  ∷ ∀ i
  . Maybe String
  → (SelectAction J.JCursor → H.Action i)
  → PickerConfig J.JCursor i
primary lbl =
  { disableWhen: (_ < 2)
  , defaultWhen: (_ < 1)
  , ariaLabel: lbl
  , defaultOption: "Choose " ⊕ fromMaybe "source" lbl
  , showValue: showPrettyJCursor
  , query: _
  }

secondary
  ∷ ∀ i
  . Maybe String
  → (SelectAction J.JCursor → H.Action i)
  → PickerConfig J.JCursor i
secondary lbl =
  { disableWhen: (_ < 1)
  , defaultWhen: const true
  , ariaLabel: lbl
  , defaultOption: "Choose " ⊕ fromMaybe "source" lbl
  , showValue: show
  , query: _
  }

dropdown
  ∷ ∀ a i
  . OptionVal a
  ⇒ Maybe String
  → (SelectAction a → H.Action i)
  → PickerConfig a i
dropdown =
  { disableWhen: (_ < 1)
  , defaultWhen: const false
  , ariaLabel: _
  , defaultOption: ""
  , showValue: stringVal
  , query: _
  }

aggregation ∷ ∀ a i. OptionVal a ⇒ Maybe String → (SelectAction a → H.Action i) → PickerConfig a i
aggregation =
  { disableWhen: (_ < 1)
  , defaultWhen: const false
  , ariaLabel: _
  , defaultOption: ""
  , showValue: stringVal
  , query: _
  }

pickerInput
  ∷ ∀ a i p
  . PickerConfig a i
  → Select a
  → H.HTML p i
pickerInput conf (Select { options, value }) =
  let
    len = Array.length options
    isDefault = isNothing value
    isDisabled = conf.disableWhen len
  in
   HH.div [ HP.classes [ HH.ClassName "sd-picker-input" ] ]
     [ HH.button
         ([ HP.classes
            $ [ B.formControl, HH.ClassName "sd-picker-main-button" ]
            ⊕ ( HH.ClassName "default" <$ guard isDefault )
          , HP.disabled isDisabled
          , ARIA.label (fromMaybe "" conf.ariaLabel)
          ]
          <> (HE.onClick (HE.input_ (conf.query (Open options))) <$ guard (not isDisabled)))
         ( foldMap (pure ∘ HH.p_ ∘ pure ∘ HH.text ∘ flip append ":") (value *> conf.ariaLabel)
           ⊕ [ HH.text (maybe conf.defaultOption conf.showValue (guard (not isDefault) *> value)) ]
         )
     , if conf.defaultWhen len && not isDefault
          then
            HH.button
              [ HP.classes [ HH.ClassName "sd-dismiss-button" ]
              , HE.onClick (HE.input_ (conf.query (Choose Nothing)))
              , HP.disabled isDisabled
              ]
              [ HH.text "×" ]
          else
            HH.text ""
      ]

selectInput
  ∷ ∀ a i p
  . Eq a
  ⇒ PickerConfig a i
  → Select a
  → H.HTML p i
selectInput conf (Select { options, value }) =
  let
    len = Array.length options
    defaultWhen = conf.defaultWhen len
    isDefault = isNothing value
    isDisabled = conf.disableWhen len
    renderedOptions = map renderOption options
  in
    HH.select
      [ HP.classes [ B.formControl ]
      , HP.disabled isDisabled
      , HE.onSelectedIndexChange \ix →
          case defaultWhen, ix of
            true, 0 → Just (conf.query (Choose Nothing) unit)
            true, _ → Array.index options (ix - 1) <#> \val → conf.query (Choose (Just val)) unit
            _   , _ → Array.index options ix <#> \val → conf.query (Choose (Just val)) unit
      ]
      if defaultWhen
        then
          [ HH.option
              [ HP.selected isDefault ]
              [ HH.text conf.defaultOption ]
          ] ⊕ renderedOptions
        else
          renderedOptions

  where
  renderOption option =
    HH.option
      [ HP.selected (Just option ≡ value) ]
      [ HH.text (conf.showValue option) ]

pickerWithSelect
  ∷ ∀ a b i p
  . Eq b
  ⇒ PickerConfig a i
  → Select a
  → PickerConfig b i
  → Select b
  → H.HTML p i
pickerWithSelect conf1 sel1@(Select { options, value }) conf2 sel2 =
  let
    isDisabled = conf1.disableWhen (Array.length options)
  in
    HH.div [ HP.classes [ HH.ClassName "sd-picker-with-select" ] ]
      [ pickerInput conf1 sel1
      , if isDisabled
          then selectInput (conf2 { disableWhen = const true }) sel2
          else selectInput conf2 sel2
      ]

dimensionPicker ∷ ∀ f. Foldable f ⇒ f (J.JCursor) → String → DPC.PickerOptions (Either J.JCursor J.JCursor)
dimensionPicker options title =
  { title
  , label: DPC.labelNode showJCursorTip
  , render: DPC.renderNode showJCursorTip
  , values: groupJCursors (List.fromFoldable options)
  , isSelectable: DPC.isLeafPath
  }

type DimensionOptions a b i =
  { configurable ∷ Boolean
  , dimension ∷ D.Dimension a b
  , showLabel ∷ a → String
  , showDefaultLabel ∷ b → String
  , showValue ∷ b → String
  , onLabelChange ∷ String → Maybe (i Unit)
  , onDismiss ∷ DOM.MouseEvent → Maybe (i Unit)
  , onConfigure ∷ DOM.MouseEvent → Maybe (i Unit)
  , onMouseDown ∷ DOM.MouseEvent → Maybe (i Unit)
  , onClick ∷ DOM.MouseEvent → Maybe (i Unit)
  , onLabelClick ∷ DOM.MouseEvent → Maybe (i Unit)
  , disabled ∷ Boolean
  , dismissable ∷ Boolean
  }

dimensionButton ∷ ∀ a b p i . DimensionOptions a b i → H.HTML p i
dimensionButton opts =
  HH.div
    [ HP.classes
        $ [ HH.ClassName "sd-dimension-button" ]
        ⊕ ( guard opts.disabled $> HH.ClassName "sd-dimension-button-disabled")
    ]
    [ HH.div
        [ HP.classes [ HH.ClassName "sd-dimension-button-label" ] ]
        [ HH.input
            [ HP.type_ HP.InputText
            , HP.disabled opts.disabled
            , HP.value labelText
            , HE.onValueInput opts.onLabelChange
            , HE.onClick opts.onLabelClick
            , HP.placeholder defaultLabel
            ]
        ]
    , HH.div
        [ HP.classes [ HH.ClassName "sd-dimension-button-toolbar" ] ]
        $ ( guard opts.dismissable $>
          ( HH.button
            [ HP.classes [ HH.ClassName "sd-dismiss-button" ]
            , HP.title "Dismiss"
            , ARIA.label "Dismiss"
            , HE.onClick opts.onDismiss
            , HP.disabled opts.disabled
            ]
            [ HH.text "×"]
          ) )
        ⊕ [ if opts.configurable && not (D.isStatic value)
            then
              HH.button
                [ HP.classes
                    [ HH.ClassName "sd-configure-button"
                    , HH.ClassName "sd-discrete-button"
                    ]
                , HP.title "Configure"
                , ARIA.label "Configure"
                , HE.onClick opts.onConfigure
                , HP.disabled opts.disabled
                ]
                [ I.cog ]
            else HH.text ""
          ]
    , HH.button
        [ HP.classes [ HH.ClassName "sd-dimension-button-display" ]
        , HE.onMouseDown opts.onMouseDown
        , HE.onClick opts.onClick
        , HP.disabled opts.disabled
        ]
        case value of
          D.Static str → [ renderValue str ]
          D.Projection Nothing v → [ renderValue (opts.showValue v) ]
          D.Projection (Just t) v → [ renderTransform t, renderValue (opts.showValue v) ]
    ]
  where
  value = opts.dimension ^. D._value
  label = opts.dimension ^. D._category

  labelText = case label of
    Just (D.Static str) → str
    _ → ""

  defaultLabel = case value of
    D.Static str → str
    D.Projection _ p → opts.showDefaultLabel p

  renderTransform t =
    HH.span
      [ HP.classes [ HH.ClassName "sd-dimension-button-transform" ] ]
      [ HH.text (T.prettyPrintTransform t) ]

  renderValue v =
    HH.span
      [ HP.classes [ HH.ClassName "sd-dimension-button-value" ] ]
      [ HH.text v ]

{-
Copyright 2016 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.Setups.Inputs where

import SlamData.Prelude

import Data.Argonaut as J
import Data.Array as Array
import Data.Lens ((^.))
import Data.List as List

import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.HTML.Properties.ARIA as ARIA
import Halogen.Themes.Bootstrap3 as B

import SlamData.Form.Select (Select(..), stringVal, class OptionVal)
import SlamData.Render.Icon as I
import SlamData.Workspace.Card.Setups.Dimension as D
import SlamData.Workspace.Card.Setups.DimensionPicker.Component as DPC
import SlamData.Workspace.Card.Setups.DimensionPicker.JCursor (groupJCursors, showJCursor, showJCursorTip)
import SlamData.Workspace.Card.Setups.Transform as T

import Utils.DOM as DOM

type Select' a = Boolean × Select a

data SelectAction a
  = Open (Array a)
  | Choose (Maybe a)

type PickerConfig a i =
  SelectConfig
    ( showValue ∷ a → String
    , query ∷ SelectAction a → H.Action i
    )

type PickerOptions a f =
  { options ∷ Array a
  , select ∷ f (Const Unit)
  }

type AggregationConfig a i =
  SelectConfig
    ( query ∷ SelectAction a → H.Action i
    )

type SelectConfig r =
  { disableWhen ∷ Int → Boolean
  , defaultWhen ∷ Int → Boolean
  , ariaLabel ∷ Maybe String
  , defaultOption ∷ String
  | r
  }

primary
  ∷ ∀ i
  . Maybe String
  → (SelectAction J.JCursor → H.Action i)
  → PickerConfig J.JCursor i
primary lbl =
  { disableWhen: (_ < 2)
  , defaultWhen: (_ < 1)
  , ariaLabel: lbl
  , defaultOption: "Choose " ⊕ fromMaybe "source" lbl
  , showValue: showJCursor
  , query: _
  }

secondary
  ∷ ∀ i
  . Maybe String
  → (SelectAction J.JCursor → H.Action i)
  → PickerConfig J.JCursor i
secondary lbl =
  { disableWhen: (_ < 1)
  , defaultWhen: const true
  , ariaLabel: lbl
  , defaultOption: "Choose " ⊕ fromMaybe "source" lbl
  , showValue: show
  , query: _
  }

dropdown
  ∷ ∀ a i
  . OptionVal a
  ⇒ Maybe String
  → (SelectAction a → H.Action i)
  → PickerConfig a i
dropdown =
  { disableWhen: (_ < 1)
  , defaultWhen: const false
  , ariaLabel: _
  , defaultOption: ""
  , showValue: stringVal
  , query: _
  }

aggregation ∷ ∀ a i. OptionVal a ⇒ Maybe String → (SelectAction a → H.Action i) → PickerConfig a i
aggregation =
  { disableWhen: (_ < 1)
  , defaultWhen: const false
  , ariaLabel: _
  , defaultOption: ""
  , showValue: stringVal
  , query: _
  }

pickerInput
  ∷ ∀ a i p
  . PickerConfig a i
  → Select a
  → H.HTML p i
pickerInput conf (Select { options, value }) =
  let
    len = Array.length options
    isDefault = isNothing value
    isDisabled = conf.disableWhen len
  in
   HH.div [ HP.classes [ HH.ClassName "sd-picker-input" ] ]
     [ HH.button
         ([ HP.classes
            $ [ B.formControl, HH.ClassName "sd-picker-main-button" ]
            ⊕ ( HH.ClassName "default" <$ guard isDefault )
          , HP.disabled isDisabled
          , ARIA.label (fromMaybe "" conf.ariaLabel)
          ]
          <> (HE.onClick (HE.input_ (conf.query (Open options))) <$ guard (not isDisabled)))
         ( foldMap (pure ∘ HH.p_ ∘ pure ∘ HH.text ∘ flip append ":") (value *> conf.ariaLabel)
           ⊕ [ HH.text (maybe conf.defaultOption conf.showValue (guard (not isDefault) *> value)) ]
         )
     , if conf.defaultWhen len && not isDefault
          then
            HH.button
              [ HP.classes [ HH.ClassName "sd-dismiss-button" ]
              , HE.onClick (HE.input_ (conf.query (Choose Nothing)))
              , HP.disabled isDisabled
              ]
              [ HH.text "×" ]
          else
            HH.text ""
      ]

selectInput
  ∷ ∀ a i p
  . Eq a
  ⇒ PickerConfig a i
  → Select a
  → H.HTML p i
selectInput conf (Select { options, value }) =
  let
    len = Array.length options
    defaultWhen = conf.defaultWhen len
    isDefault = isNothing value
    isDisabled = conf.disableWhen len
    renderedOptions = map renderOption options
  in
    HH.select
      [ HP.classes [ B.formControl ]
      , HP.disabled isDisabled
      , HE.onSelectedIndexChange \ix →
          case defaultWhen, ix of
            true, 0 → Just (conf.query (Choose Nothing) unit)
            true, _ → Array.index options (ix - 1) <#> \val → conf.query (Choose (Just val)) unit
            _   , _ → Array.index options ix <#> \val → conf.query (Choose (Just val)) unit
      ]
      if defaultWhen
        then
          [ HH.option
              [ HP.selected isDefault ]
              [ HH.text conf.defaultOption ]
          ] ⊕ renderedOptions
        else
          renderedOptions

  where
  renderOption option =
    HH.option
      [ HP.selected (Just option ≡ value) ]
      [ HH.text (conf.showValue option) ]

pickerWithSelect
  ∷ ∀ a b i p
  . Eq b
  ⇒ PickerConfig a i
  → Select a
  → PickerConfig b i
  → Select b
  → H.HTML p i
pickerWithSelect conf1 sel1@(Select { options, value }) conf2 sel2 =
  let
    isDisabled = conf1.disableWhen (Array.length options)
  in
    HH.div [ HP.classes [ HH.ClassName "sd-picker-with-select" ] ]
      [ pickerInput conf1 sel1
      , if isDisabled
          then selectInput (conf2 { disableWhen = const true }) sel2
          else selectInput conf2 sel2
      ]

dimensionPicker ∷ ∀ f. Foldable f ⇒ f (J.JCursor) → String → DPC.PickerOptions (Either J.JCursor J.JCursor)
dimensionPicker options title =
  { title
  , label: DPC.labelNode showJCursorTip
  , render: DPC.renderNode showJCursorTip
  , values: groupJCursors (List.fromFoldable options)
  , isSelectable: DPC.isLeafPath
  }

type DimensionOptions a b i =
  { configurable ∷ Boolean
  , dimension ∷ D.Dimension a b
  , showLabel ∷ a → String
  , showDefaultLabel ∷ b → String
  , showValue ∷ b → String
  , onLabelChange ∷ String → Maybe (i Unit)
  , onDismiss ∷ DOM.MouseEvent → Maybe (i Unit)
  , onConfigure ∷ DOM.MouseEvent → Maybe (i Unit)
  , onMouseDown ∷ DOM.MouseEvent → Maybe (i Unit)
  , onClick ∷ DOM.MouseEvent → Maybe (i Unit)
  , onLabelClick ∷ DOM.MouseEvent → Maybe (i Unit)
  , disabled ∷ Boolean
  , dismissable ∷ Boolean
  }

dimensionButton ∷ ∀ a b p i . DimensionOptions a b i → H.HTML p i
dimensionButton opts =
  HH.div
    [ HP.classes
        $ [ HH.ClassName "sd-dimension-button" ]
        ⊕ ( guard opts.disabled $> HH.ClassName "sd-dimension-button-disabled")
    ]
    [ HH.div
        [ HP.classes [ HH.ClassName "sd-dimension-button-label" ] ]
        [ HH.input
            [ HP.type_ HP.InputText
            , HP.disabled opts.disabled
            , HP.value labelText
            , HE.onValueInput opts.onLabelChange
            , HE.onClick opts.onLabelClick
            , HP.placeholder defaultLabel
            ]
        ]
    , HH.div
        [ HP.classes [ HH.ClassName "sd-dimension-button-toolbar" ] ]
        $ ( guard opts.dismissable $>
          ( HH.button
            [ HP.classes [ HH.ClassName "sd-dismiss-button" ]
            , HP.title "Dismiss"
            , ARIA.label "Dismiss"
            , HE.onClick opts.onDismiss
            , HP.disabled opts.disabled
            ]
            [ HH.text "×"]
          ) )
        ⊕ [ if opts.configurable && not (D.isStatic value)
            then
              HH.button
                [ HP.classes
                    [ HH.ClassName "sd-configure-button"
                    , HH.ClassName "sd-discrete-button"
                    ]
                , HP.title "Configure"
                , ARIA.label "Configure"
                , HE.onClick opts.onConfigure
                , HP.disabled opts.disabled
                ]
                [ I.cog ]
            else HH.text ""
          ]
    , HH.button
        [ HP.classes [ HH.ClassName "sd-dimension-button-display" ]
        , HE.onMouseDown opts.onMouseDown
        , HE.onClick opts.onClick
        , HP.disabled opts.disabled
        ]
        case value of
          D.Static str → [ renderValue str ]
          D.Projection Nothing v → [ renderValue (opts.showValue v) ]
          D.Projection (Just t) v → [ renderTransform t, renderValue (opts.showValue v) ]
    ]
  where
  value = opts.dimension ^. D._value
  label = opts.dimension ^. D._category

  labelText = case label of
    Just (D.Static str) → str
    _ → ""

  defaultLabel = case value of
    D.Static str → str
    D.Projection _ p → opts.showDefaultLabel p

  renderTransform t =
    HH.span
      [ HP.classes [ HH.ClassName "sd-dimension-button-transform" ] ]
      [ HH.text (T.prettyPrintTransform t) ]

  renderValue v =
    HH.span
      [ HP.classes [ HH.ClassName "sd-dimension-button-value" ] ]
      [ HH.text v ]


change default sample

change default sample

module DefaultText where

defaultSrc = """
blue = V4F 0 0 1 1
dark = V4F 0.1 0.0 0.2 1
clear = FrameBuffer $ (DepthImage @1 1000, ColorImage @1 dark)   -- ...

triangleRasterCtx = TriangleCtx CullNone PolygonFill NoOffset LastVertex
colorFragmentCtx = AccumulationContext (DepthOp Less True, ColorOp NoBlending (V4B True True True True))

rasterizeWith = Rasterize
triangles = triangleRasterCtx

cubeVertexStream = Fetch "stream4" Triangles (IV4F "position4")
mapFragments s fs = Accumulate colorFragmentCtx PassAll (\a -> FragmentOutRastDepth $ fs a) s clear
transform s f =  Transform (\v -> VertexOut (f v) 1 () (Smooth v)) s

scale t v = v `PrimMul` V4 t t t 1

rotate' v = (Uni $ IM44F "MVP") `PrimMulMatVec` v
const x y = x
x & f = f x

main =             cubeVertexStream         -- cube vertices
    `transform`    (scale 0.5 . rotate')    -- scale them
     &             rasterizeWith triangles  -- rasterize
    `mapFragments` id                       -- set every pixel blue
     &             ScreenOut                -- draw into screen
"""

module DefaultText where

defaultSrc = """
blue = V4F 0 0 1 1
red  = V4F 1 0 0 1
clear = FrameBuffer $ ColorImage @1 red   -- ...

triangleRasterCtx = TriangleCtx CullNone PolygonFill NoOffset LastVertex
colorFragmentCtx = AccumulationContext (ColorOp NoBlending (V4B True True True True))

rasterizeWith = Rasterize
triangles = triangleRasterCtx

cubeVertexStream = Fetch "stream4" Triangles (IV4F "position4")
mapFragments s fs = Accumulate colorFragmentCtx PassAll (\a -> FragmentOut $ fs a) s clear
transform s f =  Transform (\v -> VertexOut (f v) 1 () (Smooth v)) s

scale t v = v `PrimMul` V4 t t t 1

rotate v = (Uni $ IM44F "MVP") `PrimMulMatVec` v

const x y = x
x & f = f x

main =             cubeVertexStream         -- cube vertices
    `transform`    (scale 0.5 . rotate)     -- scale and rotate
     &             rasterizeWith triangles  -- rasterize
    `mapFragments` const blue               -- set every pixel blue
     &             ScreenOut                --  draw into screen
"""


use ternary operator in JavaScript output

module Data.String
  (
    charAt,
    charCodeAt,
    fromCharArray,
    fromChar,
    indexOf,
    indexOf',
    lastIndexOf,
    lastIndexOf',
    length,
    localeCompare,
    replace,
    take,
    drop,
    split,
    toCharArray,
    toLower,
    toUpper,
    trim,
    joinWith
  ) where

  import Data.Maybe
  import Data.Char
  import Data.Function

  foreign import _charAt
    """
    function _charAt(i, s, Just, Nothing) {
      return i >= 0 && i < s.length ? Just(s.charAt(i)) : Nothing;
    }
    """ :: forall a. Fn4 Number String (a -> Maybe a) (Maybe a) (Maybe Char)

  charAt :: Number -> String -> Maybe Char
  charAt n s = runFn4 _charAt n s Just Nothing

  fromChar :: Char -> String
  fromChar = charString

  foreign import _charCodeAt
    """
    function _charCodeAt(i, s, Just, Nothing) {
      return i >= 0 && i < s.length ? Just(s.charCodeAt(i)) : Nothing;
    }
    """ :: forall a. Fn4 Number String (a -> Maybe a) (Maybe a) (Maybe Number)

  charCodeAt :: Number -> String -> Maybe Number
  charCodeAt n s = runFn4 _charCodeAt n s Just Nothing

  foreign import fromCharArray
    """
    function fromCharArray(a) {
      return a.join('');
    }
    """ :: [Char] -> String

  foreign import indexOf
    """
    function indexOf(x) {
      return function(s) {
        return s.indexOf(x);
      };
    }
    """ :: String -> String -> Number

  foreign import indexOf'
    """
    function indexOf$prime(x) {
      return function(startAt) {
        return function(s) {
          return s.indexOf(x, startAt);
        };
      };
    }
    """ :: String -> Number -> String -> Number

  foreign import lastIndexOf
    """
    function lastIndexOf(x) {
      return function(s) {
        return s.lastIndexOf(x);
      };
    }
    """ :: String -> String -> Number

  foreign import lastIndexOf'
    """
    function lastIndexOf$prime(x) {
      return function(startAt) {
        return function(s) {
          return s.lastIndexOf(x, startAt);
        };
      };
    }
    """ :: String -> Number -> String -> Number

  foreign import length
    """
    function length(s) {
      return s.length;
    }
    """ :: String -> Number

  foreign import localeCompare
    """
    function localeCompare(s1) {
      return function(s2) {
        return s1.localeCompare(s2);
      };
    }
    """ :: String -> String -> Number

  foreign import replace
    """
    function replace(s1) {
      return function(s2) {
        return function(s3) {
          return s3.replace(s1, s2);
        };
      };
    }
    """ :: String -> String -> String -> String

  foreign import take
    """
    function take(n) {
      return function(s) {
        return s.substr(0, n);
      };
    }
    """ :: Number -> String -> String

  foreign import drop
    """
    function drop(n) {
      return function(s) {
        return s.substr(n);
      };
    }
    """ :: Number -> String -> String

  foreign import split
    """
    function split(sep) {
      return function(s) {
        return s.split(sep);
      };
    }
    """ :: String -> String -> [String]

  foreign import toCharArray
    """
    function toCharArray(s) {
      return s.split('');
    }
    """ :: String -> [Char]

  foreign import toLower
    """
    function toLower(s) {
      return s.toLowerCase();
    }
    """ :: String -> String

  foreign import toUpper
    """
    function toUpper(s) {
      return s.toUpperCase();
    }
    """ :: String -> String

  foreign import trim
    """
    function trim(s) {
      return s.trim();
    }
    """ :: String -> String

  foreign import joinWith
    """
    function joinWith(s) {
      return function(xs) {
        return xs.join(s);
      };
    }
    """ :: String -> [String] -> String

module Data.String
  (
    charAt,
    charCodeAt,
    fromCharArray,
    fromChar,
    indexOf,
    indexOf',
    lastIndexOf,
    lastIndexOf',
    length,
    localeCompare,
    replace,
    take,
    drop,
    split,
    toCharArray,
    toLower,
    toUpper,
    trim,
    joinWith
  ) where

  import Data.Maybe
  import Data.Char
  import Data.Function

  foreign import _charAt
    """
    function _charAt(i, s, Just, Nothing) {
      if (i < 0 || i >= s.length) return Nothing;
      else return Just(s.charAt(i));
    }
    """ :: forall a. Fn4 Number String (a -> Maybe a) (Maybe a) (Maybe Char)

  charAt :: Number -> String -> Maybe Char
  charAt n s = runFn4 _charAt n s Just Nothing

  fromChar :: Char -> String
  fromChar = charString

  foreign import _charCodeAt
    """
    function _charCodeAt(i, s, Just, Nothing) {
      if (i < 0 || i >= s.length) return Nothing;
      else return Just(s.charCodeAt(i));
    }
    """ :: forall a. Fn4 Number String (a -> Maybe a) (Maybe a) (Maybe Number)

  charCodeAt :: Number -> String -> Maybe Number
  charCodeAt n s = runFn4 _charCodeAt n s Just Nothing

  foreign import fromCharArray
    """
    function fromCharArray(a) {
      return a.join('');
    }
    """ :: [Char] -> String

  foreign import indexOf
    """
    function indexOf(x) {
      return function(s) {
        return s.indexOf(x);
      };
    }
    """ :: String -> String -> Number

  foreign import indexOf'
    """
    function indexOf$prime(x) {
      return function(startAt) {
        return function(s) {
          return s.indexOf(x, startAt);
        };
      };
    }
    """ :: String -> Number -> String -> Number

  foreign import lastIndexOf
    """
    function lastIndexOf(x) {
      return function(s) {
        return s.lastIndexOf(x);
      };
    }
    """ :: String -> String -> Number

  foreign import lastIndexOf'
    """
    function lastIndexOf$prime(x) {
      return function(startAt) {
        return function(s) {
          return s.lastIndexOf(x, startAt);
        };
      };
    }
    """ :: String -> Number -> String -> Number

  foreign import length
    """
    function length(s) {
      return s.length;
    }
    """ :: String -> Number

  foreign import localeCompare
    """
    function localeCompare(s1) {
      return function(s2) {
        return s1.localeCompare(s2);
      };
    }
    """ :: String -> String -> Number

  foreign import replace
    """
    function replace(s1) {
      return function(s2) {
        return function(s3) {
          return s3.replace(s1, s2);
        };
      };
    }
    """ :: String -> String -> String -> String

  foreign import take
    """
    function take(n) {
      return function(s) {
        return s.substr(0, n);
      };
    }
    """ :: Number -> String -> String

  foreign import drop
    """
    function drop(n) {
      return function(s) {
        return s.substr(n);
      };
    }
    """ :: Number -> String -> String

  foreign import split
    """
    function split(sep) {
      return function(s) {
        return s.split(sep);
      };
    }
    """ :: String -> String -> [String]

  foreign import toCharArray
    """
    function toCharArray(s) {
      return s.split('');
    }
    """ :: String -> [Char]

  foreign import toLower
    """
    function toLower(s) {
      return s.toLowerCase();
    }
    """ :: String -> String

  foreign import toUpper
    """
    function toUpper(s) {
      return s.toUpperCase();
    }
    """ :: String -> String

  foreign import trim
    """
    function trim(s) {
      return s.trim();
    }
    """ :: String -> String

  foreign import joinWith
    """
    function joinWith(s) {
      return function(xs) {
        return xs.join(s);
      };
    }
    """ :: String -> [String] -> String


remove comment

remove comment

module Simple.JSON where

import Prelude

import Data.Foreign (F, Foreign, readArray, readBoolean, readChar, readInt, readNumber, readString)
import Data.Foreign.Index (readProp)
import Data.Foreign.JSON (parseJSON)
import Data.Foreign.NullOrUndefined (NullOrUndefined, readNullOrUndefined)
import Data.Record (insert)
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
import Data.Traversable (sequence)
import Type.Equality (class TypeEquals, to)
import Type.Row (class ListToRow, class RowLacks, class RowToList, Cons, Nil, RLProxy(RLProxy), RProxy(..), kind RowList)

-- | Read a JSON string to a type `a` using `F a`. Useful with record types.
readJSON :: forall a
  .  ReadForeign a
  => String
  -> F a
readJSON = readImpl <=< parseJSON

read :: forall a
  .  ReadForeign a
  => Foreign
  -> F a
read = readImpl

-- | A class for reading foreign values to a type
class ReadForeign a where
  readImpl :: Foreign -> F a

instance readForeign :: ReadForeign Foreign where
  readImpl = pure

instance readChar :: ReadForeign Char where
  readImpl = readChar

instance readNumber :: ReadForeign Number where
  readImpl = readNumber

instance readInt :: ReadForeign Int where
  readImpl = readInt

instance readString :: ReadForeign String where
  readImpl = readString

instance readBoolean :: ReadForeign Boolean where
  readImpl = readBoolean

instance readArray :: ReadForeign a => ReadForeign (Array a) where
  readImpl = readElements <=< readArray
    where
      readElements xs = sequence $ readImpl <$> xs

instance readNullOrUndefined :: ReadForeign a => ReadForeign (NullOrUndefined a) where
  readImpl = readNullOrUndefined readImpl

instance readRecord ::
  ( RowToList fields fieldList
  , ReadForeignFields fieldList fields
  , ListToRow fieldList fields
  ) => ReadForeign (Record fields) where
  readImpl = getFields (RLProxy :: RLProxy fieldList) (RProxy :: RProxy fields)

-- | A class for reading foreign values from properties
class ReadForeignFields (xs :: RowList) (row :: # Type) where
  getFields :: RLProxy xs
    -> RProxy row
    -> Foreign
    -> F (Record row)

instance readFieldsCons ::
  ( IsSymbol name
  , ReadForeign ty
  , ReadForeignFields tail tailRow
  , RowLacks name tailRow
  , RowCons name ty tailRow row
  ) => ReadForeignFields (Cons name ty tail) row where
  getFields _ _ obj = do
    value <- readImpl =<< readProp name obj
    rest <- getFields tailP tailRowP obj
    pure $ insert nameP value rest
    where
      nameP = SProxy :: SProxy name
      tailP = RLProxy :: RLProxy tail
      tailRowP = RProxy :: RProxy tailRow
      name = reflectSymbol nameP

instance readFieldsNil ::
  ( TypeEquals {} (Record row)
  ) => ReadForeignFields Nil row where
  getFields _ _ _ =
    pure $ to {}

module Simple.JSON where

import Prelude

import Data.Foreign (F, Foreign, readArray, readBoolean, readChar, readInt, readNumber, readString)
import Data.Foreign.Index (readProp)
import Data.Foreign.JSON (parseJSON)
import Data.Foreign.NullOrUndefined (NullOrUndefined, readNullOrUndefined)
import Data.Record (insert)
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
import Data.Traversable (sequence)
import Type.Equality (class TypeEquals, to)
import Type.Row (class ListToRow, class RowLacks, class RowToList, Cons, Nil, RLProxy(RLProxy), RProxy(..), kind RowList)

-- | Read a JSON string to a type `a` using `F a`. Useful with record types.
readJSON :: forall a
  .  ReadForeign a
  => String
  -> F a
readJSON = readImpl <=< parseJSON

read :: forall a
  .  ReadForeign a
  => Foreign
  -> F a
read = readImpl

-- | A class for reading foreign values to a type. Warning: This class should not be instantiated.
class ReadForeign a where
  readImpl :: Foreign -> F a

instance readForeign :: ReadForeign Foreign where
  readImpl = pure

instance readChar :: ReadForeign Char where
  readImpl = readChar

instance readNumber :: ReadForeign Number where
  readImpl = readNumber

instance readInt :: ReadForeign Int where
  readImpl = readInt

instance readString :: ReadForeign String where
  readImpl = readString

instance readBoolean :: ReadForeign Boolean where
  readImpl = readBoolean

instance readArray :: ReadForeign a => ReadForeign (Array a) where
  readImpl = readElements <=< readArray
    where
      readElements xs = sequence $ readImpl <$> xs

instance readNullOrUndefined :: ReadForeign a => ReadForeign (NullOrUndefined a) where
  readImpl = readNullOrUndefined readImpl

instance readRecord ::
  ( RowToList fields fieldList
  , ReadForeignFields fieldList fields
  , ListToRow fieldList fields
  ) => ReadForeign (Record fields) where
  readImpl = getFields (RLProxy :: RLProxy fieldList) (RProxy :: RProxy fields)

-- | A class for reading foreign values from properties. Warning: This class should not be instantiated.
class ReadForeignFields (xs :: RowList) (row :: # Type) where
  getFields :: RLProxy xs
    -> RProxy row
    -> Foreign
    -> F (Record row)

instance readFieldsCons ::
  ( IsSymbol name
  , ReadForeign ty
  , ReadForeignFields tail tailRow
  , RowLacks name tailRow
  , RowCons name ty tailRow row
  ) => ReadForeignFields (Cons name ty tail) row where
  getFields _ _ obj = do
    value <- readImpl =<< readProp name obj
    rest <- getFields tailP tailRowP obj
    pure $ insert nameP value rest
    where
      nameP = SProxy :: SProxy name
      tailP = RLProxy :: RLProxy tail
      tailRowP = RProxy :: RProxy tailRow
      name = reflectSymbol nameP

instance readFieldsNil ::
  ( TypeEquals {} (Record row)
  ) => ReadForeignFields Nil row where
  getFields _ _ _ =
    pure $ to {}