new comments in app.purs

new comments in app.purs

module DemoApp.WithRactive where

import Prelude                   (Unit, bind, not, (++))
import Data.Maybe                (Maybe(Nothing, Just))
import Control.Monad.Eff         (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.Ractive (RactiveM,
                                  Ractive,
                                  ractive,
                                  on,
                                  get,
                                  set,
                                  push,
                                  pop,
                                  observe,
                                  find,
                                  findAll)
import Control.Monad.Eff.Random  (RANDOM, random)

newtype ContT r m a = ContT ((a -> m r) -> m r)

-- | Change a property by using Ractive's set() method
-- | The `RactiveM` type constructor is used to represent _RactiveJS_ effects.
-- |
-- | See [set-property from RactiveJS docs](http://docs.ractivejs.org/latest/ractive-set) for more details.
change :: forall value. String -> value -> Ractive -> (forall e. Eff (ractiveM :: RactiveM | e) Unit)
change property value ractive = do
                                  set property value ractive
-- | Inverse a Boolean value
inverse :: Boolean -> Boolean
inverse canRand = not canRand

-- | Change the random numeric value in Ractive's property "message"
-- | The `RactiveM` type constructor is used to represent _RactiveJS_ effects.
-- | The `RANDOM` type constructor is used to represent _RANDOM_ values generator effects.
setRandom :: forall e. Ractive -> Eff (random :: RANDOM, ractiveM :: RactiveM | e) Unit
setRandom ractive = do
            n <- random
            (change "message" n ractive)

-- | Callback for `logo-clicked` proxy event
-- | Each time we click a new random number will be generated unless we disable it by clicking on the button below
onLogoClicked :: forall event e. Ractive -> event -> Eff (ractiveM :: RactiveM, random :: RANDOM | e) Unit
onLogoClicked = \r e -> do
                         canRandomize <- get "canRandomize" r
                         if canRandomize then (setRandom r) else (change "message" "Randomization disabled!" r)

-- | Callback for `control-button-clicked` proxy event
-- | Here we can enable/disable the randomization functionality of the app.
onControlButtonClicked :: forall event eff. Ractive -> event -> Eff (ractiveM :: RactiveM | eff) Unit
onControlButtonClicked = \r e -> do
                                  canRandomize <- (get "canRandomize" r)
                                  change "canRandomize" (inverse canRandomize) r

-- | Writes log messages to the Console Output Panel in Browser
writeLog :: forall e. Ractive -> String -> String -> Eff (ractiveM :: RactiveM | e) Unit
writeLog ractive logName message = do
                                    current <- get logName ractive
                                    let newLog = (current++ message)
                                    change logName newLog ractive

main :: forall eff. Eff (ractiveM :: RactiveM, console :: CONSOLE, random :: RANDOM | eff) Unit
main = do
       -- | Here we define a single Ractive instance.
       -- | Every instance must be given a `template` and a DOM-element `el` to mount.
       -- | The template can be a simple string describing instance's HTML-structure or a separate
       -- | <script>-tag with a non-javascript type-attribute, for example "text/ractive".
       -- | In most cases there's also a `data`-field containing properties,
       -- | child-components, functions etc.
       ract <- ractive {
                      template : "#template",
                      el : "#app",
                      partials : {},
                      "data" : {
                              uiLibrary : "RactiveJS",
                              language  : "PureScript",
                              logoUrl   : "./content/img/ps-logo.png",
                              message   : "Click the PureScript Logo!",
                              consoleMessages: "no messages",
                              canRandomize : true,
                              numbers: []
                          }
                      }
       -- alternative call (lines 46/49 in Control/Monad/Eff/Ractive.purs must be uncommented)
       {-  ract <- ractive "#template" "#app" {
                                    uiLibrary : "RactiveJS",
                                    language  : "PureScript",
                                    logoUrl   : "./content/img/ps-logo.png",
                                    message   : "Hello, world!"
                                 }-}

       -- Register event-handlers for logo-clicks & button-clicks.
       -- Generate a random number each time we click the logo.
       on "logo-clicked" (onLogoClicked ract) ract
       on "control-button-clicked" (onControlButtonClicked ract) ract
       -- | Push a value into Ractive (console only)
       -- | The Callbacks are not mandatory. Just pass a `Nothing`.
       -- | If a Callback is Nothing a `logic-less` callback will be used on JS-side
       push "numbers" 12345 (Just (\p -> writeLog ract "consoleMessages" "\r\n\r\npush completed")) ract
       -- | Get a value from Ractive and execute callback
       (pop "numbers" (Just (\result -> writeLog ract "consoleMessages" ("\r\n\r\ngot value: " ++ result))) ract)
       -- We can also deregister event handlers like in the example below
       -- See also: http://docs.ractivejs.org/latest/ractive-off
       --> off (Just "logo-clicked") Nothing ract

       -- Ractive supports observers via observe & observeOnce APIs
       --> See also: http://docs.ractivejs.org/latest/ractive-observe
       --> and: http://docs.ractivejs.org/latest/ractive-observeonce
       --> the Callback receives:
       --------------------------> n = new value
       --------------------------> o = old value
       --------------------------> kp = keypath
       (observe "message" (\n o kp -> writeLog ract "consoleMessages" ("\r\n\r\nrandom: " ++ n)) Nothing ract)
       -- | returns the first DOM-Node matching the given CSS selector
       logo <- (find ".app-logo" ract)
       -- | returns an Array of DOM-Nodes matching the CSS selector
       --> See also: http://docs.ractivejs.org/latest/ractive-findall
       elems <- (findAll "div" Nothing ract)
       -- Change the internal state of Ractive instance
       -- Here we manipulate the property `message`
       --> change "message" "HELLO WORLD!" ract

       -- Return a value from Ractive
       -- See also: http://docs.ractivejs.org/latest/ractive-get
       m <- (get "message" ract)
       log m

module DemoApp.WithRactive where

import Prelude                   (Unit, bind, not, (++))
import Data.Maybe                (Maybe(Nothing, Just))
import Control.Monad.Eff         (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.Ractive (RactiveM,
                                  Ractive,
                                  ractive,
                                  on,
                                  get,
                                  set,
                                  push,
                                  pop,
                                  observe,
                                  find,
                                  findAll)
import Control.Monad.Eff.Random  (RANDOM, random)

newtype ContT r m a = ContT ((a -> m r) -> m r)

-- | Change a property by using Ractive's set() method
-- | The `RactiveM` type constructor is used to represent _RactiveJS_ effects.
-- |
-- | See [set-property from RactiveJS docs](http://docs.ractivejs.org/latest/ractive-set) for more details.
change :: forall value. String -> value -> Ractive -> (forall e. Eff (ractiveM :: RactiveM | e) Unit)
change property value ractive = do
                                  set property value ractive
-- | Inverse a Boolean value
inverse :: Boolean -> Boolean
inverse canRand = not canRand

-- | Change the random numeric value in Ractive's property "message"
-- | The `RactiveM` type constructor is used to represent _RactiveJS_ effects.
-- | The `RANDOM` type constructor is used to represent _RANDOM_ values generator effects.
setRandom :: forall e. Ractive -> Eff (random :: RANDOM, ractiveM :: RactiveM | e) Unit
setRandom ractive = do
            n <- random
            (change "message" n ractive)

-- | Callback for `logo-clicked` proxy event
-- | Each time we click a new random number will be generated unless we disable it by clicking on the button below
onLogoClicked :: forall event e. Ractive -> event -> Eff (ractiveM :: RactiveM, random :: RANDOM | e) Unit
onLogoClicked = \r e -> do
                         canRandomize <- get "canRandomize" r
                         if canRandomize then (setRandom r) else (change "message" "Randomization disabled!" r)

-- | Callback for `control-button-clicked` proxy event
-- | Here we can enable/disable the randomization functionality of the app.
onControlButtonClicked :: forall event eff. Ractive -> event -> Eff (ractiveM :: RactiveM | eff) Unit
onControlButtonClicked = \r e -> do
                                  canRandomize <- (get "canRandomize" r)
                                  change "canRandomize" (inverse canRandomize) r

-- | Writes log messages to the Console Output Panel in Browser
writeLog :: forall e. Ractive -> String -> String -> Eff (ractiveM :: RactiveM | e) Unit
writeLog ractive logName message = do
                                    current <- get logName ractive
                                    let newLog = (current++ message)
                                    change logName newLog ractive

main :: forall eff. Eff (ractiveM :: RactiveM, console :: CONSOLE, random :: RANDOM | eff) Unit
main = do
       -- | Here we define a single Ractive instance.
       -- | Every instance must be given a `template` and a DOM-element `el` to mount.
       -- | The template can be a simple string describing instance's HTML-structure or a separate
       -- | <script>-tag with a non-javascript type-attribute, for example "text/ractive".
       -- | In most cases there's also a `data`-field containing properties,
       -- | child-components, functions etc.
       ract <- ractive {
                      template : "#template",
                      el : "#app",
                      partials : {},
                      "data" : {
                              uiLibrary : "RactiveJS",
                              language  : "PureScript",
                              logoUrl   : "./content/img/ps-logo.png",
                              message   : "Click the PureScript Logo!",
                              consoleMessages: "no messages",
                              canRandomize : true,
                              numbers: []
                          }
                      }
       -- alternative call (lines 46/49 in Control/Monad/Eff/Ractive.purs must be uncommented)
       {-  ract <- ractive "#template" "#app" {
                                    uiLibrary : "RactiveJS",
                                    language  : "PureScript",
                                    logoUrl   : "./content/img/ps-logo.png",
                                    message   : "Hello, world!"
                                 }-}

       -- Register event-handlers for logo-clicks & button-clicks.
       -- Generate a random number each time we click the logo.
       on "logo-clicked" (onLogoClicked ract) ract
       on "control-button-clicked" (onControlButtonClicked ract) ract
       -- | Push a value into Ractive (console only)
       -- | The Callbacks are not mandatory. Just pass a `Nothing`.
       -- | If a Callback is Nothing a `logic-less` callback will be used on JS-side
       push "numbers" 12345 (Just (\p -> writeLog ract "consoleMessages" "\r\n\r\npush completed")) ract
       -- | Get a value from Ractive and execute callback
       (pop "numbers" (Just (\result -> writeLog ract "consoleMessages" ("\r\n\r\ngot value: " ++ result))) ract)
       -- We can also deregister event handlers like in the example below
       -- See also: http://docs.ractivejs.org/latest/ractive-off
       --> off (Just "logo-clicked") Nothing ract

       -- Ractive supports observers via observe & observeOnce APIs
       --> See also: http://docs.ractivejs.org/latest/ractive-observe
       --> and: http://docs.ractivejs.org/latest/ractive-observeonce
       --> the Callback receives:
       --------------------------> n = new value
       --------------------------> o = old value
       --------------------------> kp = keypath
       (observe "message" (\n o kp -> writeLog ract "consoleMessages" ("\r\n\r\nrandom: " ++ n)) Nothing ract)

       logo <- (find ".app-logo" ract)
       elems <- (findAll "div" Nothing ract)
       -- Change the internal state of Ractive instance
       -- Here we manipulate the property `message`
       --> change "message" "HELLO WORLD!" ract

       -- Return a value from Ractive
       -- See also: http://docs.ractivejs.org/latest/ractive-get
       m <- (get "message" ract)
       log m


Refactor.

Refactor.

module Main where

import Prelude hiding (append)

import Control.Comonad (extract)
import Control.Monad.Eff (Eff, foreachE)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.JQuery
  ( JQuery
  , JQueryEvent
  , append
  , appendText
  , body
  , clone
  , create
  , css
  , find
  , getValue
  , on
  , on'
  , ready
  , select
  , setAttr
  , setClass
  , setText
  , toArray
  )
import Control.Monad.Eff.Now (NOW, nowDate)
import Control.Monad.Eff.Ref (Ref, REF, readRef, modifyRef, newRef)

import Data.AppState (AppState(..))
import Data.Array ((..), (!!), elem, findIndex, index, zip, drop)
import Data.Date (Date, weekday)
import Data.DateTime as DT
import Data.Enum (fromEnum)
import Data.Int as Int
import Data.JSDate (LOCALE, parse, toDateTime)
import Data.Map as M
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Tuple.Nested (Tuple3, get1, get2, get3)
import Data.WeatherCard (WeatherCard, CardKey, ForcastData)
import Data.Zippable (zip3)

import DOM (DOM)

foreign import test :: Int

type WeekDay = String

main :: forall e. Eff (console :: CONSOLE, dom :: DOM, locale :: LOCALE, now :: NOW, ref :: REF | e) Unit
main = ready $ do
  spinner <- select ".loader"
  cardTemplate <- select ".cardTemplate"
  container <- select ".main"
  addDialog <- select ".dialog-container"

  stateRef <- newRef $ AppState
    { isLoading: true
    , visibleCards: M.empty
    , spinner: spinner
    , cardTemplate: cardTemplate
    , container: container
    , addDialog: addDialog
    }

  body <- body
  on' "click" "#butAdd" (\_ _ -> toggleAddDialog true addDialog) body

  hideSpinner spinner
  updateForecastCard stateRef initialWeatherForecast

-- Methods to update/refresh the UI

hideSpinner :: forall e. JQuery -> Eff (dom :: DOM | e) Unit
hideSpinner = setAttr "hidden" true

toggleAddDialog :: forall e. Boolean -> JQuery -> Eff (dom :: DOM | e) Unit
toggleAddDialog visible = setClass "dialog-container--visible" visible

updateForecastCard
  :: forall e
   . Ref AppState
  -> WeatherCard
  -> Eff (console :: CONSOLE, dom :: DOM, locale :: LOCALE, now :: NOW, ref :: REF | e) Unit
updateForecastCard stateRef cardData =
  let dataLastUpdated = toDateTime <$> parse cardData.created  -- Maybe DT.DateTime
      key = cardData.key
      current = cardData.channel.item.condition
      forcast = cardData.channel.item.forecast
  in do
    card <- getOrCreateCard stateRef key
    find ".description" card >>= setText current.text
    find "> .date" card >>= setText current.date
    find ".current .icon" card >>= setClass (getIconClass current.code) true
    find ".current .temperature .value" card >>= (setText $ show current.temp)
    find ".current .sunrise" card >>= setText cardData.channel.astronomy.sunrise
    find ".current .sunset" card >>= setText cardData.channel.astronomy.sunset
    find ".current .humidity" card >>= (setText $ show cardData.channel.atmosphere.humidity <> "%")
    find ".current .wind .value" card >>= (setText $ show cardData.channel.wind.speed)
    find ".current .wind .direction" card >>= (setText $ show cardData.channel.wind.direction)

    nextDays <- find ".future .oneday" card >>= toArray
    ndw <- nextDaysOfWeek
    foreachE (zip3 nextDays forcast ndw) updateNextDay

updateNextDay
  :: forall e
   . Tuple3 JQuery ForcastData WeekDay
  -> Eff (console :: CONSOLE, dom :: DOM | e) Unit
updateNextDay t =
  let c = get1 t
      daily = get2 t
      wd = get3 t
  in do
    find ".icon" c >>= setClass (getIconClass daily.code) true
    find ".date" c >>= setText wd
    find ".temp-high .value" c >>= (setText $ show daily.high)
    find ".temp-low .value" c >>= (setText $ show daily.low)

getOrCreateCard
  :: forall e
   . Ref AppState
  -> CardKey
  -> Eff (dom :: DOM, ref :: REF | e) JQuery
getOrCreateCard stateRef key = do
  AppState state <- readRef stateRef
  case M.lookup key state.visibleCards of
    Just wc ->
      pure wc
    Nothing -> do
      -- card doesn't exist - clone from template and store in state
      nc <- clone state.cardTemplate
      setClass "cardTemplate" false nc
      setAttr "hidden" false nc
      append nc state.container
      modifyRef stateRef $ addCardForKey key nc
      pure nc

-- Methods for dealing with the model

today :: forall e. Eff (now :: NOW | e) Date
today = extract <$> nowDate

weekdayFromEnum :: Date -> Int
weekdayFromEnum = fromEnum <<< weekday

daysOfWeek :: Array WeekDay
daysOfWeek = ["Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"]

nextDaysOfWeek :: forall e. Eff (now :: NOW | e) (Array WeekDay)
nextDaysOfWeek = do
  d <- weekdayFromEnum <$> today
  pure $ drop d (daysOfWeek <> daysOfWeek)

addCardForKey :: CardKey -> JQuery -> AppState -> AppState
addCardForKey key card (AppState state) =
  AppState state { visibleCards = M.insert key card state.visibleCards }

-- Weather codes: https://developer.yahoo.com/weather/documentation.html#codes
weatherCodes =
  [ [25, 32, 33, 34, 36, 3200]
  , [0, 1, 2, 6] <> 8..12 <> [17, 35, 40]
  , [3, 4, 37, 38, 39, 45, 47]
  , [5, 7, 13, 14, 16, 18, 41, 42, 43, 46]
  , [15] <> 19..22
  , [23, 24]
  , [26, 27, 28, 31]
  , [29, 30, 44]
  ]

weatherClasses =
  [ "clear-day"
  , "rain"
  , "thunderstorms"
  , "snow"
  , "fog"
  , "windy"
  , "cloudy"
  , "partly-cloudy-day"
  ]

getIconClass :: Int -> String
getIconClass weatherCode =
  fromMaybe "clear-day" $ findIndex (elem weatherCode) weatherCodes >>= index weatherClasses

-- Fake data
initialWeatherForecast :: WeatherCard
initialWeatherForecast = {
  key: "2459115"
, label: "New York, NY"
, created: "2016-07-22T01:00:00Z"
, channel: {
    astronomy: {
      sunrise: "5:43 am"
    , sunset: "8:21 pm"
    }
  , item: {
      condition: {
        text: "Windy"
      , date: "Thu, 21 Jul 2016 09:00 PM EDT"
      , temp: 56
      , code: 24
      }
    , forecast: [
        {code: 44, high: 86, low: 70}
      , {code: 44, high: 94, low: 73}
      , {code: 4, high: 95, low: 78}
      , {code: 24, high: 75, low: 89}
      , {code: 24, high: 89, low: 77}
      , {code: 44, high: 92, low: 79}
      , {code: 44, high: 89, low: 77}
      ]
    }
  , atmosphere: {humidity: 56}
  , wind: {
      speed: 25
    , direction: 195
    }
  }
}

module Main where

import Prelude hiding (append)

import Control.Comonad (extract)
import Control.Monad.Eff (Eff, foreachE)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.JQuery
  ( JQuery
  , JQueryEvent
  , append
  , appendText
  , body
  , clone
  , create
  , css
  , find
  , getValue
  , on
  , on'
  , ready
  , select
  , setAttr
  , setClass
  , setText
  , toArray
  )
import Control.Monad.Eff.Now (NOW, nowDate)
import Control.Monad.Eff.Ref (Ref, REF, readRef, modifyRef, newRef)

import Data.AppState (AppState(..))
import Data.Array ((..), (!!), elem, findIndex, index, zip, drop)
import Data.Date (Date, weekday)
import Data.DateTime as DT
import Data.Enum (fromEnum)
import Data.Int as Int
import Data.JSDate (LOCALE, parse, toDateTime)
import Data.Map as M
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Tuple.Nested (Tuple3, get1, get2, get3)
import Data.WeatherCard (WeatherCard, CardKey, ForcastData)
import Data.Zippable (zip3)

import DOM (DOM)

foreign import test :: Int

type WeekDay = String

main :: forall e. Eff (console :: CONSOLE, dom :: DOM, locale :: LOCALE, now :: NOW, ref :: REF | e) Unit
main = ready $ do
  log "Hello PWA!"

  spinner <- select ".loader"
  cardTemplate <- select ".cardTemplate"
  container <- select ".main"
  addDialog <- select ".dialog-container"

  stateRef <- newRef $ AppState
    { isLoading: true
    , visibleCards: M.empty
    , spinner: spinner
    , cardTemplate: cardTemplate
    , container: container
    , addDialog: addDialog
    }

  body <- body
  on' "click" "#butAdd" (\_ _ -> toggleAddDialog true addDialog) body

  hideSpinner spinner

  updateForecastCard stateRef initialWeatherForecast

-- Methods to update/refresh the UI

hideSpinner :: forall e. JQuery -> Eff (dom :: DOM | e) Unit
hideSpinner = setAttr "hidden" true

toggleAddDialog :: forall e. Boolean -> JQuery -> Eff (dom :: DOM | e) Unit
toggleAddDialog visible = setClass "dialog-container--visible" visible

updateForecastCard
  :: forall e
   . Ref AppState
  -> WeatherCard
  -> Eff (console :: CONSOLE, dom :: DOM, locale :: LOCALE, now :: NOW, ref :: REF | e) Unit
updateForecastCard stateRef cardData = do
  let dataLastUpdated = toDateTime <$> parse cardData.created  -- Maybe DT.DateTime
  let key = cardData.key
  let current = cardData.channel.item.condition

  card <- getOrCreateCard stateRef key
  find ".description" card >>= setText current.text
  find "> .date" card >>= setText current.date
  find ".current .icon" card >>= setClass (getIconClass current.code) true
  find ".current .temperature .value" card >>= (setText $ show current.temp)
  find ".current .sunrise" card >>= setText cardData.channel.astronomy.sunrise
  find ".current .sunset" card >>= setText cardData.channel.astronomy.sunset
  find ".current .humidity" card >>= (setText $ show cardData.channel.atmosphere.humidity <> "%")
  find ".current .wind .value" card >>= (setText $ show cardData.channel.wind.speed)
  find ".current .wind .direction" card >>= (setText $ show cardData.channel.wind.direction)

  nextDays <- find ".future .oneday" card >>= toArray
  ndw <- nextDaysOfWeek
  let forcast = cardData.channel.item.forecast
  foreachE (zip3 nextDays forcast ndw) updateNextDay

updateNextDay :: forall e. Tuple3 JQuery ForcastData WeekDay -> Eff (console :: CONSOLE, dom :: DOM | e) Unit
updateNextDay t = do
  let c = get1 t
  let d = get2 t
  let w = get3 t
  find ".icon" c >>= setClass (getIconClass d.code) true
  find ".date" c >>= setText w

getOrCreateCard
  :: forall e
   . Ref AppState
  -> CardKey
  -> Eff (dom :: DOM, ref :: REF | e) JQuery
getOrCreateCard stateRef key = do
  AppState state <- readRef stateRef
  case M.lookup key state.visibleCards of
    Just wc ->
      pure wc
    Nothing -> do
      -- card doesn't exist - clone from template and store in state
      nc <- clone state.cardTemplate
      setClass "cardTemplate" false nc
      setAttr "hidden" false nc
      append nc state.container
      modifyRef stateRef $ addCardForKey key nc
      pure nc

-- Methods for dealing with the model

today :: forall e. Eff (now :: NOW | e) Date
today = extract <$> nowDate

weekdayFromEnum :: Date -> Int
weekdayFromEnum = fromEnum <<< weekday

daysOfWeek :: Array WeekDay
daysOfWeek = ["Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"]

nextDaysOfWeek :: forall e. Eff (now :: NOW | e) (Array WeekDay)
nextDaysOfWeek = do
  d <- weekdayFromEnum <$> today
  pure $ drop d (daysOfWeek <> daysOfWeek)

addCardForKey :: CardKey -> JQuery -> AppState -> AppState
addCardForKey key card (AppState state) =
  AppState state { visibleCards = M.insert key card state.visibleCards }

-- Weather codes: https://developer.yahoo.com/weather/documentation.html#codes
weatherCodes =
  [ [25, 32, 33, 34, 36, 3200]
  , [0, 1, 2, 6] <> 8..12 <> [17, 35, 40]
  , [3, 4, 37, 38, 39, 45, 47]
  , [5, 7, 13, 14, 16, 18, 41, 42, 43, 46]
  , [15] <> 19..22
  , [23, 24]
  , [26, 27, 28, 31]
  , [29, 30, 44]
  ]

weatherClasses =
  [ "clear-day"
  , "rain"
  , "thunderstorms"
  , "snow"
  , "fog"
  , "windy"
  , "cloudy"
  , "partly-cloudy-day"
  ]

getIconClass :: Int -> String
getIconClass weatherCode =
  fromMaybe "clear-day" $ findIndex (elem weatherCode) weatherCodes >>= index weatherClasses

-- Fake data
initialWeatherForecast :: WeatherCard
initialWeatherForecast = {
  key: "2459115"
, label: "New York, NY"
, created: "2016-07-22T01:00:00Z"
, channel: {
    astronomy: {
      sunrise: "5:43 am"
    , sunset: "8:21 pm"
    }
  , item: {
      condition: {
        text: "Windy"
      , date: "Thu, 21 Jul 2016 09:00 PM EDT"
      , temp: 56
      , code: 24
      }
    , forecast: [
        {code: 44, high: 86, low: 70}
      , {code: 44, high: 94, low: 73}
      , {code: 4, high: 95, low: 78}
      , {code: 24, high: 75, low: 89}
      , {code: 24, high: 89, low: 77}
      , {code: 44, high: 92, low: 79}
      , {code: 44, high: 89, low: 77}
      ]
    }
  , atmosphere: {humidity: 56}
  , wind: {
      speed: 25
    , direction: 195
    }
  }
}


aria-disabled? nah, lets just remove it

aria-disabled? nah, lets just remove it

{-
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.Deck.Gripper
  ( gripperDefsForCard
  , renderGrippers
  , module SlamData.Workspace.Deck.Gripper.Def
  ) where

import SlamData.Prelude

import Data.Array as Array
import Data.Bifoldable (bifoldMap)

import Halogen.HTML as HH
import Halogen.HTML.Core (ClassName)
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.HTML.Properties.ARIA as ARIA

import SlamData.Render.ClassName as CN
import SlamData.Workspace.Deck.Common (DeckHTML)
import SlamData.Workspace.Deck.Component.Query (Query(StartSliding))
import SlamData.Workspace.Deck.Component.State (DisplayCard, eqDisplayCard)
import SlamData.Workspace.Deck.Gripper.Def (GripperDef(..))

gripperDefsForCard
  ∷ Array DisplayCard
  → DisplayCard
  → GripperDef × GripperDef
gripperDefsForCard cards card =
  Previous previousCardAvailable × Next nextCardAvailable
  where
  previousCardAvailable =
    fromMaybe true $
      not ∘ eqDisplayCard card <$> Array.head cards

  nextCardAvailable =
    isRight card

isAvailable ∷ GripperDef → Boolean
isAvailable = case _ of
  Previous available → available
  Next available → available

gripperLabel ∷ GripperDef → String
gripperLabel = case _ of
  Previous _ → "Access previous card"
  Next _ → "Access next card"

gripperClassName ∷ GripperDef → ClassName
gripperClassName = case _ of
  Previous _ → CN.cardGripper
  Next _ → CN.cardGripperLast

renderGrippers ∷ Boolean → Boolean → GripperDef × GripperDef → Array DeckHTML
renderGrippers isActiveCard isGrabbed =
  bifoldMap render render
  where
  render ∷ GripperDef → Array DeckHTML
  render gripperDef =
    if (not $ isAvailable gripperDef) || (not $ isActiveCard) then
      []
    else
      [ HH.button
          ([ HP.classes [ gripperClassName gripperDef ]
           , HE.onMouseDown $ HE.input (StartSliding gripperDef)
           , ARIA.grabbed $ show $ isGrabbed
           ]
           ⊕ (guard (isActiveCard) $> ARIA.label (gripperLabel gripperDef))
          )
          []
      ]

{-
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.Deck.Gripper
  ( gripperDefsForCard
  , renderGrippers
  , module SlamData.Workspace.Deck.Gripper.Def
  ) where

import SlamData.Prelude

import Data.Array as Array
import Data.Bifoldable (bifoldMap)

import Halogen.HTML as HH
import Halogen.HTML.Core (ClassName)
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.HTML.Properties.ARIA as ARIA

import SlamData.Render.ClassName as CN
import SlamData.Workspace.Deck.Common (DeckHTML)
import SlamData.Workspace.Deck.Component.Query (Query(StartSliding))
import SlamData.Workspace.Deck.Component.State (DisplayCard, eqDisplayCard)
import SlamData.Workspace.Deck.Gripper.Def (GripperDef(..))

gripperDefsForCard
  ∷ Array DisplayCard
  → DisplayCard
  → GripperDef × GripperDef
gripperDefsForCard cards card =
  Previous previousCardAvailable × Next nextCardAvailable
  where
  previousCardAvailable =
    fromMaybe true $
      not ∘ eqDisplayCard card <$> Array.head cards

  nextCardAvailable =
    isRight card

isAvailable ∷ GripperDef → Boolean
isAvailable = case _ of
  Previous available → available
  Next available → available

gripperLabel ∷ GripperDef → String
gripperLabel = case _ of
  Previous _ → "Access previous card"
  Next _ → "Access next card"

gripperClassName ∷ GripperDef → ClassName
gripperClassName = case _ of
  Previous _ → CN.cardGripper
  Next _ → CN.cardGripperLast

renderGrippers ∷ Boolean → Boolean → GripperDef × GripperDef → Array DeckHTML
renderGrippers isActiveCard isGrabbed =
  bifoldMap renderSingleton renderSingleton
  where
  render ∷ GripperDef → DeckHTML
  render gripperDef =
    HH.button
      ([ HP.classes [ gripperClassName gripperDef ]
       , HE.onMouseDown $ HE.input (StartSliding gripperDef)
       , ARIA.grabbed $ show $ isGrabbed
       , ARIA.disabled $ show $ (not $ isAvailable gripperDef) || (not $ isActiveCard)
       ]
       ⊕ (guard (isActiveCard) $> ARIA.label (gripperLabel gripperDef))
      )
      []

  renderSingleton ∷ GripperDef → Array DeckHTML
  renderSingleton = Array.singleton ∘ render


change available chart type function

change available chart type function

{-
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.ChartOptions.Component (chartOptionsComponent) where

import SlamData.Prelude

import Control.Monad.Eff.Exception (Error)

import Data.Argonaut (JArray, JCursor)
import Data.Array (length, null, cons, index)
import Data.Int as Int
import Data.Lens as Lens
import Data.Lens ((.~), (^?))
import Data.List as L
import Data.Map as M
import Data.Set as Set

import CSS.Geometry (marginBottom)
import CSS.Size (px)

import Halogen as H
import Halogen.CustomProps as Cp
import Halogen.HTML.CSS.Indexed as CSS
import Halogen.HTML.Events.Indexed as HE
import Halogen.HTML.Indexed as HH
import Halogen.HTML.Properties.Indexed as HP
import Halogen.HTML.Properties.Indexed.ARIA as ARIA
import Halogen.Themes.Bootstrap3 as B

import SlamData.Effects (Slam)
import SlamData.Form.Select (Select, autoSelect, newSelect, (⊝), ifSelected, trySelect', _value)
import SlamData.Quasar.Query as Quasar
import SlamData.Render.Common (row)
import SlamData.Render.CSS as Rc
import SlamData.Workspace.Card.CardType (CardType(ChartOptions))
import SlamData.Workspace.Card.Chart.Aggregation (aggregationSelect)
import SlamData.Workspace.Card.Chart.Axis (analyzeJArray, Axis)
import SlamData.Workspace.Card.Chart.Axis as Ax
import SlamData.Workspace.Card.Chart.ChartConfiguration (ChartConfiguration, depends, dependsOnArr)
import SlamData.Workspace.Card.Chart.ChartType (ChartType(..), isPie, isArea)
import SlamData.Workspace.Card.Common.Render (renderLowLOD)
import SlamData.Workspace.Card.Component as CC
import SlamData.Workspace.Card.Model as Card
import SlamData.Workspace.Card.Port as P
import SlamData.Workspace.Card.ChartOptions.Component.Query (QueryC, Query(..))
import SlamData.Workspace.Card.ChartOptions.Component.State as VCS
import SlamData.Workspace.Card.ChartOptions.Form.Component (formComponent)
import SlamData.Workspace.Card.ChartOptions.Form.Component as Form
import SlamData.Workspace.LevelOfDetails (LevelOfDetails(..))

type HTML = H.ParentHTML Form.StateP QueryC Form.QueryP Slam ChartType
type DSL = H.ParentDSL VCS.State Form.StateP QueryC Form.QueryP Slam ChartType

-- | How does this module work?
-- | + Take a TaggedResource case of Port
-- | + Check that resource exists and if so analyze sample to extract Map from
-- |   JCursors to Axes otherwise leave it Map.empty and set available chart types
-- |   to Set.empty. Following steps don't do anything useful if sample is empty.
-- |   Localized in first part of EvalCard handler and updateForm function.
-- | + Load all resource and if it's not too big produce output port
-- |   Second part of EvalCard handler
-- |
-- | + Output port is response of currently active subcomponent which is `Form`
-- | + Form's state (ChartConfiguration) is record with `dimensions`,
-- |   `aggregations`, `series` and `measures` fields.
-- |   These fields are arrays of `Select JCursor`  where `Select α`
-- |   Is model of html combobox with maybe selected α and list of α choices.
-- | + Form can render any kind of `ChartConfiguration` and has weird logic
-- |   for doing this :)
-- |
-- | + Peeking form signals and running CardEval call `configure` func
-- |   (second through `updateForms`)
-- | + `configure` takes all subcomponent configuration and filters them
-- |   e.g. it removes already selected in first measure combobox value from
-- |   available to select choices of second measure combobox -->
-- |   nonsense output is forbidden (one shouldn't be able to make chart
-- |   from `foo` to `foo` groupped by `foo`)
-- | + After filtering (That's important!) previoiusly selected values must
-- |   be set with func `setPreviousValueFrom`.
-- | + Then we have updated config and set it back as subcomponent state.
-- |
-- | About `needToUpdate`
-- | This flag is set when we need to update `records` and `sample` fields.
-- | Basically it's true after parent in deck has changed its output.
-- | And it's false when we just re`configure`d subcomponents.
-- |
-- |   >>> TODO: update this note, or fix the code to restore the old needToUpdate
-- |       logic, if needed. -js
-- |
-- | cryogenian 04/29/2016

chartOptionsComponent ∷ H.Component CC.CardStateP CC.CardQueryP Slam
chartOptionsComponent = CC.makeCardComponent
  { cardType: ChartOptions
  , component: H.parentComponent { render, eval, peek: Just peek }
  , initialState: H.parentState VCS.initialState
  , _State: CC._ChartOptionsState
  , _Query: CC.makeQueryPrism' CC._ChartOptionsQuery
  }

render ∷ VCS.State → HTML
render state =
  HH.div_
    [ renderHighLOD state
    , renderLowLOD B.glyphiconPicture left state.levelOfDetails
    ]

renderHighLOD ∷ VCS.State → HTML
renderHighLOD state =
    HH.div
      [ HP.classes
          $ [ Rc.cardInput, HH.className "card-input-maximum-lod" ]
          ⊕ (guard (state.levelOfDetails ≠ High) $> B.hidden)
      ]
      [ renderEmpty $ not Set.isEmpty state.availableChartTypes
      , renderForm state
      ]

renderEmpty ∷ Boolean → HTML
renderEmpty hidden =
  HH.div
    [ HP.classes
        $ [ B.alert, B.alertDanger ]
        ⊕ (guard hidden $> B.hide)
    , CSS.style $ marginBottom $ px 12.0
    ]
    [ HH.text "There is no available chart for this dataset" ]

renderForm ∷ VCS.State → HTML
renderForm state =
  HH.div
    [ HP.classes
        $ [ Rc.vizCardEditor ]
        ⊕ (guard hidden $> B.hide)
    ]
    [ renderChartTypeSelector state
    , renderChartConfiguration state
    ]
  where
  hidden ∷ Boolean
  hidden = Set.isEmpty state.availableChartTypes

renderChartTypeSelector ∷ VCS.State → HTML
renderChartTypeSelector state =
  HH.div
    [ HP.classes [ Rc.vizChartTypeSelector ] ]
    $ foldl (foldFn state.chartType) empty state.availableChartTypes
  where
  foldFn ∷ ChartType → Array HTML → ChartType → Array HTML
  foldFn selected accum current =
    flip cons accum $
      HH.img
        [ HP.src $ src current
        , HP.classes
            $ [ cls state.chartType ]
            ⊕ (guard (selected ≡ current) $> B.active)
        , HE.onClick (HE.input_ (right ∘ SetChartType current))
        ]

  src ∷ ChartType → String
  src Pie = "img/pie.svg"
  src Line = "img/line.svg"
  src Bar = "img/bar.svg"
  src Area = "img/area.svg"

  cls ∷ ChartType → HH.ClassName
  cls Pie = Rc.pieChartIcon
  cls Line = Rc.lineChartIcon
  cls Bar = Rc.barChartIcon
  cls Area = Rc.areaChartIcon

renderChartConfiguration ∷ VCS.State → HTML
renderChartConfiguration state =
  HH.div
    [ HP.classes [ Rc.vizChartConfiguration ] ]
    [ renderTab Pie
    , renderTab Line
    , renderTab Bar
    , renderTab Area
    , renderDimensions state
    ]
  where
  renderTab ∷ ChartType → HTML
  renderTab ty =
    showIf (state.chartType ≡ ty)
    [ HH.slot ty \_ →
        { component: formComponent
        , initialState: H.parentState Form.initialState
        }
    ]

  showIf ∷ Boolean → Array HTML → HTML
  showIf ok content = HH.div [ HP.classes $ (guard (not ok) $> B.hide) ] content

renderDimensions ∷ VCS.State → HTML
renderDimensions state =
  row
  [ chartInput Rc.axisLabelParam "Axis label angle"
      (_.axisLabelAngle ⋙ show) RotateAxisLabel (isPie state.chartType)
  , chartInput Rc.axisLabelParam "Axis font size"
      (_.axisLabelFontSize ⋙ show) SetAxisFontSize (isPie state.chartType)
  , boolChartInput Rc.chartDetailParam "If stack"
      (_.areaStacked)ToggleSetStacked (not $ isArea state.chartType)
  , boolChartInput Rc.chartDetailParam "If smooth"
      (_.smooth) ToggleSetSmooth (not $ isArea state.chartType)
  ]
  where
  chartInput
    ∷ HH.ClassName
    → String
    → (VCS.State → String)
    → (Int → Unit → Query Unit)
    → Boolean → HTML
  chartInput cls labelText valueFromState queryCtor isHidden =
    HH.form
      [ HP.classes
          $ [ B.colXs6, cls ]
          ⊕ (guard isHidden $> B.hide)
      , Cp.nonSubmit
      ]
      [ label labelText
      , HH.input
          [ HP.classes [ B.formControl ]
          , HP.value $ valueFromState state
          , ARIA.label labelText
          , HE.onValueInput
              $ pure ∘ map (right ∘ flip queryCtor unit) ∘ stringToInt
          ]
      ]

  boolChartInput
    ∷ HH.ClassName
    → String
    → (VCS.State → Boolean)
    → (Boolean → Unit → Query Unit)
    → Boolean → HTML
  boolChartInput cls labelText valueFromState queryCtor isHidden =
    HH.form
      [ HP.classes
          $ [ B.colXs6, cls ]
          ⊕ (guard isHidden $> B.hide)
      , Cp.nonSubmit
      ]
      [ label labelText
      , HH.input
          [ HP.inputType HP.InputCheckbox
          , HP.checked $ valueFromState state
          , ARIA.label labelText
          , HE.onChecked
             $ HE.input_ (right ∘ queryCtor (not $ valueFromState state))
          ]
      ]

  label ∷ String → HTML
  label str = HH.label [ HP.classes [ B.controlLabel ] ] [ HH.text str ]

  showIfNeqZero ∷ ∀ a. (Eq a, Show a, Semiring a) ⇒ a → String
  showIfNeqZero a = if zero ≡ a then "" else show a

  stringToInt ∷ String → Maybe Int
  stringToInt s = if s ≡ "" then Just 0 else Int.fromString s

-- Note: need to put running to state
eval ∷ QueryC ~> DSL
eval = coproduct cardEval chartEval

chartEval ∷ Query ~> DSL
chartEval q = do
  next <- case q of
    SetChartType ct n → H.modify (VCS._chartType .~ ct) $> n
    RotateAxisLabel angle n → H.modify (VCS._axisLabelAngle .~ angle) $> n
    SetAxisFontSize size n → H.modify (VCS._axisLabelFontSize .~ size) $> n
    ToggleSetStacked stacked n → H.modify (VCS._areaStacked .~ stacked) $> n
    ToggleSetSmooth smooth n → H.modify (VCS._smooth .~ smooth) $> n
  configure
  CC.raiseUpdatedP' CC.EvalModelUpdate
  pure next

cardEval ∷ CC.CardEvalQuery ~> DSL
cardEval = case _ of
  CC.EvalCard info output next → do
    for (output ^? Lens._Just ∘ P._Chart) \opts → do
      sample ← either (const []) id <$>
        H.fromAff (Quasar.sample opts.resource 0 20 :: Slam (Either Error JArray))
      if null sample
        then H.modify (VCS._availableChartTypes .~ Set.empty)
        else H.modify (VCS._sample .~ analyzeJArray sample) *> configure
    pure next
  CC.Save k → do
    st ← H.get
    config ← H.query st.chartType $ left $ H.request Form.GetConfiguration
    pure ∘ k $ Card.ChartOptions
      { chartConfig: fromMaybe Form.initialState config
      , options:
          { chartType: st.chartType
          , axisLabelFontSize: st.axisLabelFontSize
          , axisLabelAngle: st.axisLabelAngle
          , areaStacked: st.areaStacked
          , smooth: st.smooth
          }
      }
  CC.Load card next → do
    case card of
      Card.ChartOptions model → do
        let st = VCS.fromModel model
        H.set st
        H.query st.chartType
          $ left
          $ H.action $ Form.SetConfiguration model.chartConfig
        pure unit
      _ → pure unit
    pure next
  CC.SetDimensions dims next → do
    H.modify
      $ VCS._levelOfDetails
      .~ if dims.width < 576.0 ∨ dims.height < 416.0
           then Low
           else High
    pure next
  CC.ModelUpdated _ next →
    pure next
  CC.ZoomIn next →
    pure next

type AxisAccum =
  { category ∷ Array JCursor
  , value ∷ Array JCursor
  , time ∷ Array JCursor
  }

configure ∷ DSL Unit
configure = void do
  axises ← getAxises
  pieConf ← getOrInitial Pie
  setConfFor Pie $ pieBarConfiguration axises pieConf
  lineConf ← getOrInitial Line
  setConfFor Line $ lineConfiguration axises lineConf
  barConf ← getOrInitial Bar
  setConfFor Bar $ pieBarConfiguration axises barConf
  areaConf ← getOrInitial Area
  setConfFor Area $ areaConfiguration axises areaConf
  let chartTypes = available axises
  H.modify (VCS._availableChartTypes .~ available axises)
  case Set.toList chartTypes of
    L.Cons ct L.Nil → H.modify (VCS._chartType .~ ct)
    _ → pure unit
  where
  getOrInitial ∷ ChartType → DSL ChartConfiguration
  getOrInitial ty =
    map (fromMaybe Form.initialState)
      $ H.query ty
      $ left (H.request Form.GetConfiguration)

  setConfFor ∷ ChartType → ChartConfiguration → DSL Unit
  setConfFor ty conf =
    void $ H.query ty $ left $ H.action $ Form.SetConfiguration conf

  available ∷ AxisAccum → Set.Set ChartType
  available axises =
    foldMap Set.singleton
    $ if null axises.value
      then []
      else if not $ null axises.category
           then [Pie, Bar, Line, Area]
           else if (null axises.time) && (length axises.value < 2)
                then []
                else [Line, Area]

  getAxises ∷ DSL AxisAccum
  getAxises = do
    sample ← H.gets _.sample
    pure $ foldl axisFolder {category: [], value: [], time: [] } $ M.toList sample

  axisFolder ∷ AxisAccum → Tuple JCursor Axis → AxisAccum
  axisFolder accum (Tuple cursor axis)
    | Ax.isCatAxis axis = accum { category = cons cursor accum.category }
    | Ax.isValAxis axis = accum { value = cons cursor accum.value }
    | Ax.isTimeAxis axis = accum {time = cons cursor accum.time }
    | otherwise = accum

  setPreviousValueFrom
    ∷ ∀ a. (Eq a) ⇒ Maybe (Select a) → Select a → Select a
  setPreviousValueFrom mbSel target  =
    (maybe id trySelect' $ mbSel >>= Lens.view _value) $ target

  pieBarConfiguration ∷ AxisAccum → ChartConfiguration → ChartConfiguration
  pieBarConfiguration axises current =
    let allAxises = axises.category ⊕ axises.time ⊕ axises.value
        categories =
          setPreviousValueFrom (index current.series 0)
          $ autoSelect $ newSelect allAxises
        measures =
          setPreviousValueFrom (index current.measures 0)
          $ autoSelect $ newSelect $ depends categories axises.value
        firstSeries =
          setPreviousValueFrom (index current.series 1)
          $ newSelect $ ifSelected [categories] $ allAxises ⊝ categories
        secondSeries =
          setPreviousValueFrom (index current.series 2)
          $ newSelect $ ifSelected [categories, firstSeries]
          $ allAxises ⊝ categories ⊝ firstSeries
        aggregation =
          setPreviousValueFrom (index current.aggregations 0) aggregationSelect
    in { series: [categories, firstSeries, secondSeries]
       , dimensions: []
       , measures: [measures]
       , aggregations: [aggregation]
       }

  lineConfiguration ∷ AxisAccum → ChartConfiguration → ChartConfiguration
  lineConfiguration axises current =
    let allAxises = (axises.category ⊕ axises.time ⊕ axises.value)
        dimensions =
          setPreviousValueFrom (index current.dimensions 0)
          $ autoSelect $ newSelect $ dependsOnArr axises.value
          -- This is redundant, I've put it here to notify
          -- that this behaviour differs from pieBar and can be changed.
          $ allAxises
        firstMeasures =
          setPreviousValueFrom (index current.measures 0)
          $ autoSelect $ newSelect $ depends dimensions
          $ axises.value ⊝ dimensions
        secondMeasures =
          setPreviousValueFrom (index current.measures 1)
          $ newSelect $ ifSelected [firstMeasures]
          $ depends dimensions
          $ axises.value ⊝ firstMeasures ⊝ dimensions
        firstSeries =
          setPreviousValueFrom (index current.series 0)
          $ newSelect $ ifSelected [dimensions] $ allAxises ⊝ dimensions
        secondSeries =
          setPreviousValueFrom (index current.series 1)
          $ newSelect $ ifSelected [dimensions, firstSeries]
          $ allAxises ⊝ dimensions ⊝ firstSeries
        firstAggregation =
          setPreviousValueFrom (index current.aggregations 0) aggregationSelect
        secondAggregation =
          setPreviousValueFrom (index current.aggregations 1) aggregationSelect
    in { series: [firstSeries, secondSeries]
       , dimensions: [dimensions]
       , measures: [firstMeasures, secondMeasures]
       , aggregations: [firstAggregation, secondAggregation]
       }

  areaConfiguration ∷ AxisAccum → ChartConfiguration → ChartConfiguration
  areaConfiguration axises current =
    let allAxises = (axises.category ⊕ axises.time ⊕ axises.value)
        dimensions =
          setPreviousValueFrom (index current.dimensions 0)
          $ autoSelect $ newSelect $ dependsOnArr axises.value
          -- This is redundant, I've put it here to notify
          -- that this behaviour differs from pieBar and can be changed.
          $ allAxises
        firstMeasures =
          setPreviousValueFrom (index current.measures 0)
          $ autoSelect $ newSelect $ depends dimensions
          $ axises.value ⊝ dimensions
        secondMeasures =
          setPreviousValueFrom (index current.measures 1)
          $ newSelect $ ifSelected [firstMeasures]
          $ depends dimensions
          $ axises.value ⊝ firstMeasures ⊝ dimensions
        firstSeries =
          setPreviousValueFrom (index current.series 0)
          $ newSelect $ ifSelected [dimensions] $ allAxises ⊝ dimensions
        secondSeries =
          setPreviousValueFrom (index current.series 1)
          $ newSelect $ ifSelected [dimensions, firstSeries]
          $ allAxises ⊝ dimensions ⊝ firstSeries
        firstAggregation =
          setPreviousValueFrom (index current.aggregations 0) aggregationSelect
        secondAggregation =
          setPreviousValueFrom (index current.aggregations 1) aggregationSelect
    in { series: [firstSeries, secondSeries]
       , dimensions: [dimensions]
       , measures: [firstMeasures, secondMeasures]
       , aggregations: [firstAggregation, secondAggregation]
       }

peek ∷ ∀ a. H.ChildF ChartType Form.QueryP a → DSL Unit
peek _ = configure *> CC.raiseUpdatedP' CC.EvalModelUpdate

{-
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.ChartOptions.Component (chartOptionsComponent) where

import SlamData.Prelude

import Control.Monad.Eff.Exception (Error)

import Data.Argonaut (JArray, JCursor)
import Data.Array (length, null, cons, index)
import Data.Int as Int
import Data.Lens as Lens
import Data.Lens ((.~), (^?))
import Data.List as L
import Data.Map as M
import Data.Set as Set

import CSS.Geometry (marginBottom)
import CSS.Size (px)

import Halogen as H
import Halogen.CustomProps as Cp
import Halogen.HTML.CSS.Indexed as CSS
import Halogen.HTML.Events.Indexed as HE
import Halogen.HTML.Indexed as HH
import Halogen.HTML.Properties.Indexed as HP
import Halogen.HTML.Properties.Indexed.ARIA as ARIA
import Halogen.Themes.Bootstrap3 as B

import SlamData.Effects (Slam)
import SlamData.Form.Select (Select, autoSelect, newSelect, (⊝), ifSelected, trySelect', _value)
import SlamData.Quasar.Query as Quasar
import SlamData.Render.Common (row)
import SlamData.Render.CSS as Rc
import SlamData.Workspace.Card.CardType (CardType(ChartOptions))
import SlamData.Workspace.Card.Chart.Aggregation (aggregationSelect)
import SlamData.Workspace.Card.Chart.Axis (analyzeJArray, Axis)
import SlamData.Workspace.Card.Chart.Axis as Ax
import SlamData.Workspace.Card.Chart.ChartConfiguration (ChartConfiguration, depends, dependsOnArr)
import SlamData.Workspace.Card.Chart.ChartType (ChartType(..), isPie, isArea)
import SlamData.Workspace.Card.Common.Render (renderLowLOD)
import SlamData.Workspace.Card.Component as CC
import SlamData.Workspace.Card.Model as Card
import SlamData.Workspace.Card.Port as P
import SlamData.Workspace.Card.ChartOptions.Component.Query (QueryC, Query(..))
import SlamData.Workspace.Card.ChartOptions.Component.State as VCS
import SlamData.Workspace.Card.ChartOptions.Form.Component (formComponent)
import SlamData.Workspace.Card.ChartOptions.Form.Component as Form
import SlamData.Workspace.LevelOfDetails (LevelOfDetails(..))

type HTML = H.ParentHTML Form.StateP QueryC Form.QueryP Slam ChartType
type DSL = H.ParentDSL VCS.State Form.StateP QueryC Form.QueryP Slam ChartType

-- | How does this module work?
-- | + Take a TaggedResource case of Port
-- | + Check that resource exists and if so analyze sample to extract Map from
-- |   JCursors to Axes otherwise leave it Map.empty and set available chart types
-- |   to Set.empty. Following steps don't do anything useful if sample is empty.
-- |   Localized in first part of EvalCard handler and updateForm function.
-- | + Load all resource and if it's not too big produce output port
-- |   Second part of EvalCard handler
-- |
-- | + Output port is response of currently active subcomponent which is `Form`
-- | + Form's state (ChartConfiguration) is record with `dimensions`,
-- |   `aggregations`, `series` and `measures` fields.
-- |   These fields are arrays of `Select JCursor`  where `Select α`
-- |   Is model of html combobox with maybe selected α and list of α choices.
-- | + Form can render any kind of `ChartConfiguration` and has weird logic
-- |   for doing this :)
-- |
-- | + Peeking form signals and running CardEval call `configure` func
-- |   (second through `updateForms`)
-- | + `configure` takes all subcomponent configuration and filters them
-- |   e.g. it removes already selected in first measure combobox value from
-- |   available to select choices of second measure combobox -->
-- |   nonsense output is forbidden (one shouldn't be able to make chart
-- |   from `foo` to `foo` groupped by `foo`)
-- | + After filtering (That's important!) previoiusly selected values must
-- |   be set with func `setPreviousValueFrom`.
-- | + Then we have updated config and set it back as subcomponent state.
-- |
-- | About `needToUpdate`
-- | This flag is set when we need to update `records` and `sample` fields.
-- | Basically it's true after parent in deck has changed its output.
-- | And it's false when we just re`configure`d subcomponents.
-- |
-- |   >>> TODO: update this note, or fix the code to restore the old needToUpdate
-- |       logic, if needed. -js
-- |
-- | cryogenian 04/29/2016

chartOptionsComponent ∷ H.Component CC.CardStateP CC.CardQueryP Slam
chartOptionsComponent = CC.makeCardComponent
  { cardType: ChartOptions
  , component: H.parentComponent { render, eval, peek: Just peek }
  , initialState: H.parentState VCS.initialState
  , _State: CC._ChartOptionsState
  , _Query: CC.makeQueryPrism' CC._ChartOptionsQuery
  }

render ∷ VCS.State → HTML
render state =
  HH.div_
    [ renderHighLOD state
    , renderLowLOD B.glyphiconPicture left state.levelOfDetails
    ]

renderHighLOD ∷ VCS.State → HTML
renderHighLOD state =
    HH.div
      [ HP.classes
          $ [ Rc.cardInput, HH.className "card-input-maximum-lod" ]
          ⊕ (guard (state.levelOfDetails ≠ High) $> B.hidden)
      ]
      [ renderEmpty $ not Set.isEmpty state.availableChartTypes
      , renderForm state
      ]

renderEmpty ∷ Boolean → HTML
renderEmpty hidden =
  HH.div
    [ HP.classes
        $ [ B.alert, B.alertDanger ]
        ⊕ (guard hidden $> B.hide)
    , CSS.style $ marginBottom $ px 12.0
    ]
    [ HH.text "There is no available chart for this dataset" ]

renderForm ∷ VCS.State → HTML
renderForm state =
  HH.div
    [ HP.classes
        $ [ Rc.vizCardEditor ]
        ⊕ (guard hidden $> B.hide)
    ]
    [ renderChartTypeSelector state
    , renderChartConfiguration state
    ]
  where
  hidden ∷ Boolean
  hidden = Set.isEmpty state.availableChartTypes

renderChartTypeSelector ∷ VCS.State → HTML
renderChartTypeSelector state =
  HH.div
    [ HP.classes [ Rc.vizChartTypeSelector ] ]
    $ foldl (foldFn state.chartType) empty state.availableChartTypes
  where
  foldFn ∷ ChartType → Array HTML → ChartType → Array HTML
  foldFn selected accum current =
    flip cons accum $
      HH.img
        [ HP.src $ src current
        , HP.classes
            $ [ cls state.chartType ]
            ⊕ (guard (selected ≡ current) $> B.active)
        , HE.onClick (HE.input_ (right ∘ SetChartType current))
        ]

  src ∷ ChartType → String
  src Pie = "img/pie.svg"
  src Line = "img/line.svg"
  src Bar = "img/bar.svg"
  src Area = "img/area.svg"

  cls ∷ ChartType → HH.ClassName
  cls Pie = Rc.pieChartIcon
  cls Line = Rc.lineChartIcon
  cls Bar = Rc.barChartIcon
  cls Area = Rc.areaChartIcon

renderChartConfiguration ∷ VCS.State → HTML
renderChartConfiguration state =
  HH.div
    [ HP.classes [ Rc.vizChartConfiguration ] ]
    [ renderTab Pie
    , renderTab Line
    , renderTab Bar
    , renderTab Area
    , renderDimensions state
    ]
  where
  renderTab ∷ ChartType → HTML
  renderTab ty =
    showIf (state.chartType ≡ ty)
    [ HH.slot ty \_ →
        { component: formComponent
        , initialState: H.parentState Form.initialState
        }
    ]

  showIf ∷ Boolean → Array HTML → HTML
  showIf ok content = HH.div [ HP.classes $ (guard (not ok) $> B.hide) ] content

renderDimensions ∷ VCS.State → HTML
renderDimensions state =
  row
  [ chartInput Rc.axisLabelParam "Axis label angle"
      (_.axisLabelAngle ⋙ show) RotateAxisLabel (isPie state.chartType)
  , chartInput Rc.axisLabelParam "Axis font size"
      (_.axisLabelFontSize ⋙ show) SetAxisFontSize (isPie state.chartType)
  , boolChartInput Rc.chartDetailParam "If stack"
      (_.areaStacked)ToggleSetStacked (not $ isArea state.chartType)
  , boolChartInput Rc.chartDetailParam "If smooth"
      (_.smooth) ToggleSetSmooth (not $ isArea state.chartType)
  ]
  where
  chartInput
    ∷ HH.ClassName
    → String
    → (VCS.State → String)
    → (Int → Unit → Query Unit)
    → Boolean → HTML
  chartInput cls labelText valueFromState queryCtor isHidden =
    HH.form
      [ HP.classes
          $ [ B.colXs6, cls ]
          ⊕ (guard isHidden $> B.hide)
      , Cp.nonSubmit
      ]
      [ label labelText
      , HH.input
          [ HP.classes [ B.formControl ]
          , HP.value $ valueFromState state
          , ARIA.label labelText
          , HE.onValueInput
              $ pure ∘ map (right ∘ flip queryCtor unit) ∘ stringToInt
          ]
      ]

  boolChartInput
    ∷ HH.ClassName
    → String
    → (VCS.State → Boolean)
    → (Boolean → Unit → Query Unit)
    → Boolean → HTML
  boolChartInput cls labelText valueFromState queryCtor isHidden =
    HH.form
      [ HP.classes
          $ [ B.colXs6, cls ]
          ⊕ (guard isHidden $> B.hide)
      , Cp.nonSubmit
      ]
      [ label labelText
      , HH.input
          [ HP.inputType HP.InputCheckbox
          , HP.checked $ valueFromState state
          , ARIA.label labelText
          , HE.onChecked
             $ HE.input_ (right ∘ queryCtor (not $ valueFromState state))
          ]
      ]

  label ∷ String → HTML
  label str = HH.label [ HP.classes [ B.controlLabel ] ] [ HH.text str ]

  showIfNeqZero ∷ ∀ a. (Eq a, Show a, Semiring a) ⇒ a → String
  showIfNeqZero a = if zero ≡ a then "" else show a

  stringToInt ∷ String → Maybe Int
  stringToInt s = if s ≡ "" then Just 0 else Int.fromString s

-- Note: need to put running to state
eval ∷ QueryC ~> DSL
eval = coproduct cardEval chartEval

chartEval ∷ Query ~> DSL
chartEval q = do
  next <- case q of
    SetChartType ct n → H.modify (VCS._chartType .~ ct) $> n
    RotateAxisLabel angle n → H.modify (VCS._axisLabelAngle .~ angle) $> n
    SetAxisFontSize size n → H.modify (VCS._axisLabelFontSize .~ size) $> n
    ToggleSetStacked stacked n → H.modify (VCS._areaStacked .~ stacked) $> n
    ToggleSetSmooth smooth n → H.modify (VCS._smooth .~ smooth) $> n
  configure
  CC.raiseUpdatedP' CC.EvalModelUpdate
  pure next

cardEval ∷ CC.CardEvalQuery ~> DSL
cardEval = case _ of
  CC.EvalCard info output next → do
    for (output ^? Lens._Just ∘ P._Chart) \opts → do
      sample ← either (const []) id <$>
        H.fromAff (Quasar.sample opts.resource 0 20 :: Slam (Either Error JArray))
      if null sample
        then H.modify (VCS._availableChartTypes .~ Set.empty)
        else H.modify (VCS._sample .~ analyzeJArray sample) *> configure
    pure next
  CC.Save k → do
    st ← H.get
    config ← H.query st.chartType $ left $ H.request Form.GetConfiguration
    pure ∘ k $ Card.ChartOptions
      { chartConfig: fromMaybe Form.initialState config
      , options:
          { chartType: st.chartType
          , axisLabelFontSize: st.axisLabelFontSize
          , axisLabelAngle: st.axisLabelAngle
          , areaStacked: st.areaStacked
          , smooth: st.smooth
          }
      }
  CC.Load card next → do
    case card of
      Card.ChartOptions model → do
        let st = VCS.fromModel model
        H.set st
        H.query st.chartType
          $ left
          $ H.action $ Form.SetConfiguration model.chartConfig
        pure unit
      _ → pure unit
    pure next
  CC.SetDimensions dims next → do
    H.modify
      $ VCS._levelOfDetails
      .~ if dims.width < 576.0 ∨ dims.height < 416.0
           then Low
           else High
    pure next
  CC.ModelUpdated _ next →
    pure next
  CC.ZoomIn next →
    pure next

type AxisAccum =
  { category ∷ Array JCursor
  , value ∷ Array JCursor
  , time ∷ Array JCursor
  }

configure ∷ DSL Unit
configure = void do
  axises ← getAxises
  pieConf ← getOrInitial Pie
  setConfFor Pie $ pieBarConfiguration axises pieConf
  lineConf ← getOrInitial Line
  setConfFor Line $ lineConfiguration axises lineConf
  barConf ← getOrInitial Bar
  setConfFor Bar $ pieBarConfiguration axises barConf
  areaConf ← getOrInitial Area
  setConfFor Area $ areaConfiguration axises areaConf
  let chartTypes = available axises
  H.modify (VCS._availableChartTypes .~ available axises)
  case Set.toList chartTypes of
    L.Cons ct L.Nil → H.modify (VCS._chartType .~ ct)
    _ → pure unit
  where
  getOrInitial ∷ ChartType → DSL ChartConfiguration
  getOrInitial ty =
    map (fromMaybe Form.initialState)
      $ H.query ty
      $ left (H.request Form.GetConfiguration)

  setConfFor ∷ ChartType → ChartConfiguration → DSL Unit
  setConfFor ty conf =
    void $ H.query ty $ left $ H.action $ Form.SetConfiguration conf

  available ∷ AxisAccum → Set.Set ChartType
  available axises =
    foldMap Set.singleton
    $ if null axises.value
      then []
      else if not $ null axises.category
           then [Pie, Bar, Line, Area]
           else if (null axises.time) && (length axises.value < 2)
                then []
                else [Line]

  getAxises ∷ DSL AxisAccum
  getAxises = do
    sample ← H.gets _.sample
    pure $ foldl axisFolder {category: [], value: [], time: [] } $ M.toList sample

  axisFolder ∷ AxisAccum → Tuple JCursor Axis → AxisAccum
  axisFolder accum (Tuple cursor axis)
    | Ax.isCatAxis axis = accum { category = cons cursor accum.category }
    | Ax.isValAxis axis = accum { value = cons cursor accum.value }
    | Ax.isTimeAxis axis = accum {time = cons cursor accum.time }
    | otherwise = accum

  setPreviousValueFrom
    ∷ ∀ a. (Eq a) ⇒ Maybe (Select a) → Select a → Select a
  setPreviousValueFrom mbSel target  =
    (maybe id trySelect' $ mbSel >>= Lens.view _value) $ target

  pieBarConfiguration ∷ AxisAccum → ChartConfiguration → ChartConfiguration
  pieBarConfiguration axises current =
    let allAxises = axises.category ⊕ axises.time ⊕ axises.value
        categories =
          setPreviousValueFrom (index current.series 0)
          $ autoSelect $ newSelect allAxises
        measures =
          setPreviousValueFrom (index current.measures 0)
          $ autoSelect $ newSelect $ depends categories axises.value
        firstSeries =
          setPreviousValueFrom (index current.series 1)
          $ newSelect $ ifSelected [categories] $ allAxises ⊝ categories
        secondSeries =
          setPreviousValueFrom (index current.series 2)
          $ newSelect $ ifSelected [categories, firstSeries]
          $ allAxises ⊝ categories ⊝ firstSeries
        aggregation =
          setPreviousValueFrom (index current.aggregations 0) aggregationSelect
    in { series: [categories, firstSeries, secondSeries]
       , dimensions: []
       , measures: [measures]
       , aggregations: [aggregation]
       }

  lineConfiguration ∷ AxisAccum → ChartConfiguration → ChartConfiguration
  lineConfiguration axises current =
    let allAxises = (axises.category ⊕ axises.time ⊕ axises.value)
        dimensions =
          setPreviousValueFrom (index current.dimensions 0)
          $ autoSelect $ newSelect $ dependsOnArr axises.value
          -- This is redundant, I've put it here to notify
          -- that this behaviour differs from pieBar and can be changed.
          $ allAxises
        firstMeasures =
          setPreviousValueFrom (index current.measures 0)
          $ autoSelect $ newSelect $ depends dimensions
          $ axises.value ⊝ dimensions
        secondMeasures =
          setPreviousValueFrom (index current.measures 1)
          $ newSelect $ ifSelected [firstMeasures]
          $ depends dimensions
          $ axises.value ⊝ firstMeasures ⊝ dimensions
        firstSeries =
          setPreviousValueFrom (index current.series 0)
          $ newSelect $ ifSelected [dimensions] $ allAxises ⊝ dimensions
        secondSeries =
          setPreviousValueFrom (index current.series 1)
          $ newSelect $ ifSelected [dimensions, firstSeries]
          $ allAxises ⊝ dimensions ⊝ firstSeries
        firstAggregation =
          setPreviousValueFrom (index current.aggregations 0) aggregationSelect
        secondAggregation =
          setPreviousValueFrom (index current.aggregations 1) aggregationSelect
    in { series: [firstSeries, secondSeries]
       , dimensions: [dimensions]
       , measures: [firstMeasures, secondMeasures]
       , aggregations: [firstAggregation, secondAggregation]
       }

  areaConfiguration ∷ AxisAccum → ChartConfiguration → ChartConfiguration
  areaConfiguration axises current =
    let allAxises = (axises.category ⊕ axises.time ⊕ axises.value)
        dimensions =
          setPreviousValueFrom (index current.dimensions 0)
          $ autoSelect $ newSelect $ dependsOnArr axises.value
          -- This is redundant, I've put it here to notify
          -- that this behaviour differs from pieBar and can be changed.
          $ allAxises
        firstMeasures =
          setPreviousValueFrom (index current.measures 0)
          $ autoSelect $ newSelect $ depends dimensions
          $ axises.value ⊝ dimensions
        secondMeasures =
          setPreviousValueFrom (index current.measures 1)
          $ newSelect $ ifSelected [firstMeasures]
          $ depends dimensions
          $ axises.value ⊝ firstMeasures ⊝ dimensions
        firstSeries =
          setPreviousValueFrom (index current.series 0)
          $ newSelect $ ifSelected [dimensions] $ allAxises ⊝ dimensions
        secondSeries =
          setPreviousValueFrom (index current.series 1)
          $ newSelect $ ifSelected [dimensions, firstSeries]
          $ allAxises ⊝ dimensions ⊝ firstSeries
        firstAggregation =
          setPreviousValueFrom (index current.aggregations 0) aggregationSelect
        secondAggregation =
          setPreviousValueFrom (index current.aggregations 1) aggregationSelect
    in { series: [firstSeries, secondSeries]
       , dimensions: [dimensions]
       , measures: [firstMeasures, secondMeasures]
       , aggregations: [firstAggregation, secondAggregation]
       }

peek ∷ ∀ a. H.ChildF ChartType Form.QueryP a → DSL Unit
peek _ = configure *> CC.raiseUpdatedP' CC.EvalModelUpdate


Drop functor constraint from HalogenQ instances

module Halogen.Query.HalogenQ where

import Prelude

import Data.Bifunctor (class Bifunctor)
import Data.Coyoneda (Coyoneda)

data HalogenQ query action input a
  = Initialize a
  | Finalize a
  | Receive input a
  | Action action a
  | Query (Coyoneda query a) (Unit → a)

instance bifunctorHalogenQ :: Bifunctor (HalogenQ query action) where
  bimap f g = case _ of
    Initialize a -> Initialize (g a)
    Finalize a -> Finalize (g a)
    Receive i a -> Receive (f i) (g a)
    Action action a -> Action action (g a)
    Query fa k -> Query (map g fa) (map g k)

derive instance functorHalogenQ :: Functor (HalogenQ query action input)

module Halogen.Query.HalogenQ where

import Prelude

import Data.Bifunctor (class Bifunctor)
import Data.Coyoneda (Coyoneda)

data HalogenQ query action input a
  = Initialize a
  | Finalize a
  | Receive input a
  | Action action a
  | Query (Coyoneda query a) (Unit → a)

instance bifunctorHalogenQ :: Functor query => Bifunctor (HalogenQ query action) where
  bimap f g = case _ of
    Initialize a -> Initialize (g a)
    Finalize a -> Finalize (g a)
    Receive i a -> Receive (f i) (g a)
    Action action a -> Action action (g a)
    Query fa k -> Query (map g fa) (map g k)

derive instance functorHalogenQ :: Functor query => Functor (HalogenQ query action input)


Removed unused import

Removed unused import

module Test.Data.TimeSeries.Time.Parser (testTimeParser) where

import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (log, CONSOLE)
import Data.Date (canonicalDate)
import Data.DateTime (date)
import Data.Enum (toEnum)
import Data.Maybe (fromMaybe)
import Data.TimeSeries.Time.Parser (parseISODateTime)
import Test.Assert (assert, ASSERT)

testTimeParser :: forall eff. Eff (console :: CONSOLE, assert :: ASSERT | eff) Unit
testTimeParser = do

    let d1 = fromMaybe bottom $ canonicalDate <$> toEnum 2015 <*> toEnum 1 <*> toEnum 1
    let d2 = fromMaybe bottom $ canonicalDate <$> toEnum 2015 <*> toEnum 7 <*> toEnum 1
    let d3 = fromMaybe bottom $ canonicalDate <$> toEnum 2015 <*> toEnum 7 <*> toEnum 3

    log "Parse Year"
    assert $ date (parseISODateTime "2015") == d1

    log "Parse Year"
    -- log $ show $ parseISODateTime "2015-12-03"
    assert $ date (parseISODateTime "2015-07") == d2

    log "Parse Year"
    -- log $ show $ parseISODateTime "2015-12-03"
    assert $ date (parseISODateTime "2015-07-03") == d3

module Test.Data.TimeSeries.Time.Parser (testTimeParser) where

import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (log, CONSOLE)
import Data.Date (canonicalDate, year)
import Data.DateTime (date)
import Data.Enum (toEnum)
import Data.Maybe (fromMaybe)
import Data.TimeSeries.Time.Parser (parseISODateTime)
import Test.Assert (assert, ASSERT)

testTimeParser :: forall eff. Eff (console :: CONSOLE, assert :: ASSERT | eff) Unit
testTimeParser = do

    let d1 = fromMaybe bottom $ canonicalDate <$> toEnum 2015 <*> toEnum 1 <*> toEnum 1
    let d2 = fromMaybe bottom $ canonicalDate <$> toEnum 2015 <*> toEnum 7 <*> toEnum 1
    let d3 = fromMaybe bottom $ canonicalDate <$> toEnum 2015 <*> toEnum 7 <*> toEnum 3

    log "Parse Year"
    assert $ date (parseISODateTime "2015") == d1

    log "Parse Year"
    -- log $ show $ parseISODateTime "2015-12-03"
    assert $ date (parseISODateTime "2015-07") == d2

    log "Parse Year"
    -- log $ show $ parseISODateTime "2015-12-03"
    assert $ date (parseISODateTime "2015-07-03") == d3