SD-934 #Done SD-935 #Done

SD-934 #Done SD-935 #Done

{-
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 View.Notebook.Cell.Viz (vizChoices, vizOutput) where

import Prelude
import Control.Plus (empty)
import Data.Maybe (Maybe(..), maybe, fromMaybe)

import qualified Data.StrMap as M
import Optic.Core
import Optic.Fold ((^?))
import Data.Selection
import Optic.Extended (TraversalP())
import Data.Array (range, zipWith, length, drop, take, (!!), null, (:))
import Data.Argonaut.JCursor (JCursor())
import Data.Int (toNumber)
import qualified Data.Set as S
import qualified Data.List as L

import qualified Halogen.HTML as H
import qualified Halogen.HTML.Attributes as A
import qualified Halogen.HTML.Events as E
import qualified Halogen.HTML.Events.Monad as E
import qualified Halogen.HTML.Events.Forms as E
import qualified Halogen.HTML.Events.Handler as E
import qualified Halogen.Themes.Bootstrap3 as B
import qualified Halogen.HTML.CSS as CSS

import Css.Size
import Css.Geometry (marginBottom, height, width, left, marginLeft)
import Css.String
import Css.Display

import ECharts.Options

import Model.Notebook.ECharts (Axis(..))
import Model.Notebook.Cell (Cell(), _cellId, _content, _Visualize, _runState, RunState(..))

import Controller.Notebook.Common (I())
import View.Common (row, row')
import qualified View.Css as VC
import View.Notebook.Common (HTML(), dataCellId, dataCellType, dataEChartsId)
import Data.Foreign.Class ()
import Utils.Halide (max, min, step)

-- to many imports from thiese modules to make them explicit
import Model.Notebook.Cell.Viz
import Controller.Notebook.Cell.Viz
import Utils (s2i)

vizChoices :: forall e. Cell -> HTML e
vizChoices cell =
  H.div_
  case cell ^. _runState of
    RunningSince _ -> loading
    _ -> case cell ^. _err of
      "" -> correct cell
      str -> errored str

correct :: forall e. Cell -> Array (HTML e)
correct cell =
  maybe [ ] go $ (cell ^? _content.._Visualize)
  where
  go :: VizRec -> Array (HTML e)
  go r =
    [H.div [ A.classes [ VC.vizCellEditor ] ] $
     (chartTypeSelector cell r) <>
     (chartConfiguration cell r)
    ]

chartTypeSelector :: forall e. Cell -> VizRec -> Array (HTML e)
chartTypeSelector cell r =
  [H.div [ A.classes [ VC.vizChartTypeSelector ] ]
   (img <$> (L.fromList $ S.toList  (r ^._availableChartTypes)))
  ]
  where
  img :: ChartType -> HTML e
  img ct =
    H.img [ A.src (src ct)
          , A.classes ( [ cls ct ]
                        <> (if (r ^._chartType) == ct
                            then [B.active]
                            else [])
                      )
          , E.onClick (\_ -> pure $ selectChartType cell ct)
          ]
    [ ]
  src :: ChartType -> String
  src Pie = "img/pie.svg"
  src Line = "img/line.svg"
  src Bar = "img/bar.svg"

  cls :: ChartType -> A.ClassName
  cls Pie = VC.pieChartIcon
  cls Line = VC.lineChartIcon
  cls Bar = VC.barChartIcon

chartConfiguration :: forall e. Cell -> VizRec -> Array (HTML e)
chartConfiguration cell r =
  [H.div [ A.classes [ VC.vizChartConfiguration ] ]
   [ pieConfiguration cell r (ct == Pie)
   , lineConfiguration cell r (ct == Line)
   , barConfiguration cell r (ct == Bar)
   , row
     [ H.form [ A.classes [ B.colXs4, VC.chartConfigureForm ] ]
       [ label "Height"
       , H.input [ A.value (if zero == (r ^._chartHeight)
                            then ""
                            else show (r ^._chartHeight))
                 , A.classes [ B.formControl, VC.chartConfigureHeight ]
                 , E.onInput (\v -> pure $ setChartHeight cell v)
                 ] [ ]
       ]
     , H.form [ A.classes [ B.colXs4, VC.chartConfigureForm ] ]
       [ label "Width"
       , H.input [ A.value (if zero == (r ^._chartWidth)
                            then ""
                            else show (r ^._chartWidth))
                 , A.classes [ B.formControl, VC.chartConfigureWidth ]
                 , E.onInput (\v -> pure $ setChartWidth cell v)
                 ] [ ]
       ]
     ]
   ]
  ]
  where ct = r ^._chartType

pieConfiguration :: forall e. Cell -> VizRec -> Boolean ->  HTML e
pieConfiguration cell r visible =
  H.div [ A.classes $ [VC.pieEditor] <> (if visible then [] else [B.hide]) ]
  [ row
    [ H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.chartCategory] ]
      [ categoryLabel
      , primaryOptions cell r (_pieConfiguration .. _cats)
      ]
    , H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.withAggregation
                         , VC.chartMeasureOne] ]
      [ measureLabel
      , primaryOptions cell r (_pieConfiguration .. _firstMeasures)
      , aggSelect cell r (_pieConfiguration.._firstMeasures) (_pieConfiguration.._firstAggregation)
      ]
    , H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.chartSeriesOne] ]
      [ seriesLabel
      , secondaryOptions cell r (_pieConfiguration .. _firstSeries)
      ]
    ]
  , row
    [ H.form [ A.classes [ B.colXs4
                         , B.colXsOffset8
                         , VC.chartConfigureForm
                         , VC.chartSeriesTwo] ]
      [ seriesLabel
      , secondaryOptions cell r (_pieConfiguration .. _secondSeries)
      ]
    ]
  ]
aggSelect :: forall e. Cell -> VizRec -> LensP VizRec JSelection -> LensP VizRec Aggregation -> HTML e
aggSelect cell r _blocker _agg =
  H.select [ A.classes [ B.formControl, VC.aggregation, B.btnPrimary ]
           , E.onValueChanged (\s -> pure $ maybe empty (selectAgg cell _agg) $ str2aggregation s),
             A.disabled (null (r ^._blocker.._variants))
           ]
  (aggOpt (r ^._agg) <$> allAggregations)

aggOpt :: forall e. Aggregation -> Aggregation -> HTML e
aggOpt sel a =
  H.option [ A.value (aggregation2str a)
           , A.selected (sel == a)
           ] [ H.text (aggregation2str a) ]

option :: forall e. Maybe JCursor -> JCursor -> Int -> HTML e
option selected cursor ix =
  H.option [ A.selected (Just cursor == selected)
           , A.value (show ix) ]
  [ H.text (show cursor) ]

defaultOption :: forall e. Maybe JCursor ->  HTML e
defaultOption selected =
  H.option [ A.selected (selected == Nothing)
           , A.value "-1" ]
  [ H.text "Select axis source" ]

import Utils.Log

options :: forall e. (Int -> Boolean) ->
           (Int -> Boolean) ->
           Cell -> VizRec -> LensP VizRec JSelection -> HTML e
options disableWhen defaultWhen cell r _sel =
  H.select [ A.classes [ B.formControl ]
           , E.onValueChanged (\ix -> pure $ updateR (byIx ix vars))
           , A.disabled (disableWhen $ length vars)
           ]

  (defOption <> (zipWith (option selected) vars (range 0 $ length vars)))
  where
  defOption :: Array (HTML e)
  defOption =
    if defaultWhen $ length vars
    then [defaultOption selected]
    else [ ]

  vars :: Array JCursor
  vars = r ^._sel.._variants

  selected :: Maybe JCursor
  selected = r ^._sel.._selection

  byIx :: String -> Array JCursor -> Maybe JCursor
  byIx ix xs = s2i ix >>= (xs !!)

  updateR :: Maybe JCursor -> I e
  updateR cursor =
    updateViz cell (r # _sel.._selection .~ cursor)

-- types don't check 0_o
-- primaryOptions :: forall e. Cell -> VizRec -> LensP VizRec JSelection -> HTML e
primaryOptions = options (< 2) (> 1)
-- secondaryOptions :: forall e. Cell -> VizRec -> LensP VizRec JSelection -> HTML e
secondaryOptions = options (< 1) (const true)

barConfiguration :: forall e. Cell -> VizRec -> Boolean -> HTML e
barConfiguration cell r visible =
  H.div [ A.classes $ [VC.barEditor] <> (if visible then [] else [B.hide]) ]
  [ row
    [ H.form [ A.classes [ B.colXs4, VC.chartConfigureForm, VC.chartCategory] ]
      [ categoryLabel
      , (primaryOptions cell r (_barConfiguration.._cats))
      ]
    , H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.withAggregation
                         , VC.chartMeasureOne] ]
      [ measureLabel
      , (primaryOptions cell r (_barConfiguration.._firstMeasures))
      , aggSelect cell r (_barConfiguration.._firstMeasures) (_barConfiguration.._firstAggregation)
      ]
    , H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.chartSeriesOne] ]
      [ seriesLabel
      , (secondaryOptions cell r (_barConfiguration.._firstSeries))
      ]
    ]
  , row
    [ H.form [ A.classes [ B.colXs4
                         , B.colXsOffset8
                         , VC.chartConfigureForm
                         , VC.chartSeriesTwo] ]
      [ seriesLabel
      , (secondaryOptions cell r (_barConfiguration.._secondSeries))
      ]
    ]
  ]

lineConfiguration :: forall e. Cell -> VizRec -> Boolean -> HTML e
lineConfiguration cell r visible =
  H.div [ A.classes $ [VC.lineEditor] <> (if visible then [] else [B.hide]) ]
  [ row
    [ H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.chartDimension] ]
      [ dimensionLabel
      , (primaryOptions cell r (_lineConfiguration.._dims))
      ]
    , H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.withAggregation
                         , VC.chartMeasureOne] ]
      [ measureLabel
      , (primaryOptions cell r (_lineConfiguration.._firstMeasures))
      , aggSelect cell r (_lineConfiguration.._firstMeasures) (_lineConfiguration.._firstAggregation)
      ]
    , H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.chartSeriesOne] ]
      [ seriesLabel
      , (secondaryOptions cell r (_lineConfiguration.._firstSeries))
      ]
    ]
  , row
    [ H.form [ A.classes [ B.colXs4
                         , B.colXsOffset4
                         , VC.chartConfigureForm
                         , VC.withAggregation
                         , VC.chartMeasureTwo] ]
      [ measureLabel
      , (secondaryOptions cell r (_lineConfiguration.._secondMeasures))
      , aggSelect cell r (_lineConfiguration.._secondMeasures) (_lineConfiguration.._secondAggregation)
      ]
    , H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.chartSeriesTwo] ]
      [ seriesLabel
      , (secondaryOptions cell r (_lineConfiguration.._secondSeries))
      ]
    ]
  ]

seriesLabel :: forall e. HTML e
seriesLabel = label "Series"

measureLabel :: forall e. HTML e
measureLabel = label "Measure"

categoryLabel :: forall e. HTML e
categoryLabel = label "Category"

dimensionLabel :: forall e. HTML e
dimensionLabel = label "Dimension"

label :: forall e. String -> HTML e
label str =
  H.label [ A.classes [ B.controlLabel ] ]
  [ H.text str ]

loading :: forall e. Array (HTML e)
loading =
  [H.div [ A.classes [ B.alert, B.alertInfo, VC.loadingMessage ]
         ]
   [ H.text "Loading"
   , H.img [ A.src "/img/blue-spin.gif" ] [ ]
   ]
  ]

errored :: forall e. String -> Array (HTML e)
errored message =
  [H.div [ A.classes [ B.alert, B.alertDanger ]
         , CSS.style do
              marginBottom $ px 12.0
         ]
   [ H.text message ]
  ]

vizOutput :: forall e. Cell -> Array (HTML e)
vizOutput state =
  case state ^. _err of
    "" -> [chart
           (show $ state ^._cellId)
           (fromMaybe zero (state ^? _viz.._chartHeight))
           (fromMaybe zero (state ^? _viz.._chartWidth))
          ]
    _ -> [ ]

chart' :: forall e i. Array (A.Attr (I e)) -> String -> Int -> Int -> HTML e
chart' attrs chartId h w =
  H.div (attrs <>
         [ dataEChartsId chartId
         , A.key ("echarts-key" <> chartId)
         , CSS.style (do height $ px $ toNumber h
                         width $ px $ toNumber w
                         position relative
                         left $ pct 50.0
                         marginLeft $ px $ -0.5 * (toNumber w)
                     )
         ]) [ ]

chart :: forall e. String -> Int -> Int -> HTML e
chart = chart' []

_viz :: TraversalP Cell VizRec
_viz = _content .. _Visualize

_err :: TraversalP Cell String
_err = _viz .. _error

{-
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 View.Notebook.Cell.Viz (vizChoices, vizOutput) where

import Prelude
import Control.Plus (empty)
import Data.Maybe (Maybe(..), maybe, fromMaybe)

import qualified Data.StrMap as M
import Optic.Core
import Optic.Fold ((^?))
import Data.Selection
import Optic.Extended (TraversalP())
import Data.Array (range, zipWith, length, drop, take, (!!), null, (:))
import Data.Argonaut.JCursor (JCursor())
import Data.Int (toNumber)
import qualified Data.Set as S
import qualified Data.List as L

import qualified Halogen.HTML as H
import qualified Halogen.HTML.Attributes as A
import qualified Halogen.HTML.Events as E
import qualified Halogen.HTML.Events.Monad as E
import qualified Halogen.HTML.Events.Forms as E
import qualified Halogen.HTML.Events.Handler as E
import qualified Halogen.Themes.Bootstrap3 as B
import qualified Halogen.HTML.CSS as CSS

import Css.Size
import Css.Geometry (marginBottom, height, width, left, marginLeft)
import Css.String
import Css.Display

import ECharts.Options

import Model.Notebook.ECharts (Axis(..))
import Model.Notebook.Cell (Cell(), _cellId, _content, _Visualize, _runState, RunState(..))

import Controller.Notebook.Common (I())
import View.Common (row, row')
import qualified View.Css as VC
import View.Notebook.Common (HTML(), dataCellId, dataCellType, dataEChartsId)
import Data.Foreign.Class ()
import Utils.Halide (max, min, step)

-- to many imports from thiese modules to make them explicit
import Model.Notebook.Cell.Viz
import Controller.Notebook.Cell.Viz
import Utils (s2i)

vizChoices :: forall e. Cell -> HTML e
vizChoices cell =
  H.div_
  case cell ^. _runState of
    RunningSince _ -> loading
    _ -> case cell ^. _err of
      "" -> correct cell
      str -> errored str

correct :: forall e. Cell -> Array (HTML e)
correct cell =
  maybe [ ] go $ (cell ^? _content.._Visualize)
  where
  go :: VizRec -> Array (HTML e)
  go r =
    [H.div [ A.classes [ VC.vizCellEditor ] ] $
     (chartTypeSelector cell r) <>
     (chartConfiguration cell r)
    ]

chartTypeSelector :: forall e. Cell -> VizRec -> Array (HTML e)
chartTypeSelector cell r =
  [H.div [ A.classes [ VC.vizChartTypeSelector ] ]
   (img <$> (L.fromList $ S.toList  (r ^._availableChartTypes)))
  ]
  where
  img :: ChartType -> HTML e
  img ct =
    H.img [ A.src (src ct)
          , A.classes ( [ cls ct ]
                        <> (if (r ^._chartType) == ct
                            then [B.active]
                            else [])
                      )
          , E.onClick (\_ -> pure $ selectChartType cell ct)
          ]
    [ ]
  src :: ChartType -> String
  src Pie = "img/pie.svg"
  src Line = "img/line.svg"
  src Bar = "img/bar.svg"

  cls :: ChartType -> A.ClassName
  cls Pie = VC.pieChartIcon
  cls Line = VC.lineChartIcon
  cls Bar = VC.barChartIcon

chartConfiguration :: forall e. Cell -> VizRec -> Array (HTML e)
chartConfiguration cell r =
  [H.div [ A.classes [ VC.vizChartConfiguration ] ]
   [ pieConfiguration cell r (ct == Pie)
   , lineConfiguration cell r (ct == Line)
   , barConfiguration cell r (ct == Bar)
   , row
     [ H.form [ A.classes [ B.colXs4, VC.chartConfigureForm ] ]
       [ label "Height"
       , H.input [ A.value (if zero == (r ^._chartHeight)
                            then ""
                            else show (r ^._chartHeight))
                 , A.classes [ B.formControl, VC.chartConfigureHeight ]
                 , E.onInput (\v -> pure $ setChartHeight cell v)
                 ] [ ]
       ]
     , H.form [ A.classes [ B.colXs4, VC.chartConfigureForm ] ]
       [ label "Width"
       , H.input [ A.value (if zero == (r ^._chartWidth)
                            then ""
                            else show (r ^._chartWidth))
                 , A.classes [ B.formControl, VC.chartConfigureWidth ]
                 , E.onInput (\v -> pure $ setChartWidth cell v)
                 ] [ ]
       ]
     ]
   ]
  ]
  where ct = r ^._chartType

pieConfiguration :: forall e. Cell -> VizRec -> Boolean ->  HTML e
pieConfiguration cell r visible =
  H.div [ A.classes $ [VC.pieEditor] <> (if visible then [] else [B.hide]) ]
  [ row
    [ H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.chartCategory] ]
      [ categoryLabel
      , primaryOptions cell r (_pieConfiguration .. _cats)
      ]
    , H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.withAggregation
                         , VC.chartMeasureOne] ]
      [ measureLabel
      , primaryOptions cell r (_pieConfiguration .. _firstMeasures)
      , aggSelect cell r (_pieConfiguration.._firstMeasures) (_pieConfiguration.._firstAggregation)
      ]
    , H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.chartSeriesOne] ]
      [ seriesLabel
      , secondaryOptions cell r (_pieConfiguration .. _firstSeries)
      ]
    ]
  , row
    [ H.form [ A.classes [ B.colXs4
                         , B.colXsOffset8
                         , VC.chartConfigureForm
                         , VC.chartSeriesTwo] ]
      [ seriesLabel
      , secondaryOptions cell r (_pieConfiguration .. _secondSeries)
      ]
    ]
  ]
aggSelect :: forall e. Cell -> VizRec -> LensP VizRec JSelection -> LensP VizRec Aggregation -> HTML e
aggSelect cell r _blocker _agg =
  H.select [ A.classes [ B.formControl, VC.aggregation, B.btnPrimary ]
           , E.onInput (\s -> pure $ maybe empty (selectAgg cell _agg) $ str2aggregation s),
             A.disabled (null (r ^._blocker.._variants))
           ]
  (aggOpt (r ^._agg) <$> allAggregations)

aggOpt :: forall e. Aggregation -> Aggregation -> HTML e
aggOpt sel a =
  H.option [ A.value (aggregation2str a)
           , A.selected (sel == a)
           ] [ H.text (aggregation2str a) ]

option :: forall e. Maybe JCursor -> JCursor -> Int -> HTML e
option selected cursor ix =
  H.option [ A.selected (Just cursor == selected)
           , A.value (show ix) ]
  [ H.text (show cursor) ]

defaultOption :: forall e. Maybe JCursor ->  HTML e
defaultOption selected =
  H.option [ A.selected (selected == Nothing)
           , A.value "-1" ]
  [ H.text "Select axis source" ]

options :: forall e. (Int -> Boolean) ->
           (Int -> Boolean) ->
           Cell -> VizRec -> LensP VizRec JSelection -> HTML e
options disableWhen defaultWhen cell r _sel =
  H.select [ A.classes [ B.formControl ]
           , E.onInput (\ix -> pure $ updateR (byIx ix vars))
           , A.disabled (disableWhen $ length vars)
           ]

  (defOption <> (zipWith (option selected) vars (range 0 $ length vars)))
  where
  defOption :: Array (HTML e)
  defOption =
    if defaultWhen $ length vars
    then [defaultOption selected]
    else [ ]

  vars :: Array JCursor
  vars = r ^._sel.._variants

  selected :: Maybe JCursor
  selected = r ^._sel.._selection

  byIx :: String -> Array JCursor -> Maybe JCursor
  byIx ix xs = s2i ix >>= (xs !!)

  updateR :: Maybe JCursor -> I e
  updateR cursor =
    updateViz cell (r # _sel.._selection .~ cursor)

-- types don't check 0_o
-- primaryOptions :: forall e. Cell -> VizRec -> LensP VizRec JSelection -> HTML e
primaryOptions = options (< 2) (> 1)
-- secondaryOptions :: forall e. Cell -> VizRec -> LensP VizRec JSelection -> HTML e
secondaryOptions = options (< 1) (const true)

barConfiguration :: forall e. Cell -> VizRec -> Boolean -> HTML e
barConfiguration cell r visible =
  H.div [ A.classes $ [VC.barEditor] <> (if visible then [] else [B.hide]) ]
  [ row
    [ H.form [ A.classes [ B.colXs4, VC.chartConfigureForm, VC.chartCategory] ]
      [ categoryLabel
      , (primaryOptions cell r (_barConfiguration.._cats))
      ]
    , H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.withAggregation
                         , VC.chartMeasureOne] ]
      [ measureLabel
      , (primaryOptions cell r (_barConfiguration.._firstMeasures))
      , aggSelect cell r (_barConfiguration.._firstMeasures) (_barConfiguration.._firstAggregation)
      ]
    , H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.chartSeriesOne] ]
      [ seriesLabel
      , (secondaryOptions cell r (_barConfiguration.._firstSeries))
      ]
    ]
  , row
    [ H.form [ A.classes [ B.colXs4
                         , B.colXsOffset8
                         , VC.chartConfigureForm
                         , VC.chartSeriesTwo] ]
      [ seriesLabel
      , (secondaryOptions cell r (_barConfiguration.._secondSeries))
      ]
    ]
  ]

lineConfiguration :: forall e. Cell -> VizRec -> Boolean -> HTML e
lineConfiguration cell r visible =
  H.div [ A.classes $ [VC.lineEditor] <> (if visible then [] else [B.hide]) ]
  [ row
    [ H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.chartDimension] ]
      [ dimensionLabel
      , (primaryOptions cell r (_lineConfiguration.._dims))
      ]
    , H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.withAggregation
                         , VC.chartMeasureOne] ]
      [ measureLabel
      , (primaryOptions cell r (_lineConfiguration.._firstMeasures))
      , aggSelect cell r (_lineConfiguration.._firstMeasures) (_lineConfiguration.._firstAggregation)
      ]
    , H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.chartSeriesOne] ]
      [ seriesLabel
      , (secondaryOptions cell r (_lineConfiguration.._firstSeries))
      ]
    ]
  , row
    [ H.form [ A.classes [ B.colXs4
                         , B.colXsOffset4
                         , VC.chartConfigureForm
                         , VC.withAggregation
                         , VC.chartMeasureTwo] ]
      [ measureLabel
      , (secondaryOptions cell r (_lineConfiguration.._secondMeasures))
      , aggSelect cell r (_lineConfiguration.._secondMeasures) (_lineConfiguration.._secondAggregation)
      ]
    , H.form [ A.classes [ B.colXs4
                         , VC.chartConfigureForm
                         , VC.chartSeriesTwo] ]
      [ seriesLabel
      , (secondaryOptions cell r (_lineConfiguration.._secondSeries))
      ]
    ]
  ]

seriesLabel :: forall e. HTML e
seriesLabel = label "Series"

measureLabel :: forall e. HTML e
measureLabel = label "Measure"

categoryLabel :: forall e. HTML e
categoryLabel = label "Category"

dimensionLabel :: forall e. HTML e
dimensionLabel = label "Dimension"

label :: forall e. String -> HTML e
label str =
  H.label [ A.classes [ B.controlLabel ] ]
  [ H.text str ]

loading :: forall e. Array (HTML e)
loading =
  [H.div [ A.classes [ B.alert, B.alertInfo, VC.loadingMessage ]
         ]
   [ H.text "Loading"
   , H.img [ A.src "/img/blue-spin.gif" ] [ ]
   ]
  ]

errored :: forall e. String -> Array (HTML e)
errored message =
  [H.div [ A.classes [ B.alert, B.alertDanger ]
         , CSS.style do
              marginBottom $ px 12.0
         ]
   [ H.text message ]
  ]

vizOutput :: forall e. Cell -> Array (HTML e)
vizOutput state =
  case state ^. _err of
    "" -> [chart
           (show $ state ^._cellId)
           (fromMaybe zero (state ^? _viz.._chartHeight))
           (fromMaybe zero (state ^? _viz.._chartWidth))
          ]
    _ -> [ ]

chart' :: forall e i. Array (A.Attr (I e)) -> String -> Int -> Int -> HTML e
chart' attrs chartId h w =
  H.div (attrs <>
         [ dataEChartsId chartId
         , A.key ("echarts-key" <> chartId)
         , CSS.style (do height $ px $ toNumber h
                         width $ px $ toNumber w
                         position relative
                         left $ pct 50.0
                         marginLeft $ px $ -0.5 * (toNumber w)
                     )
         ]) [ ]

chart :: forall e. String -> Int -> Int -> HTML e
chart = chart' []

_viz :: TraversalP Cell VizRec
_viz = _content .. _Visualize

_err :: TraversalP Cell String
_err = _viz .. _error


C# name style here too

C# name style here too

Original commit cefe96dea5f2bc5370d66cdbd09c68bfa0dc1056

module CSharp
    ( renderer
    ) where

import Doc
import IR
import Prelude
import Types

import Data.Foldable (for_, intercalate)
import Data.List (List, (:))
import Data.List as L
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.String.Util (capitalize, camelCase)
import Data.Tuple as Tuple

renderer :: Renderer
renderer =
    { name: "C#"
    , aceMode: "csharp"
    , render: renderCSharp
    }

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType _ = false

nullableFromSet :: Set.Set IRType -> Maybe IRType
nullableFromSet s =
    case L.fromFoldable s of
    IRNull : x : L.Nil -> Just x
    x : IRNull : L.Nil -> Just x
    _ -> Nothing

renderUnionToCSharp :: Set.Set IRType -> String
renderUnionToCSharp s =
    case nullableFromSet s of
    Just x -> if isValueType x then renderTypeToCSharp x <> "?" else renderTypeToCSharp x
    Nothing -> "Either<" <> intercalate ", " (Set.map renderTypeToCSharp s) <> ">"

renderTypeToCSharp :: IRType -> String
renderTypeToCSharp = case _ of
    IRNothing -> "object"
    IRNull -> "object"
    IRInteger -> "int"
    IRDouble -> "double"
    IRBool -> "bool"
    IRString -> "string"
    IRArray a -> renderTypeToCSharp a <> "[]"
    IRClass (IRClassData name _) -> csNameStyle name
    IRUnion types -> renderUnionToCSharp types

renderCSharp :: L.List IRClassData -> Doc Unit
renderCSharp classes = do
    line "namespace QuickType"
    line "{"
    blank

    indent do
        line "using Newtonsoft.Json.JsonPropertyAttribute"
        blank
        for_ classes \cls -> do
            renderCSharpClass cls
            blank
    line "}"

csNameStyle :: String -> String
csNameStyle = camelCase >>> capitalize

renderCSharpClass :: IRClassData -> Doc Unit
renderCSharpClass (IRClassData name properties) = do
    line $ words ["class", csNameStyle name]
    line "{"
    indent do
        for_ (Map.toUnfoldable properties :: Array _) \(Tuple.Tuple pname ptype) -> do
            line do
                string "[JsonProperty(\""
                string pname
                string "\")]"
            line do
                string "public "
                string $ renderTypeToCSharp ptype
                words ["", csNameStyle pname, "{ get; set; }"]
                blank
    line "}"

module CSharp
    ( renderer
    ) where

import Doc
import IR
import Prelude
import Types

import Data.Foldable (for_, intercalate)
import Data.List (List, (:))
import Data.List as L
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.String.Util (capitalize, camelCase)
import Data.Tuple as Tuple

renderer :: Renderer
renderer =
    { name: "C#"
    , aceMode: "csharp"
    , render: renderCSharp
    }

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType _ = false

nullableFromSet :: Set.Set IRType -> Maybe IRType
nullableFromSet s =
    case L.fromFoldable s of
    IRNull : x : L.Nil -> Just x
    x : IRNull : L.Nil -> Just x
    _ -> Nothing

renderUnionToCSharp :: Set.Set IRType -> String
renderUnionToCSharp s =
    case nullableFromSet s of
    Just x -> if isValueType x then renderTypeToCSharp x <> "?" else renderTypeToCSharp x
    Nothing -> "Either<" <> intercalate ", " (Set.map renderTypeToCSharp s) <> ">"

renderTypeToCSharp :: IRType -> String
renderTypeToCSharp = case _ of
    IRNothing -> "object"
    IRNull -> "object"
    IRInteger -> "int"
    IRDouble -> "double"
    IRBool -> "bool"
    IRString -> "string"
    IRArray a -> renderTypeToCSharp a <> "[]"
    IRClass (IRClassData name _) -> csNameStyle name
    IRUnion types -> renderUnionToCSharp types

renderCSharp :: L.List IRClassData -> Doc Unit
renderCSharp classes = do
    line "namespace QuickType"
    line "{"
    blank

    indent do
        line "using Newtonsoft.Json.JsonPropertyAttribute"
        blank
        for_ classes \cls -> do
            renderCSharpClass cls
            blank
    line "}"

csNameStyle :: String -> String
csNameStyle = camelCase >>> capitalize

renderCSharpClass :: IRClassData -> Doc Unit
renderCSharpClass (IRClassData name properties) = do
    line $ words ["class", capitalize name]
    line "{"
    indent do
        for_ (Map.toUnfoldable properties :: Array _) \(Tuple.Tuple pname ptype) -> do
            line do
                string "[JsonProperty(\""
                string pname
                string "\")]"
            line do
                string "public "
                string $ renderTypeToCSharp ptype
                words ["", csNameStyle pname, "{ get; set; }"]
                blank
    line "}"


Add `Generic a => Generic (Identity a)` instance

module Data.Generic
  ( class Generic
  , toSpine
  , toSignature
  , fromSpine
  , GenericSpine(..)
  , GenericSignature(..)
  , DataConstructor
  , showDataConstructor
  , showSignature
  , isValidSpine
  , gShow
  , gEq
  , gCompare
  ) where

import Prelude

import Data.Array (null, length, sortBy, zipWith)
import Data.Either (Either(..))
import Data.Foldable (all, and, find, fold, intercalate)
import Data.Identity (Identity(..))
import Data.Maybe (Maybe(..))
import Data.NonEmpty (NonEmpty(..))
import Data.String (joinWith)
import Data.Traversable (traverse)
import Data.Tuple (Tuple(..))

import Type.Proxy (Proxy(..))

-- | The Generic typeclass provides methods for sending data to/from spine
-- | representations, as well as querying about the signatures of spine
-- | representations.
-- |
-- | For standard data structures, you can simply write
-- | `derive instance genericFoo :: Generic Foo` in the module they are
-- | declared, and the instance methods will be filled in for you.
class Generic a where
  toSpine :: a -> GenericSpine
  toSignature :: Proxy a -> GenericSignature
  fromSpine :: GenericSpine -> Maybe a

instance genericNumber :: Generic Number where
  toSpine = SNumber
  toSignature _ = SigNumber
  fromSpine (SNumber n) = Just n
  fromSpine _ = Nothing

instance genericInt :: Generic Int where
  toSpine = SInt
  toSignature _ = SigInt
  fromSpine (SInt n) = Just n
  fromSpine _ = Nothing

instance genericString :: Generic String where
  toSpine = SString
  toSignature _ = SigString
  fromSpine (SString s) = Just s
  fromSpine _ = Nothing

instance genericChar :: Generic Char where
  toSpine = SChar
  toSignature _ = SigChar
  fromSpine (SChar s) = Just s
  fromSpine _ = Nothing

instance genericBool :: Generic Boolean where
  toSpine = SBoolean
  toSignature _ = SigBoolean
  fromSpine (SBoolean b) = Just b
  fromSpine _ = Nothing

instance genericArray :: Generic a => Generic (Array a) where
  toSpine = SArray <<< map (\x _ -> toSpine x)
  toSignature x = SigArray (\_ -> toSignature (lowerProxy x))
    where
    lowerProxy :: Proxy (Array a) -> Proxy a
    lowerProxy _ = Proxy
  fromSpine (SArray x) = traverse (fromSpine <<< force) x
  fromSpine _ = Nothing

instance genericUnit :: Generic Unit where
  toSpine _ = SUnit
  toSignature _ = SigUnit
  fromSpine SUnit = Just unit
  fromSpine _ = Nothing

instance genericTuple :: (Generic a, Generic b) => Generic (Tuple a b) where
  toSpine (Tuple x y) =
    SProd "Data.Tuple.Tuple" [\_ -> toSpine x, \_ -> toSpine y]
  toSignature x =
    SigProd
      "Data.Tuple.Tuple"
      [ { sigConstructor: "Data.Tuple.Tuple"
        , sigValues:
            [ \_ -> toSignature (fstProxy x)
            , \_ -> toSignature (sndProxy x)
            ]
        }
      ]
    where
    fstProxy :: Proxy (Tuple a b) -> Proxy a
    fstProxy _ = Proxy
    sndProxy :: Proxy (Tuple a b) -> Proxy b
    sndProxy _ = Proxy
  fromSpine (SProd "Data.Tuple.Tuple" [x, y]) =
    Tuple <$> fromSpine (force x) <*> fromSpine (force y)
  fromSpine _ = Nothing

instance genericMaybe :: Generic a => Generic (Maybe a) where
  toSpine (Just x) = SProd "Data.Maybe.Just" [\_ -> toSpine x]
  toSpine Nothing = SProd "Data.Maybe.Nothing" []
  toSignature x =
    SigProd
      "Data.Maybe.Maybe"
      [ { sigConstructor: "Data.Maybe.Just"
        , sigValues: [\_ -> toSignature (mbProxy x)]
        }
      , { sigConstructor: "Data.Maybe.Nothing"
        , sigValues: []
        }
      ]
    where
    mbProxy :: Proxy (Maybe a) -> Proxy a
    mbProxy _ = Proxy
  fromSpine (SProd "Data.Maybe.Just" [x]) = Just <$> fromSpine (force x)
  fromSpine (SProd "Data.Maybe.Nothing" []) = pure Nothing
  fromSpine _ = Nothing

instance genericEither :: (Generic a, Generic b) => Generic (Either a b) where
  toSpine (Left x) = SProd "Data.Either.Left" [\_ -> toSpine x]
  toSpine (Right x) = SProd "Data.Either.Right" [\_ -> toSpine x]
  toSignature x =
    SigProd
      "Data.Either.Either"
      [ { sigConstructor: "Data.Either.Left"
        , sigValues: [\_ -> toSignature (lproxy x)]
        }
      , { sigConstructor: "Data.Either.Right"
        , sigValues: [\_ -> toSignature (rproxy x)]
        }
      ]
    where
    lproxy :: Proxy (Either a b) -> Proxy a
    lproxy _ = Proxy
    rproxy :: Proxy (Either a b) -> Proxy b
    rproxy _ = Proxy
  fromSpine (SProd "Data.Either.Left" [x]) = Left <$> fromSpine (force x)
  fromSpine (SProd "Data.Either.Right" [x]) = Right <$> fromSpine (force x)
  fromSpine _ = Nothing

instance genericIdentity :: (Generic a) => Generic (Identity a) where
  toSpine (Identity a) = SProd "Data.Identity.Identity" [\_ -> toSpine a]
  toSignature x =
    SigProd
      "Data.Identity.Identity"
      [ { sigConstructor: "Data.Identity.Identity"
        , sigValues: [\_ -> toSignature (iproxy x)]
        }
      ]
    where
    iproxy :: Proxy (Identity a) -> Proxy a
    iproxy _ = Proxy
  fromSpine (SProd "Data.Identity.Identity" [x]) = Identity <$> fromSpine (force x)
  fromSpine _ = Nothing

instance genericOrdering :: Generic Ordering where
  toSpine = case _ of
    LT -> SProd "Data.Ordering.LT" []
    EQ -> SProd "Data.Ordering.EQ" []
    GT -> SProd "Data.Ordering.GT" []
  toSignature _ =
    SigProd
      "Data.Ordering.Ordering"
      [ { sigConstructor: "Data.Ordering.LT", sigValues: [] }
      , { sigConstructor: "Data.Ordering.EQ", sigValues: [] }
      , { sigConstructor: "Data.Ordering.GT", sigValues: [] }
      ]
  fromSpine = case _ of
    SProd "Data.Ordering.LT" [] -> Just LT
    SProd "Data.Ordering.EQ" [] -> Just EQ
    SProd "Data.Ordering.GT" [] -> Just GT
    _ -> Nothing

instance genericNonEmpty :: (Generic (f a), Generic a) => Generic (NonEmpty f a) where
  toSpine (NonEmpty x xs) =
    SProd "Data.NonEmpty.NonEmpty" [\_ -> toSpine x, \_ -> toSpine xs]
  toSignature x =
    SigProd
      "Data.NonEmpty.NonEmpty"
      [ { sigConstructor: "Data.NonEmpty.NonEmpty"
        , sigValues:
            [ \_ -> toSignature (headProxy x)
            , \_ -> toSignature (tailProxy x)
            ]
        }
      ]
    where
    headProxy :: Proxy (NonEmpty f a) -> Proxy a
    headProxy _ = Proxy
    tailProxy :: Proxy (NonEmpty f a) -> Proxy (f a)
    tailProxy _ = Proxy
  fromSpine (SProd "Data.NonEmpty.NonEmpty" [x, xs]) =
    NonEmpty <$> fromSpine (force x) <*> fromSpine (force xs)
  fromSpine _ = Nothing

-- | A GenericSpine is a universal representation of an arbitrary data
-- | structure (that does not contain function arrows).
data GenericSpine
  = SProd String (Array (Unit -> GenericSpine))
  | SRecord (Array { recLabel :: String, recValue :: Unit -> GenericSpine })
  | SNumber Number
  | SBoolean Boolean
  | SInt Int
  | SString String
  | SChar Char
  | SArray (Array (Unit -> GenericSpine))
  | SUnit

instance eqGenericSpine :: Eq GenericSpine where
  eq (SProd s1 arr1) (SProd s2 arr2) =
    s1 == s2 && length arr1 == length arr2 && zipAll eqThunk arr1 arr2
  eq (SRecord arr1) (SRecord arr2) = eqRecordSigs arr1 arr2
  eq (SNumber x) (SNumber y) = x == y
  eq (SBoolean x) (SBoolean y) = x == y
  eq (SInt x) (SInt y) = x == y
  eq (SString x) (SString y) = x == y
  eq (SChar x) (SChar y) = x == y
  eq (SArray xs) (SArray ys) = length xs == length ys && zipAll eqThunk xs ys
  eq SUnit SUnit = true
  eq _ _ = false

instance ordGenericSpine :: Ord GenericSpine where
  compare (SProd s1 arr1) (SProd s2 arr2) =
    case compare s1 s2 of
      EQ -> compare 0 $ zipCompare compareThunk arr1 arr2
      c1 -> c1
  compare (SProd _ _) _ = LT
  compare _ (SProd _ _) = GT
  compare (SRecord xs) (SRecord ys) =
    compare 0 $ zipCompare go xs ys
    where
    go x y = case compare x.recLabel y.recLabel of
      EQ -> orderingToInt $ compare (force x.recValue) (force y.recValue)
      c -> orderingToInt c
  compare (SRecord _) _ = LT
  compare _ (SRecord _) = GT
  compare (SInt x) (SInt y) = compare x y
  compare (SInt _) _ = LT
  compare _ (SInt _) = GT
  compare (SBoolean x) (SBoolean y) = compare x y
  compare (SBoolean _) _ = LT
  compare _ (SBoolean _) = GT
  compare (SNumber x) (SNumber y) = compare x y
  compare (SNumber _) _ = LT
  compare _ (SNumber _) = GT
  compare (SString x) (SString y) = compare x y
  compare (SString _) _ = LT
  compare _ (SString _) = GT
  compare (SChar x) (SChar y) = compare x y
  compare (SChar _) _ = LT
  compare _ (SChar _) = GT
  compare (SArray xs) (SArray ys) = compare 0 $ zipCompare compareThunk xs ys
  compare (SArray _) _ = LT
  compare _ (SArray _) = GT
  compare SUnit SUnit = EQ

-- | A GenericSignature is a universal representation of the structure of an
-- | arbitrary data structure (that does not contain function arrows).
data GenericSignature
  = SigProd String (Array DataConstructor)
  | SigRecord (Array { recLabel :: String, recValue :: Unit -> GenericSignature })
  | SigNumber
  | SigBoolean
  | SigInt
  | SigString
  | SigChar
  | SigArray (Unit -> GenericSignature)
  | SigUnit

instance eqGenericSignature :: Eq GenericSignature where
  eq (SigProd s1 arr1) (SigProd s2 arr2) =
    s1 == s2 && length arr1 == length arr2 && zipAll eqDataConstructor arr1 arr2
  eq (SigRecord arr1) (SigRecord arr2) = eqRecordSigs arr1 arr2
  eq SigNumber SigNumber = true
  eq SigBoolean SigBoolean = true
  eq SigInt SigInt = true
  eq SigString SigString = true
  eq SigChar SigChar = true
  eq (SigArray t1) (SigArray t2) = eqThunk t1 t2
  eq SigUnit SigUnit = true
  eq _ _ = false

instance showGenericSignature :: Show GenericSignature where
  show = showSignature

-- | Identifies a data constructor.
type DataConstructor =
  { sigConstructor :: String
  , sigValues :: Array (Unit -> GenericSignature)
  }

eqDataConstructor :: DataConstructor -> DataConstructor -> Boolean
eqDataConstructor p1 p2
  = p1.sigConstructor == p2.sigConstructor
  && zipAll eqThunk p1.sigValues p2.sigValues

showDataConstructor :: DataConstructor -> String
showDataConstructor dc =
  "{ sigConstructor: " <> show dc.sigConstructor <>
  ", sigValues: " <> showArray (showSignature <<< force) dc.sigValues <>
  "}"

showSignature :: GenericSignature -> String
showSignature sig =
  fold $ case sig of
    SigProd tyName ctors ->
      ["SigProd ", show tyName, " ", showArray showDataConstructor ctors]
    SigRecord labels -> ["SigRecord ", showArray showLabel labels]
    SigNumber -> ["SigNumber"]
    SigBoolean -> ["SigBoolean"]
    SigInt -> ["SigInt"]
    SigString -> ["SigString"]
    SigChar -> ["SigChar"]
    SigArray sig' -> ["SigArray ", paren (force sig')]
    SigUnit -> ["SigUnit"]

  where
  paren s
    | needsParen s = "(" <> showSignature s <> ")"
    | otherwise = showSignature s

  needsParen s = case s of
    SigProd _ _ -> true
    SigRecord _ -> true
    SigNumber -> false
    SigBoolean -> false
    SigInt -> false
    SigString -> false
    SigChar -> false
    SigArray _ -> true
    SigUnit -> false

-- We use this instead of the default Show Array instance to avoid escaping
-- strings twice.
showArray :: forall a. (a -> String) -> Array a -> String
showArray f xs = "[ " <> intercalate ", " (map f xs) <> " ]"

showLabel
  :: { recLabel :: String, recValue :: Unit -> GenericSignature }
  -> String
showLabel l =
  "{ recLabel: " <> show l.recLabel <>
  ", recValue: " <> showSignature (force l.recValue) <>
  " }"

-- | Checks that the spine follows the structure defined by the signature
isValidSpine :: GenericSignature -> GenericSpine -> Boolean
isValidSpine SigBoolean (SBoolean _) = true
isValidSpine SigNumber (SNumber _) = true
isValidSpine SigInt (SInt _) = true
isValidSpine SigString (SString _) = true
isValidSpine SigChar (SChar _) = true
isValidSpine (SigArray sig) (SArray spines) =
  all (isValidSpine (force sig) <<< force) spines
isValidSpine (SigProd _ alts) (SProd tag values) =
  case find (\alt -> alt.sigConstructor == tag) alts of
    Nothing -> false
    Just { sigValues } ->
      and $ zipWith
        (\sig spine -> isValidSpine (force sig) (force spine))
        sigValues
        values
isValidSpine (SigRecord fieldSigs) (SRecord fieldVals) =
  and $ zipWith
    (\sig val -> isValidSpine (force sig.recValue) (force val.recValue))
    (sortBy (\a b -> compare a.recLabel b.recLabel) fieldSigs)
    (sortBy (\a b -> compare a.recLabel b.recLabel) fieldVals)
isValidSpine SigUnit SUnit = true
isValidSpine _ _ = false

-- ## Generic Functions

-- | This function can be used as the default instance for Show for any
-- | instance of Generic
gShow :: forall a. Generic a => a -> String
gShow = genericShowPrec 0 <<< toSpine

genericShowPrec :: Int -> GenericSpine -> String
genericShowPrec d (SProd s arr)
  | null arr = s
  | otherwise =
      showParen (d > 10) $
        s <> " " <> joinWith " " (map (\x -> genericShowPrec 11 (force x)) arr)
      where
      showParen false x = x
      showParen true  x = "(" <> x <> ")"
genericShowPrec _ (SRecord xs) =
  "{" <> joinWith ", " (map showLabelPart xs) <> "}"
  where
  showLabelPart x = x.recLabel <> ": " <> genericShowPrec 0 (force x.recValue)
genericShowPrec _ (SBoolean x) = show x
genericShowPrec _ (SInt x) = show x
genericShowPrec _ (SNumber x) = show x
genericShowPrec _ (SString x) = show x
genericShowPrec _ (SChar x) = show x
genericShowPrec _ (SArray xs) =
  "[" <> joinWith ", "  (map (\x -> genericShowPrec 0 (force x)) xs) <> "]"
genericShowPrec _ SUnit = "unit"

-- | This function can be used as an implementation of the `eq` function of `Eq`
-- | for any type with a `Generic` instance.
-- |
-- | **Note**: It is preferrable to use `derive instance` for `Eq` instances
-- | rather than relying on `gEq`, where possible.
gEq :: forall a. Generic a => a -> a -> Boolean
gEq x y = toSpine x == toSpine y

-- | This function can be used as an implementation of the `compare` function
-- | of `Ord` for any type with a `Generic` instance.
-- |
-- | **Note**: It is preferrable to use `derive instance` for `Ord` instances
-- | rather than relying on `gCompare`, where possible.
gCompare :: forall a. Generic a => a -> a -> Ordering
gCompare x y = compare (toSpine x) (toSpine y)

-- ## Internal functions

foreign import zipAll
  :: forall a b
   . (a -> b -> Boolean)
  -> Array a
  -> Array b
  -> Boolean

foreign import zipCompare
  :: forall a b
   . (a -> b -> Int)
  -> Array a
  -> Array b
  -> Int

force :: forall a. (Unit -> a) -> a
force f = f unit

compareThunk :: forall a. Ord a => (Unit -> a) -> (Unit -> a) -> Int
compareThunk x y = orderingToInt $ compare (force x) (force y)

eqThunk :: forall a. Eq a => (Unit -> a) -> (Unit -> a) -> Boolean
eqThunk x y = force x == force y

eqRecordSigs
  :: forall a
   . Eq a
  => Array {recLabel :: String, recValue :: Unit -> a}
  -> Array {recLabel :: String, recValue :: Unit -> a}
  -> Boolean
eqRecordSigs arr1 arr2 =
  length arr1 == length arr2 && zipAll doCmp sorted1 sorted2
  where
  labelCompare r1 r2 = compare r1.recLabel r2.recLabel
  sorted1 = sortBy labelCompare arr1
  sorted2 = sortBy labelCompare arr2
  doCmp x y = x.recLabel == y.recLabel && force x.recValue == force y.recValue

orderingToInt :: Ordering -> Int
orderingToInt = case _ of
  EQ -> 0
  LT -> 1
  GT -> -1

module Data.Generic
  ( class Generic
  , toSpine
  , toSignature
  , fromSpine
  , GenericSpine(..)
  , GenericSignature(..)
  , DataConstructor
  , showDataConstructor
  , showSignature
  , isValidSpine
  , gShow
  , gEq
  , gCompare
  ) where

import Prelude

import Data.Array (null, length, sortBy, zipWith)
import Data.Either (Either(..))
import Data.Foldable (all, and, find, fold, intercalate)
import Data.Maybe (Maybe(..))
import Data.NonEmpty (NonEmpty(..))
import Data.String (joinWith)
import Data.Traversable (traverse)
import Data.Tuple (Tuple(..))

import Type.Proxy (Proxy(..))

-- | The Generic typeclass provides methods for sending data to/from spine
-- | representations, as well as querying about the signatures of spine
-- | representations.
-- |
-- | For standard data structures, you can simply write
-- | `derive instance genericFoo :: Generic Foo` in the module they are
-- | declared, and the instance methods will be filled in for you.
class Generic a where
  toSpine :: a -> GenericSpine
  toSignature :: Proxy a -> GenericSignature
  fromSpine :: GenericSpine -> Maybe a

instance genericNumber :: Generic Number where
  toSpine = SNumber
  toSignature _ = SigNumber
  fromSpine (SNumber n) = Just n
  fromSpine _ = Nothing

instance genericInt :: Generic Int where
  toSpine = SInt
  toSignature _ = SigInt
  fromSpine (SInt n) = Just n
  fromSpine _ = Nothing

instance genericString :: Generic String where
  toSpine = SString
  toSignature _ = SigString
  fromSpine (SString s) = Just s
  fromSpine _ = Nothing

instance genericChar :: Generic Char where
  toSpine = SChar
  toSignature _ = SigChar
  fromSpine (SChar s) = Just s
  fromSpine _ = Nothing

instance genericBool :: Generic Boolean where
  toSpine = SBoolean
  toSignature _ = SigBoolean
  fromSpine (SBoolean b) = Just b
  fromSpine _ = Nothing

instance genericArray :: Generic a => Generic (Array a) where
  toSpine = SArray <<< map (\x _ -> toSpine x)
  toSignature x = SigArray (\_ -> toSignature (lowerProxy x))
    where
    lowerProxy :: Proxy (Array a) -> Proxy a
    lowerProxy _ = Proxy
  fromSpine (SArray x) = traverse (fromSpine <<< force) x
  fromSpine _ = Nothing

instance genericUnit :: Generic Unit where
  toSpine _ = SUnit
  toSignature _ = SigUnit
  fromSpine SUnit = Just unit
  fromSpine _ = Nothing

instance genericTuple :: (Generic a, Generic b) => Generic (Tuple a b) where
  toSpine (Tuple x y) =
    SProd "Data.Tuple.Tuple" [\_ -> toSpine x, \_ -> toSpine y]
  toSignature x =
    SigProd
      "Data.Tuple.Tuple"
      [ { sigConstructor: "Data.Tuple.Tuple"
        , sigValues:
            [ \_ -> toSignature (fstProxy x)
            , \_ -> toSignature (sndProxy x)
            ]
        }
      ]
    where
    fstProxy :: Proxy (Tuple a b) -> Proxy a
    fstProxy _ = Proxy
    sndProxy :: Proxy (Tuple a b) -> Proxy b
    sndProxy _ = Proxy
  fromSpine (SProd "Data.Tuple.Tuple" [x, y]) =
    Tuple <$> fromSpine (force x) <*> fromSpine (force y)
  fromSpine _ = Nothing

instance genericMaybe :: Generic a => Generic (Maybe a) where
  toSpine (Just x) = SProd "Data.Maybe.Just" [\_ -> toSpine x]
  toSpine Nothing = SProd "Data.Maybe.Nothing" []
  toSignature x =
    SigProd
      "Data.Maybe.Maybe"
      [ { sigConstructor: "Data.Maybe.Just"
        , sigValues: [\_ -> toSignature (mbProxy x)]
        }
      , { sigConstructor: "Data.Maybe.Nothing"
        , sigValues: []
        }
      ]
    where
    mbProxy :: Proxy (Maybe a) -> Proxy a
    mbProxy _ = Proxy
  fromSpine (SProd "Data.Maybe.Just" [x]) = Just <$> fromSpine (force x)
  fromSpine (SProd "Data.Maybe.Nothing" []) = pure Nothing
  fromSpine _ = Nothing

instance genericEither :: (Generic a, Generic b) => Generic (Either a b) where
  toSpine (Left x) = SProd "Data.Either.Left" [\_ -> toSpine x]
  toSpine (Right x) = SProd "Data.Either.Right" [\_ -> toSpine x]
  toSignature x =
    SigProd
      "Data.Either.Either"
      [ { sigConstructor: "Data.Either.Left"
        , sigValues: [\_ -> toSignature (lproxy x)]
        }
      , { sigConstructor: "Data.Either.Right"
        , sigValues: [\_ -> toSignature (rproxy x)]
        }
      ]
    where
    lproxy :: Proxy (Either a b) -> Proxy a
    lproxy _ = Proxy
    rproxy :: Proxy (Either a b) -> Proxy b
    rproxy _ = Proxy
  fromSpine (SProd "Data.Either.Left" [x]) = Left <$> fromSpine (force x)
  fromSpine (SProd "Data.Either.Right" [x]) = Right <$> fromSpine (force x)
  fromSpine _ = Nothing

instance genericOrdering :: Generic Ordering where
  toSpine = case _ of
    LT -> SProd "Data.Ordering.LT" []
    EQ -> SProd "Data.Ordering.EQ" []
    GT -> SProd "Data.Ordering.GT" []
  toSignature _ =
    SigProd
      "Data.Ordering.Ordering"
      [ { sigConstructor: "Data.Ordering.LT", sigValues: [] }
      , { sigConstructor: "Data.Ordering.EQ", sigValues: [] }
      , { sigConstructor: "Data.Ordering.GT", sigValues: [] }
      ]
  fromSpine = case _ of
    SProd "Data.Ordering.LT" [] -> Just LT
    SProd "Data.Ordering.EQ" [] -> Just EQ
    SProd "Data.Ordering.GT" [] -> Just GT
    _ -> Nothing

instance genericNonEmpty :: (Generic (f a), Generic a) => Generic (NonEmpty f a) where
  toSpine (NonEmpty x xs) =
    SProd "Data.NonEmpty.NonEmpty" [\_ -> toSpine x, \_ -> toSpine xs]
  toSignature x =
    SigProd
      "Data.NonEmpty.NonEmpty"
      [ { sigConstructor: "Data.NonEmpty.NonEmpty"
        , sigValues:
            [ \_ -> toSignature (headProxy x)
            , \_ -> toSignature (tailProxy x)
            ]
        }
      ]
    where
    headProxy :: Proxy (NonEmpty f a) -> Proxy a
    headProxy _ = Proxy
    tailProxy :: Proxy (NonEmpty f a) -> Proxy (f a)
    tailProxy _ = Proxy
  fromSpine (SProd "Data.NonEmpty.NonEmpty" [x, xs]) =
    NonEmpty <$> fromSpine (force x) <*> fromSpine (force xs)
  fromSpine _ = Nothing

-- | A GenericSpine is a universal representation of an arbitrary data
-- | structure (that does not contain function arrows).
data GenericSpine
  = SProd String (Array (Unit -> GenericSpine))
  | SRecord (Array { recLabel :: String, recValue :: Unit -> GenericSpine })
  | SNumber Number
  | SBoolean Boolean
  | SInt Int
  | SString String
  | SChar Char
  | SArray (Array (Unit -> GenericSpine))
  | SUnit

instance eqGenericSpine :: Eq GenericSpine where
  eq (SProd s1 arr1) (SProd s2 arr2) =
    s1 == s2 && length arr1 == length arr2 && zipAll eqThunk arr1 arr2
  eq (SRecord arr1) (SRecord arr2) = eqRecordSigs arr1 arr2
  eq (SNumber x) (SNumber y) = x == y
  eq (SBoolean x) (SBoolean y) = x == y
  eq (SInt x) (SInt y) = x == y
  eq (SString x) (SString y) = x == y
  eq (SChar x) (SChar y) = x == y
  eq (SArray xs) (SArray ys) = length xs == length ys && zipAll eqThunk xs ys
  eq SUnit SUnit = true
  eq _ _ = false

instance ordGenericSpine :: Ord GenericSpine where
  compare (SProd s1 arr1) (SProd s2 arr2) =
    case compare s1 s2 of
      EQ -> compare 0 $ zipCompare compareThunk arr1 arr2
      c1 -> c1
  compare (SProd _ _) _ = LT
  compare _ (SProd _ _) = GT
  compare (SRecord xs) (SRecord ys) =
    compare 0 $ zipCompare go xs ys
    where
    go x y = case compare x.recLabel y.recLabel of
      EQ -> orderingToInt $ compare (force x.recValue) (force y.recValue)
      c -> orderingToInt c
  compare (SRecord _) _ = LT
  compare _ (SRecord _) = GT
  compare (SInt x) (SInt y) = compare x y
  compare (SInt _) _ = LT
  compare _ (SInt _) = GT
  compare (SBoolean x) (SBoolean y) = compare x y
  compare (SBoolean _) _ = LT
  compare _ (SBoolean _) = GT
  compare (SNumber x) (SNumber y) = compare x y
  compare (SNumber _) _ = LT
  compare _ (SNumber _) = GT
  compare (SString x) (SString y) = compare x y
  compare (SString _) _ = LT
  compare _ (SString _) = GT
  compare (SChar x) (SChar y) = compare x y
  compare (SChar _) _ = LT
  compare _ (SChar _) = GT
  compare (SArray xs) (SArray ys) = compare 0 $ zipCompare compareThunk xs ys
  compare (SArray _) _ = LT
  compare _ (SArray _) = GT
  compare SUnit SUnit = EQ

-- | A GenericSignature is a universal representation of the structure of an
-- | arbitrary data structure (that does not contain function arrows).
data GenericSignature
  = SigProd String (Array DataConstructor)
  | SigRecord (Array { recLabel :: String, recValue :: Unit -> GenericSignature })
  | SigNumber
  | SigBoolean
  | SigInt
  | SigString
  | SigChar
  | SigArray (Unit -> GenericSignature)
  | SigUnit

instance eqGenericSignature :: Eq GenericSignature where
  eq (SigProd s1 arr1) (SigProd s2 arr2) =
    s1 == s2 && length arr1 == length arr2 && zipAll eqDataConstructor arr1 arr2
  eq (SigRecord arr1) (SigRecord arr2) = eqRecordSigs arr1 arr2
  eq SigNumber SigNumber = true
  eq SigBoolean SigBoolean = true
  eq SigInt SigInt = true
  eq SigString SigString = true
  eq SigChar SigChar = true
  eq (SigArray t1) (SigArray t2) = eqThunk t1 t2
  eq SigUnit SigUnit = true
  eq _ _ = false

instance showGenericSignature :: Show GenericSignature where
  show = showSignature

-- | Identifies a data constructor.
type DataConstructor =
  { sigConstructor :: String
  , sigValues :: Array (Unit -> GenericSignature)
  }

eqDataConstructor :: DataConstructor -> DataConstructor -> Boolean
eqDataConstructor p1 p2
  = p1.sigConstructor == p2.sigConstructor
  && zipAll eqThunk p1.sigValues p2.sigValues

showDataConstructor :: DataConstructor -> String
showDataConstructor dc =
  "{ sigConstructor: " <> show dc.sigConstructor <>
  ", sigValues: " <> showArray (showSignature <<< force) dc.sigValues <>
  "}"

showSignature :: GenericSignature -> String
showSignature sig =
  fold $ case sig of
    SigProd tyName ctors ->
      ["SigProd ", show tyName, " ", showArray showDataConstructor ctors]
    SigRecord labels -> ["SigRecord ", showArray showLabel labels]
    SigNumber -> ["SigNumber"]
    SigBoolean -> ["SigBoolean"]
    SigInt -> ["SigInt"]
    SigString -> ["SigString"]
    SigChar -> ["SigChar"]
    SigArray sig' -> ["SigArray ", paren (force sig')]
    SigUnit -> ["SigUnit"]

  where
  paren s
    | needsParen s = "(" <> showSignature s <> ")"
    | otherwise = showSignature s

  needsParen s = case s of
    SigProd _ _ -> true
    SigRecord _ -> true
    SigNumber -> false
    SigBoolean -> false
    SigInt -> false
    SigString -> false
    SigChar -> false
    SigArray _ -> true
    SigUnit -> false

-- We use this instead of the default Show Array instance to avoid escaping
-- strings twice.
showArray :: forall a. (a -> String) -> Array a -> String
showArray f xs = "[ " <> intercalate ", " (map f xs) <> " ]"

showLabel
  :: { recLabel :: String, recValue :: Unit -> GenericSignature }
  -> String
showLabel l =
  "{ recLabel: " <> show l.recLabel <>
  ", recValue: " <> showSignature (force l.recValue) <>
  " }"

-- | Checks that the spine follows the structure defined by the signature
isValidSpine :: GenericSignature -> GenericSpine -> Boolean
isValidSpine SigBoolean (SBoolean _) = true
isValidSpine SigNumber (SNumber _) = true
isValidSpine SigInt (SInt _) = true
isValidSpine SigString (SString _) = true
isValidSpine SigChar (SChar _) = true
isValidSpine (SigArray sig) (SArray spines) =
  all (isValidSpine (force sig) <<< force) spines
isValidSpine (SigProd _ alts) (SProd tag values) =
  case find (\alt -> alt.sigConstructor == tag) alts of
    Nothing -> false
    Just { sigValues } ->
      and $ zipWith
        (\sig spine -> isValidSpine (force sig) (force spine))
        sigValues
        values
isValidSpine (SigRecord fieldSigs) (SRecord fieldVals) =
  and $ zipWith
    (\sig val -> isValidSpine (force sig.recValue) (force val.recValue))
    (sortBy (\a b -> compare a.recLabel b.recLabel) fieldSigs)
    (sortBy (\a b -> compare a.recLabel b.recLabel) fieldVals)
isValidSpine SigUnit SUnit = true
isValidSpine _ _ = false

-- ## Generic Functions

-- | This function can be used as the default instance for Show for any
-- | instance of Generic
gShow :: forall a. Generic a => a -> String
gShow = genericShowPrec 0 <<< toSpine

genericShowPrec :: Int -> GenericSpine -> String
genericShowPrec d (SProd s arr)
  | null arr = s
  | otherwise =
      showParen (d > 10) $
        s <> " " <> joinWith " " (map (\x -> genericShowPrec 11 (force x)) arr)
      where
      showParen false x = x
      showParen true  x = "(" <> x <> ")"
genericShowPrec _ (SRecord xs) =
  "{" <> joinWith ", " (map showLabelPart xs) <> "}"
  where
  showLabelPart x = x.recLabel <> ": " <> genericShowPrec 0 (force x.recValue)
genericShowPrec _ (SBoolean x) = show x
genericShowPrec _ (SInt x) = show x
genericShowPrec _ (SNumber x) = show x
genericShowPrec _ (SString x) = show x
genericShowPrec _ (SChar x) = show x
genericShowPrec _ (SArray xs) =
  "[" <> joinWith ", "  (map (\x -> genericShowPrec 0 (force x)) xs) <> "]"
genericShowPrec _ SUnit = "unit"

-- | This function can be used as an implementation of the `eq` function of `Eq`
-- | for any type with a `Generic` instance.
-- |
-- | **Note**: It is preferrable to use `derive instance` for `Eq` instances
-- | rather than relying on `gEq`, where possible.
gEq :: forall a. Generic a => a -> a -> Boolean
gEq x y = toSpine x == toSpine y

-- | This function can be used as an implementation of the `compare` function
-- | of `Ord` for any type with a `Generic` instance.
-- |
-- | **Note**: It is preferrable to use `derive instance` for `Ord` instances
-- | rather than relying on `gCompare`, where possible.
gCompare :: forall a. Generic a => a -> a -> Ordering
gCompare x y = compare (toSpine x) (toSpine y)

-- ## Internal functions

foreign import zipAll
  :: forall a b
   . (a -> b -> Boolean)
  -> Array a
  -> Array b
  -> Boolean

foreign import zipCompare
  :: forall a b
   . (a -> b -> Int)
  -> Array a
  -> Array b
  -> Int

force :: forall a. (Unit -> a) -> a
force f = f unit

compareThunk :: forall a. Ord a => (Unit -> a) -> (Unit -> a) -> Int
compareThunk x y = orderingToInt $ compare (force x) (force y)

eqThunk :: forall a. Eq a => (Unit -> a) -> (Unit -> a) -> Boolean
eqThunk x y = force x == force y

eqRecordSigs
  :: forall a
   . Eq a
  => Array {recLabel :: String, recValue :: Unit -> a}
  -> Array {recLabel :: String, recValue :: Unit -> a}
  -> Boolean
eqRecordSigs arr1 arr2 =
  length arr1 == length arr2 && zipAll doCmp sorted1 sorted2
  where
  labelCompare r1 r2 = compare r1.recLabel r2.recLabel
  sorted1 = sortBy labelCompare arr1
  sorted2 = sortBy labelCompare arr2
  doCmp x y = x.recLabel == y.recLabel && force x.recValue == force y.recValue

orderingToInt :: Ordering -> Int
orderingToInt = case _ of
  EQ -> 0
  LT -> 1
  GT -> -1


oops!

oops!

-- | Bindings to the global `process` object in Node.js. See also [the Node API documentation](https://nodejs.org/api/process.html)
module Node.Process
  ( PROCESS
  , onBeforeExit
  , onExit
  , onSignal
  , argv
  , execArgv
  , execPath
  , chdir
  , cwd
  , getEnv
  , lookupEnv
  , setEnv
  , pid
  , platform
  , exit
  , stdin
  , stdout
  , stderr
  , stdoutIsTTY
  , stderrIsTTY
  , version
  ) where

import Prelude

import Control.Monad.Eff (Eff, kind Effect)
import Control.Monad.Eff.Console (CONSOLE)
import Control.Monad.Eff.Exception (EXCEPTION)

import Data.Maybe (Maybe)
import Data.Posix (Pid)
import Data.Posix.Signal (Signal)
import Data.Posix.Signal as Signal
import Data.StrMap (StrMap)
import Data.StrMap as StrMap

import Node.Platform (Platform)
import Node.Platform as Platform
import Node.Stream (Readable, Writable)

import Unsafe.Coerce (unsafeCoerce)

-- | An effect tracking interaction with the global `process` object.
foreign import data PROCESS :: Effect

-- YOLO
foreign import process :: forall props. { | props }

mkEff :: forall eff a. (Unit -> a) -> Eff eff a
mkEff = unsafeCoerce

-- | Register a callback to be performed when the event loop empties, and
-- | Node.js is about to exit. Asynchronous calls can be made in the callback,
-- | and if any are made, it will cause the process to continue a little longer.
foreign import onBeforeExit :: forall eff. Eff (process :: PROCESS | eff) Unit -> Eff (process :: PROCESS | eff) Unit

-- | Register a callback to be performed when the process is about to exit.
-- | Any work scheduled via asynchronous calls made here will not be performed
-- | in time.
-- |
-- | The argument to the callback is the exit code which the process is about
-- | to exit with.
foreign import onExit :: forall eff. (Int -> Eff (process :: PROCESS | eff) Unit) -> Eff (process :: PROCESS | eff) Unit

foreign import onSignalImpl :: forall eff. String -> Eff (process :: PROCESS | eff) Unit -> Eff (process :: PROCESS | eff) Unit

-- | Install a handler for a particular signal.
onSignal :: forall eff. Signal -> Eff (process :: PROCESS | eff) Unit -> Eff (process :: PROCESS | eff) Unit
onSignal sig = onSignalImpl (Signal.toString sig)

-- | Register a callback to run as soon as the current event loop runs to
-- | completion.
nextTick :: forall eff. Eff eff Unit -> Eff eff Unit
nextTick callback = mkEff \_ -> process.nextTick callback

-- | Get an array containing the command line arguments. Be aware
-- | that this can change over the course of the program.
argv :: forall eff. Eff (process :: PROCESS | eff) (Array String)
argv = mkEff \_ -> process.argv

-- | Node-specific options passed to the `node` executable. Be aware that
-- | this can change over the course of the program.
execArgv :: forall eff. Eff (process :: PROCESS | eff) (Array String)
execArgv = mkEff \_ -> process.execArgv

-- | The absolute pathname of the `node` executable that started the
-- | process.
execPath :: forall eff. Eff (process :: PROCESS | eff) String
execPath = mkEff \_ -> process.execPath

-- | Change the current working directory of the process. If the current
-- | directory could not be changed, an exception will be thrown.
foreign import chdir :: forall eff. String -> Eff (err :: EXCEPTION, process :: PROCESS | eff) Unit

-- | Get the current working directory of the process.
cwd :: forall eff. Eff (process :: PROCESS | eff) String
cwd = process.cwd

-- | Get a copy of the current environment.
getEnv :: forall eff. Eff (process :: PROCESS | eff) (StrMap String)
getEnv = mkEff \_ -> process.env

-- | Lookup a particular environment variable.
lookupEnv :: forall eff. String -> Eff (process :: PROCESS | eff) (Maybe String)
lookupEnv k = StrMap.lookup k <$> getEnv

-- | Set an environment variable.
foreign import setEnv :: forall eff. String -> String -> Eff (process :: PROCESS | eff) Unit

pid :: Pid
pid = process.pid

platform :: Maybe Platform
platform = Platform.fromString platformStr

platformStr :: String
platformStr = process.platform

-- | Cause the process to exit with the supplied integer code. An exit code
-- | of 0 is normally considered successful, and anything else is considered a
-- | failure.
foreign import exit :: forall eff a. Int -> Eff (process :: PROCESS | eff) a

-- | The standard input stream. Note that this stream will never emit an `end`
-- | event, so any handlers attached via `onEnd` will never be called.
stdin :: forall eff. Readable () (console :: CONSOLE | eff)
stdin = process.stdin

-- | The standard output stream. Note that this stream cannot be closed; calling
-- | `end` will result in an exception being thrown.
stdout :: forall eff. Writable () (console :: CONSOLE, err :: EXCEPTION | eff)
stdout = process.stdout

-- | The standard error stream. Note that this stream cannot be closed; calling
-- | `end` will result in an exception being thrown.
stderr :: forall eff. Writable () (console :: CONSOLE, err :: EXCEPTION | eff)
stderr = process.stderr

-- | Check whether the standard output stream appears to be attached to a TTY.
-- | It is a good idea to check this before printing ANSI codes to stdout
-- | (e.g. for coloured text in the terminal).
stdoutIsTTY :: Boolean
stdoutIsTTY = process.stdout.isTTY

-- | Check whether the standard error stream appears to be attached to a TTY.
-- | It is a good idea to check this before printing ANSI codes to stderr
-- | (e.g. for coloured text in the terminal).
stderrIsTTY :: Boolean
stderrIsTTY = process.stderr.isTTY

-- | Get the Node.js version.
version :: String
version = process.version

-- | Bindings to the global `process` object in Node.js. See also [the Node API documentation](https://nodejs.org/api/process.html)
module Node.Process
  ( PROCESS
  , onBeforeExit
  , onExit
  , onSignal
  , argv
  , execArgv
  , execPath
  , chdir
  , cwd
  , getEnv
  , lookupEnv
  , setEnv
  , pid
  , platform
  , exit
  , stdin
  , stdout
  , stderr
  , stdoutIsTTY
  , stderrIsTTY
  , version
  ) where

import Prelude

import Control.Monad.Eff (Eff, kind Effect)
import Control.Monad.Eff.Console (CONSOLE)
import Control.Monad.Eff.Exception (EXCEPTION)

import Data.Maybe (Maybe, fromJust)
import Data.Posix (Pid)
import Data.Posix.Signal (Signal)
import Data.Posix.Signal as Signal
import Data.StrMap (StrMap)
import Data.StrMap as StrMap

import Node.Platform (Platform)
import Node.Platform as Platform
import Node.Stream (Readable, Writable)

import Partial.Unsafe (unsafePartial)

import Unsafe.Coerce (unsafeCoerce)

-- | An effect tracking interaction with the global `process` object.
foreign import data PROCESS :: Effect

-- YOLO
foreign import process :: forall props. { | props }

mkEff :: forall eff a. (Unit -> a) -> Eff eff a
mkEff = unsafeCoerce

-- | Register a callback to be performed when the event loop empties, and
-- | Node.js is about to exit. Asynchronous calls can be made in the callback,
-- | and if any are made, it will cause the process to continue a little longer.
foreign import onBeforeExit :: forall eff. Eff (process :: PROCESS | eff) Unit -> Eff (process :: PROCESS | eff) Unit

-- | Register a callback to be performed when the process is about to exit.
-- | Any work scheduled via asynchronous calls made here will not be performed
-- | in time.
-- |
-- | The argument to the callback is the exit code which the process is about
-- | to exit with.
foreign import onExit :: forall eff. (Int -> Eff (process :: PROCESS | eff) Unit) -> Eff (process :: PROCESS | eff) Unit

foreign import onSignalImpl :: forall eff. String -> Eff (process :: PROCESS | eff) Unit -> Eff (process :: PROCESS | eff) Unit

-- | Install a handler for a particular signal.
onSignal :: forall eff. Signal -> Eff (process :: PROCESS | eff) Unit -> Eff (process :: PROCESS | eff) Unit
onSignal sig = onSignalImpl (Signal.toString sig)

-- | Register a callback to run as soon as the current event loop runs to
-- | completion.
nextTick :: forall eff. Eff eff Unit -> Eff eff Unit
nextTick callback = mkEff \_ -> process.nextTick callback

-- | Get an array containing the command line arguments. Be aware
-- | that this can change over the course of the program.
argv :: forall eff. Eff (process :: PROCESS | eff) (Array String)
argv = mkEff \_ -> process.argv

-- | Node-specific options passed to the `node` executable. Be aware that
-- | this can change over the course of the program.
execArgv :: forall eff. Eff (process :: PROCESS | eff) (Array String)
execArgv = mkEff \_ -> process.execArgv

-- | The absolute pathname of the `node` executable that started the
-- | process.
execPath :: forall eff. Eff (process :: PROCESS | eff) String
execPath = mkEff \_ -> process.execPath

-- | Change the current working directory of the process. If the current
-- | directory could not be changed, an exception will be thrown.
foreign import chdir :: forall eff. String -> Eff (err :: EXCEPTION, process :: PROCESS | eff) Unit

-- | Get the current working directory of the process.
cwd :: forall eff. Eff (process :: PROCESS | eff) String
cwd = process.cwd

-- | Get a copy of the current environment.
getEnv :: forall eff. Eff (process :: PROCESS | eff) (StrMap String)
getEnv = mkEff \_ -> process.env

-- | Lookup a particular environment variable.
lookupEnv :: forall eff. String -> Eff (process :: PROCESS | eff) (Maybe String)
lookupEnv k = StrMap.lookup k <$> getEnv

-- | Set an environment variable.
foreign import setEnv :: forall eff. String -> String -> Eff (process :: PROCESS | eff) Unit

pid :: Pid
pid = process.pid

platform :: Maybe Platform
platform = Platform.fromString platformStr

platformStr :: String
platformStr = process.platform

-- | Cause the process to exit with the supplied integer code. An exit code
-- | of 0 is normally considered successful, and anything else is considered a
-- | failure.
foreign import exit :: forall eff a. Int -> Eff (process :: PROCESS | eff) a

-- | The standard input stream. Note that this stream will never emit an `end`
-- | event, so any handlers attached via `onEnd` will never be called.
stdin :: forall eff. Readable () (console :: CONSOLE | eff)
stdin = process.stdin

-- | The standard output stream. Note that this stream cannot be closed; calling
-- | `end` will result in an exception being thrown.
stdout :: forall eff. Writable () (console :: CONSOLE, err :: EXCEPTION | eff)
stdout = process.stdout

-- | The standard error stream. Note that this stream cannot be closed; calling
-- | `end` will result in an exception being thrown.
stderr :: forall eff. Writable () (console :: CONSOLE, err :: EXCEPTION | eff)
stderr = process.stderr

-- | Check whether the standard output stream appears to be attached to a TTY.
-- | It is a good idea to check this before printing ANSI codes to stdout
-- | (e.g. for coloured text in the terminal).
stdoutIsTTY :: Boolean
stdoutIsTTY = process.stdout.isTTY

-- | Check whether the standard error stream appears to be attached to a TTY.
-- | It is a good idea to check this before printing ANSI codes to stderr
-- | (e.g. for coloured text in the terminal).
stderrIsTTY :: Boolean
stderrIsTTY = process.stderr.isTTY

-- | Get the Node.js version.
version :: String
version = process.version


Finished writing all of the test cases.

Finished writing all of the test cases.

module Test.Main where

import Test.Spec                  (describe, it, pending)
import Test.Spec.Assertions       (shouldEqual)
import Test.Spec.Runner           (run)
import Test.Spec.Reporter.Console (consoleReporter)

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Node.Process (PROCESS)

import Prelude
import Data.InfiniteList
import Data.List as L
import Data.NonEmpty ((:|))
import Data.Tuple
import Data.Filterable (filter)

main :: forall e. Eff (console :: CONSOLE, process :: PROCESS | e) Unit
main = run [consoleReporter] allSpecs

-- main :: forall e. Eff (console :: CONSOLE | e) Unit
allSpecs = describe "Infinite List" do
  iterateSpecs
  repeatedSpecs
  dropWhileSpecs
  takeWhileSpecs
  functorSpecs
  filterableSpecs

iterateSpecs = describe "Iteated infinite lists" do
  it "The natural numbers" do
    let il = iterate ((+) 1) 1
    head il `shouldEqual` 1
    (head <<< tail $ il) `shouldEqual` 2
    (head <<< tail <<< tail $ il) `shouldEqual` 3
    (head <<< tail <<< tail <<< tail $ il) `shouldEqual` 4
    (head <<< tail <<< tail <<< tail <<< tail $ il) `shouldEqual` 5
  it "Created a descending list of negative numbers" do
    let il = iterate (\x -> x - 1) 0
    head il `shouldEqual` 0
    (head <<< tail $ il) `shouldEqual` (-1)
    (head <<< tail <<< tail $ il) `shouldEqual` (-2)
    (head <<< tail <<< tail <<< tail $ il) `shouldEqual` (-3)
    (head <<< tail <<< tail <<< tail <<< tail $ il) `shouldEqual` (-4)
  it "From a thousand and beyond" do
    let il = iterate ((+) 1) 1000
    head il `shouldEqual` 1000
    (head <<< tail $ il) `shouldEqual` 1001
    (head <<< tail <<< tail $ il) `shouldEqual` 1002
    (head <<< tail <<< tail <<< tail $ il) `shouldEqual` 1003
    (head <<< tail <<< tail <<< tail <<< tail $ il) `shouldEqual` 1004
  it "create the binary list" do
    let il = iterate not true
    head il `shouldEqual` true
    (head <<< tail $ il) `shouldEqual` false
    (head <<< tail <<< tail $ il) `shouldEqual` true
    (head <<< tail <<< tail <<< tail $ il) `shouldEqual` false

repeatedSpecs = describe "Repeated infinite lists" do
  it "The numbers from one to three repeated" do
    let il = repeat (1 :| L.fromFoldable [2, 3])
    take 8 il `shouldEqual` L.fromFoldable [1, 2, 3, 1, 2, 3, 1, 2]

  it "strange numbers repeated work" do
    let il = repeat (1 :| L.fromFoldable [5, 2, 1, 3, 4])
    take 8 il `shouldEqual` L.fromFoldable [1, 5, 2, 1, 3, 4, 1, 5]

dropWhileSpecs = describe "dropWhile" do
  it "'head' after a 'dropWhile' should return something that matches the condition" do
    let il = iterate ((+) 1) 0
    let result = dropWhile (\x -> x < 10) il
    head il `shouldEqual` 0
    head result `shouldEqual` 10
  it "dropWhile should skip many elements" do
    let il = iterate ((+) 1) 0
    let result = dropWhile (\x -> x < 100000) il
    head result `shouldEqual` 100000

takeWhileSpecs = describe "takeWhile" do
  it "takeWhile should generate a good list of elements" do
    let il = iterate ((+) 1) 0
    takeWhile (\x -> x < 10) il `shouldEqual` L.fromFoldable [0, 1, 2, 3, 4, 5, 6, 7, 8 ,9]
  it "takeWhile on many elements should be fast" do
    let il = iterate ((+) 1) 0
    let result = takeWhile (\x -> x < 10000) il
    L.length result `shouldEqual` 10000

functorSpecs = describe "Functor" do
  it "can increment an infinite list by five" do
    let il = iterate ((+) 1) 0
    let result = map ((+) 5) il
    take 5 result `shouldEqual` L.fromFoldable [5, 6, 7, 8, 9]
  it "can map an infinite list to boolean values" do
    let il = iterate ((+) 1) 0
    let result = map (\x -> x `mod` 3 == 0) il
    take 5 result `shouldEqual` L.fromFoldable [true, false, false, true, false]
  it "can map an infinite list into tuple values" do
    let il = iterate ((+) 1) 0
    let result = map (\x -> Tuple x ("n: " <> show x)) il
    take 5 result `shouldEqual` L.fromFoldable [Tuple 0 "n: 0", Tuple 1 "n: 1", Tuple 2 "n: 2", Tuple 3 "n: 3", Tuple 4 "n: 4"]

filterableSpecs = describe "Filterable" do
  it "can filter numbers from an infinite list" do
    let il = iterate ((+) 1) 1
    let result = filter (\x -> (x `mod` 3 == 0) || (x `mod` 5 == 0)) il
    takeWhile (\x -> x <= 20) result `shouldEqual` L.fromFoldable [3, 5, 6, 9, 10, 12, 15, 18, 20]

-- Iterate
-- Repeat
{-
, iterate
, repeat
, take
, drop
, takeWhile
, dropWhile
, head
, tail
, zip
, map
, filter
-}

module Test.Main where

import Test.Spec                  (describe, it, pending)
import Test.Spec.Assertions       (shouldEqual)
import Test.Spec.Runner           (run)
import Test.Spec.Reporter.Console (consoleReporter)

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Node.Process (PROCESS)

import Prelude
import Data.InfiniteList
import Data.List as L
import Data.NonEmpty ((:|))

main :: forall e. Eff (console :: CONSOLE, process :: PROCESS | e) Unit
main = run [consoleReporter] allSpecs

-- main :: forall e. Eff (console :: CONSOLE | e) Unit
allSpecs = describe "Infinite List" do
  iterateSpecs
  repeatedSpecs
  dropWhileSpecs
  takeWhileSpecs
  functorSpecs
  filterableSpecs

iterateSpecs = describe "Iteated infinite lists" do
  it "The natural numbers" do
    let il = iterate ((+) 1) 1
    head il `shouldEqual` 1
    (head <<< tail $ il) `shouldEqual` 2
    (head <<< tail <<< tail $ il) `shouldEqual` 3
    (head <<< tail <<< tail <<< tail $ il) `shouldEqual` 4
    (head <<< tail <<< tail <<< tail <<< tail $ il) `shouldEqual` 5
  it "Created a descending list of negative numbers" do
    let il = iterate (\x -> x - 1) 0
    head il `shouldEqual` 0
    (head <<< tail $ il) `shouldEqual` (-1)
    (head <<< tail <<< tail $ il) `shouldEqual` (-2)
    (head <<< tail <<< tail <<< tail $ il) `shouldEqual` (-3)
    (head <<< tail <<< tail <<< tail <<< tail $ il) `shouldEqual` (-4)
  it "From a thousand and beyond" do
    let il = iterate ((+) 1) 1000
    head il `shouldEqual` 1000
    (head <<< tail $ il) `shouldEqual` 1001
    (head <<< tail <<< tail $ il) `shouldEqual` 1002
    (head <<< tail <<< tail <<< tail $ il) `shouldEqual` 1003
    (head <<< tail <<< tail <<< tail <<< tail $ il) `shouldEqual` 1004
  it "create the binary list" do
    let il = iterate not true
    head il `shouldEqual` true
    (head <<< tail $ il) `shouldEqual` false
    (head <<< tail <<< tail $ il) `shouldEqual` true
    (head <<< tail <<< tail <<< tail $ il) `shouldEqual` false

repeatedSpecs = describe "Repeated infinite lists" do
  it "The numbers from one to three repeated" do
    let il = repeat (1 :| L.fromFoldable [2, 3])
    take 8 il `shouldEqual` L.fromFoldable [1, 2, 3, 1, 2, 3, 1, 2]

  it "strange numbers repeated work" do
    let il = repeat (1 :| L.fromFoldable [5, 2, 1, 3, 4])
    take 5 il `shouldEqual` L.fromFoldable [1, 5, 2, 1, 3]

dropWhileSpecs = describe "dropWhile" do
  pending "The 'head' after a 'dropWhile' should return something that matches the condition"
  pending "dropWhile should skip many elements"

takeWhileSpecs = describe "takeWhile" do
  pending "takeWhile should generate a good list of elements"

functorSpecs = describe "Functor" do
  pending "can increment an infinite list by five"
  pending "can map an infinite list to boolean values"
  pending "can map an infinite list into tuple values"

filterableSpecs = describe "Filterable" do
  pending "can filter numbers from an infinite list"

-- Iterate
-- Repeat
{-
, iterate
, repeat
, take
, drop
, takeWhile
, dropWhile
, head
, tail
, zip
, map
, filter
-}