Add missing onMouseEnter to indexed events

module Halogen.HTML.Events.Indexed
  ( IEventProp()
  , onAbort
  , onBeforeUnload
  , onError
  , onHashChange
  , onLoad
  , onPageShow
  , onPageHide
  , onResize
  , onScroll
  , onUnload
  , onChange
  , onInput
  , onInvalid
  , onReset
  , onSearch
  , onSelect
  , onSubmit
  , onClick
  , onContextMenu
  , onDoubleClick
  , onMouseDown
  , onMouseEnter
  , onMouseLeave
  , onMouseMove
  , onMouseOver
  , onMouseOut
  , onMouseUp
  , onKeyDown
  , onKeyPress
  , onKeyUp
  , onBlur
  , onFocus
  , onFocusIn
  , onFocusOut
  , onValueChange
  , onValueInput
  , onChecked
  , module ExportedEvents
  ) where

import Prelude

import Unsafe.Coerce (unsafeCoerce)

import Halogen.HTML.Events.Handler (EventHandler())
import Halogen.HTML.Events.Types (Event(), MouseEvent(), FocusEvent(), KeyboardEvent())
import Halogen.HTML.Properties.Indexed (IProp(), I())
import qualified Halogen.HTML.Events (input, input_) as ExportedEvents
import qualified Halogen.HTML.Events as E
import qualified Halogen.HTML.Events.Forms as E

type IEventProp r e i = (Event e -> EventHandler i) -> IProp r i

onAbort :: forall r i. IEventProp (onAbort :: I | r) () i
onAbort = unsafeCoerce E.onAbort

onBeforeUnload :: forall r i. IEventProp (onBeforeUnload :: I | r) () i
onBeforeUnload = unsafeCoerce E.onBeforeUnload

onError :: forall r i. IEventProp (onError :: I | r) () i
onError = unsafeCoerce E.onError

onHashChange :: forall r i. IEventProp (onHashChange :: I | r) () i
onHashChange = unsafeCoerce E.onHashChange

onLoad :: forall r i. IEventProp (onLoad :: I | r) () i
onLoad = unsafeCoerce E.onLoad

onPageShow :: forall r i. IEventProp (onPageShow :: I | r) () i
onPageShow = unsafeCoerce E.onPageShow

onPageHide :: forall r i. IEventProp (onPageHide :: I | r) () i
onPageHide = unsafeCoerce E.onPageHide

onResize :: forall r i. IEventProp (onResize :: I | r) () i
onResize = unsafeCoerce E.onResize

onScroll :: forall r i. IEventProp (onScroll :: I | r) () i
onScroll = unsafeCoerce E.onScroll

onUnload :: forall r i. IEventProp (onUnload :: I | r) () i
onUnload = unsafeCoerce E.onUnload

onChange :: forall r i. IEventProp (onChange :: I | r) () i
onChange = unsafeCoerce E.onChange

onInput :: forall r i. IEventProp (onInput :: I | r) () i
onInput = unsafeCoerce E.onInput

onInvalid :: forall r i. IEventProp (onInvalid :: I | r) () i
onInvalid = unsafeCoerce E.onInvalid

onReset :: forall r i. IEventProp (onReset :: I | r) () i
onReset = unsafeCoerce E.onReset

onSearch :: forall r i. IEventProp (onSearch :: I | r) () i
onSearch = unsafeCoerce E.onSearch

onSelect :: forall r i. IEventProp (onSelect :: I | r) () i
onSelect = unsafeCoerce E.onSelect

onSubmit :: forall r i. IEventProp (onSubmit :: I | r) () i
onSubmit = unsafeCoerce E.onSubmit

onClick :: forall r i. IEventProp (onClick :: I | r) MouseEvent i
onClick = unsafeCoerce E.onClick

onContextMenu :: forall r i. IEventProp (onContextMenu :: I | r) MouseEvent i
onContextMenu = unsafeCoerce E.onContextMenu

onDoubleClick :: forall r i. IEventProp (onDoubleClick :: I | r) MouseEvent i
onDoubleClick = unsafeCoerce E.onDoubleClick

onMouseDown :: forall r i. IEventProp (onMouseDown :: I | r) MouseEvent i
onMouseDown = unsafeCoerce E.onMouseDown

onMouseEnter :: forall r i. IEventProp (onMouseEnter :: I | r) MouseEvent i
onMouseEnter = unsafeCoerce E.onMouseEnter

onMouseLeave :: forall r i. IEventProp (onMouseLeave :: I | r) MouseEvent i
onMouseLeave = unsafeCoerce E.onMouseLeave

onMouseMove :: forall r i. IEventProp (onMouseMove :: I | r) MouseEvent i
onMouseMove = unsafeCoerce E.onMouseMove

onMouseOver :: forall r i. IEventProp (onMouseOver :: I | r) MouseEvent i
onMouseOver = unsafeCoerce E.onMouseOver

onMouseOut :: forall r i. IEventProp (onMouseOut :: I | r) MouseEvent i
onMouseOut = unsafeCoerce E.onMouseOut

onMouseUp :: forall r i. IEventProp (onMouseUp :: I | r) MouseEvent i
onMouseUp = unsafeCoerce E.onMouseUp

onKeyDown :: forall r i. IEventProp (onKeyDown :: I | r) KeyboardEvent i
onKeyDown = unsafeCoerce E.onKeyDown

onKeyPress :: forall r i. IEventProp (onKeyPress :: I | r) KeyboardEvent i
onKeyPress = unsafeCoerce E.onKeyPress

onKeyUp :: forall r i. IEventProp (onKeyUp :: I | r) KeyboardEvent i
onKeyUp = unsafeCoerce E.onKeyUp

onBlur :: forall r i. IEventProp (onBlur :: I | r) FocusEvent i
onBlur = unsafeCoerce E.onBlur

onFocus :: forall r i. IEventProp (onFocus :: I | r) FocusEvent i
onFocus = unsafeCoerce E.onFocus

onFocusIn :: forall r i. IEventProp (onFocusIn :: I | r) FocusEvent i
onFocusIn = unsafeCoerce E.onFocusIn

onFocusOut :: forall r i. IEventProp (onFocusOut :: I | r) FocusEvent i
onFocusOut = unsafeCoerce E.onFocusOut

onValueChange :: forall r f. (String -> EventHandler (f Unit)) -> IProp (value :: I, onChange :: I | r) (f Unit)
onValueChange = unsafeCoerce E.onValueChange

onValueInput :: forall r f. (String -> EventHandler (f Unit)) -> IProp (value :: I, onInput :: I | r) (f Unit)
onValueInput = unsafeCoerce E.onValueInput

onChecked :: forall r f. (Boolean -> EventHandler (f Unit)) -> IProp (checked :: I, onChange :: I | r) (f Unit)
onChecked = unsafeCoerce E.onChecked

module Halogen.HTML.Events.Indexed
  ( IEventProp()
  , onAbort
  , onBeforeUnload
  , onError
  , onHashChange
  , onLoad
  , onPageShow
  , onPageHide
  , onResize
  , onScroll
  , onUnload
  , onChange
  , onInput
  , onInvalid
  , onReset
  , onSearch
  , onSelect
  , onSubmit
  , onClick
  , onContextMenu
  , onDoubleClick
  , onMouseDown
  , onMouseLeave
  , onMouseMove
  , onMouseOver
  , onMouseOut
  , onMouseUp
  , onKeyDown
  , onKeyPress
  , onKeyUp
  , onBlur
  , onFocus
  , onFocusIn
  , onFocusOut
  , onValueChange
  , onValueInput
  , onChecked
  , module ExportedEvents
  ) where

import Prelude

import Unsafe.Coerce (unsafeCoerce)

import Halogen.HTML.Events.Handler (EventHandler())
import Halogen.HTML.Events.Types (Event(), MouseEvent(), FocusEvent(), KeyboardEvent())
import Halogen.HTML.Properties.Indexed (IProp(), I())
import qualified Halogen.HTML.Events (input, input_) as ExportedEvents
import qualified Halogen.HTML.Events as E
import qualified Halogen.HTML.Events.Forms as E

type IEventProp r e i = (Event e -> EventHandler i) -> IProp r i

onAbort :: forall r i. IEventProp (onAbort :: I | r) () i
onAbort = unsafeCoerce E.onAbort

onBeforeUnload :: forall r i. IEventProp (onBeforeUnload :: I | r) () i
onBeforeUnload = unsafeCoerce E.onBeforeUnload

onError :: forall r i. IEventProp (onError :: I | r) () i
onError = unsafeCoerce E.onError

onHashChange :: forall r i. IEventProp (onHashChange :: I | r) () i
onHashChange = unsafeCoerce E.onHashChange

onLoad :: forall r i. IEventProp (onLoad :: I | r) () i
onLoad = unsafeCoerce E.onLoad

onPageShow :: forall r i. IEventProp (onPageShow :: I | r) () i
onPageShow = unsafeCoerce E.onPageShow

onPageHide :: forall r i. IEventProp (onPageHide :: I | r) () i
onPageHide = unsafeCoerce E.onPageHide

onResize :: forall r i. IEventProp (onResize :: I | r) () i
onResize = unsafeCoerce E.onResize

onScroll :: forall r i. IEventProp (onScroll :: I | r) () i
onScroll = unsafeCoerce E.onScroll

onUnload :: forall r i. IEventProp (onUnload :: I | r) () i
onUnload = unsafeCoerce E.onUnload

onChange :: forall r i. IEventProp (onChange :: I | r) () i
onChange = unsafeCoerce E.onChange

onInput :: forall r i. IEventProp (onInput :: I | r) () i
onInput = unsafeCoerce E.onInput

onInvalid :: forall r i. IEventProp (onInvalid :: I | r) () i
onInvalid = unsafeCoerce E.onInvalid

onReset :: forall r i. IEventProp (onReset :: I | r) () i
onReset = unsafeCoerce E.onReset

onSearch :: forall r i. IEventProp (onSearch :: I | r) () i
onSearch = unsafeCoerce E.onSearch

onSelect :: forall r i. IEventProp (onSelect :: I | r) () i
onSelect = unsafeCoerce E.onSelect

onSubmit :: forall r i. IEventProp (onSubmit :: I | r) () i
onSubmit = unsafeCoerce E.onSubmit

onClick :: forall r i. IEventProp (onClick :: I | r) MouseEvent i
onClick = unsafeCoerce E.onClick

onContextMenu :: forall r i. IEventProp (onContextMenu :: I | r) MouseEvent i
onContextMenu = unsafeCoerce E.onContextMenu

onDoubleClick :: forall r i. IEventProp (onDoubleClick :: I | r) MouseEvent i
onDoubleClick = unsafeCoerce E.onDoubleClick

onMouseDown :: forall r i. IEventProp (onMouseDown :: I | r) MouseEvent i
onMouseDown = unsafeCoerce E.onMouseDown

onMouseLeave :: forall r i. IEventProp (onMouseLeave :: I | r) MouseEvent i
onMouseLeave = unsafeCoerce E.onMouseLeave

onMouseMove :: forall r i. IEventProp (onMouseMove :: I | r) MouseEvent i
onMouseMove = unsafeCoerce E.onMouseMove

onMouseOver :: forall r i. IEventProp (onMouseOver :: I | r) MouseEvent i
onMouseOver = unsafeCoerce E.onMouseOver

onMouseOut :: forall r i. IEventProp (onMouseOut :: I | r) MouseEvent i
onMouseOut = unsafeCoerce E.onMouseOut

onMouseUp :: forall r i. IEventProp (onMouseUp :: I | r) MouseEvent i
onMouseUp = unsafeCoerce E.onMouseUp

onKeyDown :: forall r i. IEventProp (onKeyDown :: I | r) KeyboardEvent i
onKeyDown = unsafeCoerce E.onKeyDown

onKeyPress :: forall r i. IEventProp (onKeyPress :: I | r) KeyboardEvent i
onKeyPress = unsafeCoerce E.onKeyPress

onKeyUp :: forall r i. IEventProp (onKeyUp :: I | r) KeyboardEvent i
onKeyUp = unsafeCoerce E.onKeyUp

onBlur :: forall r i. IEventProp (onBlur :: I | r) FocusEvent i
onBlur = unsafeCoerce E.onBlur

onFocus :: forall r i. IEventProp (onFocus :: I | r) FocusEvent i
onFocus = unsafeCoerce E.onFocus

onFocusIn :: forall r i. IEventProp (onFocusIn :: I | r) FocusEvent i
onFocusIn = unsafeCoerce E.onFocusIn

onFocusOut :: forall r i. IEventProp (onFocusOut :: I | r) FocusEvent i
onFocusOut = unsafeCoerce E.onFocusOut

onValueChange :: forall r f. (String -> EventHandler (f Unit)) -> IProp (value :: I, onChange :: I | r) (f Unit)
onValueChange = unsafeCoerce E.onValueChange

onValueInput :: forall r f. (String -> EventHandler (f Unit)) -> IProp (value :: I, onInput :: I | r) (f Unit)
onValueInput = unsafeCoerce E.onValueInput

onChecked :: forall r f. (Boolean -> EventHandler (f Unit)) -> IProp (checked :: I, onChange :: I | r) (f Unit)
onChecked = unsafeCoerce E.onChecked


Remove unused dependencies

Remove unused dependencies

module Main where

import Control.Monad.Eff
import Control.Monad.Eff.DOM (DOM())

import Debug.Trace

import Data.AddressBook.UI

main :: forall eff. Eff (trace :: Trace, dom :: DOM | eff) Unit
main = do
  trace "Attaching event handlers"
  setupEventHandlers

module Main where

import Data.Array

import Control.Monad.Eff
import Control.Monad.Eff.DOM (DOM())

import Debug.Trace

import Data.AddressBook.UI

main :: forall eff. Eff (trace :: Trace, dom :: DOM | eff) Unit
main = do
  trace "Attaching event handlers"
  setupEventHandlers


shortened func name

shortened func name

module KanColle.Expedition.New.Scorer where

import Prelude
import KanColle.Expedition.Base
import KanColle.Expedition.New.Types
import Data.Int

resourceScorer :: forall f. (ResourcePerHr -> Number) -> Scorer f
resourceScorer f rph _ = f rph

simpleResourceScorer :: forall f. ResourceRows Number -> Scorer f
simpleResourceScorer p = resourceScorer scorer
  where
    scorer rph = rph.fuel * p.fuel
               + rph.ammo * p.ammo
               + rph.steel * p.steel
               + rph.bauxite * p.bauxite

-- TODO: 1. calc fleet net income for one exped
-- 2. sum up with others
calcResourcePerHr :: FleetNetIncome -> Info -> Int -> ResourcePerHr
calcResourcePerHr (FNI ni) info afkTimeInMin =
    { fuel: perHr ni.fuel
    , ammo: perHr ni.ammo
    , steel: perHr ni.steel
    , bauxite: perHr ni.bauxite
    }
  where
    t = max afkTimeInMin info.timeInMin
    perHr :: Int -> Number
    perHr x = toNumber (60 * x) / toNumber t

module KanColle.Expedition.New.Scorer where

import Prelude
import KanColle.Expedition.Base
import KanColle.Expedition.New.Types
import Data.Int

resourceScorer :: forall f. (ResourcePerHr -> Number) -> Scorer f
resourceScorer f rph _ = f rph

simpleResourceScorer :: forall f. ResourceRows Number -> Scorer f
simpleResourceScorer p = resourceScorer scorer
  where
    scorer rph = rph.fuel * p.fuel
               + rph.ammo * p.ammo
               + rph.steel * p.steel
               + rph.bauxite * p.bauxite

-- TODO: 1. calc fleet net income for one exped
-- 2. sum up with others
calcResourcePerHrWithAFKTime :: FleetNetIncome -> Info -> Int -> ResourcePerHr
calcResourcePerHrWithAFKTime (FNI ni) info afkTimeInMin =
    { fuel: perHr ni.fuel
    , ammo: perHr ni.ammo
    , steel: perHr ni.steel
    , bauxite: perHr ni.bauxite
    }
  where
    t = max afkTimeInMin info.timeInMin
    perHr :: Int -> Number
    perHr x = toNumber (60 * x) / toNumber t


cleaning

cleaning


Minor improvement to text

Minor improvement to text

module Mustache where

import Control.Monad.Eff (Eff())
import Data.StrMap (StrMap())
import Prelude (Show, Unit())

type Template = String

type Tag = String

type View = StrMap String

type Partials = StrMap String

type Token = Array TokenElement

foreign import data TokenElement :: *

foreign import showTokenElementImpl :: TokenElement -> String

instance showTokenElement :: Show TokenElement where
  show = showTokenElementImpl

-- | Effect that represents side effects within mustache.js.
-- |
-- | This is used to indicate interactions with the cache in mustache.js.
foreign import data MustacheEffect :: !

-- | Name of the mustache.js dependency.
foreign import name :: String

-- | Version string as specified in mustache.js.
foreign import version :: String

-- | Default mustache.js tags (default: array with "{{" and "}}").
foreign import tags :: Array Tag

-- | Precompile a template and write parsed tokens to a cache within mustache.js.
foreign import parse :: forall e. Template -> Array Tag -> Eff (mustache :: MustacheEffect | e) (Array Token)

-- | Render the template with the given view and partial templates.
foreign import render :: forall e. Template -> View -> Partials -> Eff (mustache :: MustacheEffect | e) String

-- | Escape various characters as HTML entities in the given string.
foreign import escape :: String -> String

-- | Clear the internal cache used by mustache.js.
foreign import clearCache :: forall e. Eff (mustache :: MustacheEffect | e) Unit

module Mustache where

import Control.Monad.Eff (Eff())
import Data.StrMap (StrMap())
import Prelude (Show, Unit())

type Template = String

type Tag = String

type View = StrMap String

type Partials = StrMap String

type Token = Array TokenElement

foreign import data TokenElement :: *

foreign import showTokenElementImpl :: TokenElement -> String

instance showTokenElement :: Show TokenElement where
  show = showTokenElementImpl

-- | Effect that represents side effects within mustache.js.
-- |
-- | This is used to indicate interactions with the cache in mustache.js.
foreign import data MustacheEffect :: !

-- | Name of the mustache.js dependency.
foreign import name :: String

-- | Version string as specified in mustache.js.
foreign import version :: String

-- | Default mustache.js tags (default: array with "{{" and "}}").
foreign import tags :: Array Tag

-- | Precompile a template and store parsed token in mustache.js's cache.
foreign import parse :: forall e. Template -> Array Tag -> Eff (mustache :: MustacheEffect | e) (Array Token)

-- | Render the template with the given view and partial templates.
foreign import render :: forall e. Template -> View -> Partials -> Eff (mustache :: MustacheEffect | e) String

-- | Escape various characters as HTML entities in the given string.
foreign import escape :: String -> String

-- | Clear the internal cache used by mustache.js.
foreign import clearCache :: forall e. Eff (mustache :: MustacheEffect | e) Unit


Update docs for `parse` to discourage its use (#25)

* Update docs for `parse` to discourage its use

* Use same spelling within the same doc string

-- | A module providing a type and operations for the native JavaScript `Date`
-- | object.
-- |
-- | The `JSDate` type and associated functions are provided for interop
-- | purposes with JavaScript, but for working with dates in PureScript it is
-- | recommended that `DateTime` representation is used instead - `DateTime`
-- | offers greater type safety, a more PureScript-friendly interface, and has
-- | a `Generic` instance.
module Data.JSDate
  ( JSDate
  , readDate
  , isValid
  , fromDateTime
  , toDateTime
  , toDate
  , fromInstant
  , toInstant
  , jsdate
  , jsdateLocal
  , now
  , parse
  , getTime
  , getUTCDate
  , getUTCDay
  , getUTCFullYear
  , getUTCHours
  , getUTCMilliseconds
  , getUTCMinutes
  , getUTCMonth
  , getUTCSeconds
  , getDate
  , getDay
  , getFullYear
  , getHours
  , getMilliseconds
  , getMinutes
  , getMonth
  , getSeconds
  , getTimezoneOffset
  , toDateString
  , toISOString
  , toString
  , toTimeString
  , toUTCString
  , fromTime
  ) where

import Prelude

import Data.Date as Date
import Data.DateTime (DateTime(..), Date)
import Data.DateTime as DateTime
import Data.DateTime.Instant (Instant)
import Data.DateTime.Instant as Instant
import Data.Enum (fromEnum)
import Data.Function.Uncurried (Fn2, runFn2)
import Data.Int (toNumber)
import Data.Maybe (Maybe(..))
import Data.Time as Time
import Data.Time.Duration (Milliseconds(..))
import Effect (Effect)
import Foreign (F, Foreign, unsafeReadTagged)

-- | The type of JavaScript `Date` objects.
foreign import data JSDate :: Type

instance eqJSDate :: Eq JSDate where
  eq a b = getTime a == getTime b

instance ordJSDate :: Ord JSDate where
  compare a b = getTime a `compare` getTime b

instance showJSDate :: Show JSDate where
  show a = "(fromTime " <> show (getTime a) <> ")"

-- | Attempts to read a `Foreign` value as a `JSDate`.
readDate :: Foreign -> F JSDate
readDate = unsafeReadTagged "Date"

-- | Checks whether a date value is valid. When a date is invalid, the majority
-- | of the functions return `NaN`, `"Invalid Date"`, or throw an exception.
foreign import isValid :: JSDate -> Boolean

-- | Converts a `DateTime` value into a native JavaScript date object. The
-- | resulting date value is guaranteed to be valid.
fromDateTime :: DateTime -> JSDate
fromDateTime (DateTime d t) = jsdate
  { year: toNumber (fromEnum (Date.year d))
  , month: toNumber (fromEnum (Date.month d) - 1)
  , day: toNumber (fromEnum (Date.day d))
  , hour: toNumber (fromEnum (Time.hour t))
  , minute: toNumber (fromEnum (Time.minute t))
  , second: toNumber (fromEnum (Time.second t))
  , millisecond: toNumber (fromEnum (Time.millisecond t))
  }

-- | Attempts to construct a `DateTime` value for a `JSDate`. `Nothing` is
-- | returned only when the date value is an invalid date.
toDateTime :: JSDate -> Maybe DateTime
toDateTime = map Instant.toDateTime <$> toInstant

-- | Attempts to construct a `Date` value for a `JSDate`, ignoring any time
-- | component of the `JSDate`. `Nothing` is returned only when the date value
-- | is an invalid date.
toDate :: JSDate -> Maybe Date
toDate = map DateTime.date <$> toDateTime

-- | Creates a `JSDate` from an `Instant` value.
foreign import fromInstant :: Instant -> JSDate

-- | Attempts to construct an `Instant` for a `JSDate`. `Nothing` is returned
-- | only when the date value is an invalid date.
toInstant :: JSDate -> Maybe Instant
toInstant = Instant.instant <<< Milliseconds <=< toInstantImpl Just Nothing

foreign import toInstantImpl
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> JSDate
  -> Maybe Number

-- | Constructs a new `JSDate` from UTC component values. If any of the values
-- | are `NaN` the resulting date will be invalid.
foreign import jsdate
  :: { year :: Number
     , month :: Number
     , day :: Number
     , hour :: Number
     , minute :: Number
     , second :: Number
     , millisecond :: Number
     }
  -> JSDate

-- | Constructs a new `JSDate` from component values using the current machine's
-- | locale. If any of the values are `NaN` the resulting date will be invalid.
foreign import jsdateLocal
  :: { year :: Number
     , month :: Number
     , day :: Number
     , hour :: Number
     , minute :: Number
     , second :: Number
     , millisecond :: Number
     }
  -> Effect JSDate

foreign import dateMethodEff :: forall a. Fn2 String JSDate (Effect a)
foreign import dateMethod :: forall a. Fn2 String JSDate a

-- | Attempts to parse a date from a string. The behavior of this function is
-- | implementation specific until ES5, so may not always have the same
-- | behavior for a given string. For this reason, it is **strongly** encouraged
-- | that you avoid this function if at all possible.
-- |
-- | If you must use it, the RFC2822 and ISO8601 date string formats should
-- | parse consistently.
-- |
-- | This function is effectful because if no time zone is specified in the
-- | string the current locale's time zone will be used instead.
foreign import parse :: String -> Effect JSDate

-- | Gets a `JSDate` value for the date and time according to the current
-- | machine's clock.
-- |
-- | Unless a `JSDate` is required specifically, consider using the functions in
-- | `Effect.Now` instead.
foreign import now :: Effect JSDate

-- | Returns the date as a number of milliseconds since 1970-01-01 00:00:00 UTC.
getTime :: JSDate -> Number
getTime dt = runFn2 dateMethod "getTime" dt

-- | Returns the day of the month for a date, according to UTC.
getUTCDate :: JSDate -> Number
getUTCDate dt = runFn2 dateMethod "getUTCDate" dt

-- | Returns the day of the week for a date, according to UTC.
getUTCDay :: JSDate -> Number
getUTCDay dt = runFn2 dateMethod "getUTCDay" dt

-- | Returns the year for a date, according to UTC.
getUTCFullYear :: JSDate -> Number
getUTCFullYear dt = runFn2 dateMethod "getUTCFullYear" dt

-- | Returns the hours for a date, according to UTC.
getUTCHours :: JSDate -> Number
getUTCHours dt = runFn2 dateMethod "getUTCHours" dt

-- | Returns the milliseconds for a date, according to UTC.
getUTCMilliseconds :: JSDate -> Number
getUTCMilliseconds dt = runFn2 dateMethod "getUTCMilliseconds" dt

-- | Returns the minutes for a date, according to UTC.
getUTCMinutes :: JSDate -> Number
getUTCMinutes dt = runFn2 dateMethod "getUTCMinutes" dt

-- | Returns the month for a date, according to UTC.
getUTCMonth :: JSDate -> Number
getUTCMonth dt = runFn2 dateMethod "getUTCMonth" dt

-- | Returns the seconds for a date, according to UTC.
getUTCSeconds :: JSDate -> Number
getUTCSeconds dt = runFn2 dateMethod "getUTCSeconds" dt

-- | Returns the day of the month for a date, according to the current
-- | machine's date/time locale.
getDate :: JSDate -> Effect Number
getDate dt = runFn2 dateMethodEff "getDate" dt

-- | Returns the day of the week for a date, according to the current
-- | machine's date/time locale.
getDay :: JSDate -> Effect Number
getDay dt = runFn2 dateMethodEff "getDay" dt

-- | Returns the year for a date, according to the current machine's date/time
-- | locale.
getFullYear :: JSDate -> Effect Number
getFullYear dt = runFn2 dateMethodEff "getFullYear" dt

-- | Returns the hour for a date, according to the current machine's date/time
-- | locale.
getHours :: JSDate -> Effect Number
getHours dt = runFn2 dateMethodEff "getHours" dt

-- | Returns the milliseconds for a date, according to the current machine's
-- | date/time locale.
getMilliseconds :: JSDate -> Effect Number
getMilliseconds dt = runFn2 dateMethodEff "getMilliseconds" dt

-- | Returns the minutes for a date, according to the current machine's
-- | date/time locale.
getMinutes :: JSDate -> Effect Number
getMinutes dt = runFn2 dateMethodEff "getMinutes" dt

-- | Returns the month for a date, according to the current machine's
-- | date/time locale.
getMonth :: JSDate -> Effect Number
getMonth dt = runFn2 dateMethodEff "getMonth" dt

-- | Returns the seconds for a date, according to the current machine's
-- | date/time locale.
getSeconds :: JSDate -> Effect Number
getSeconds dt = runFn2 dateMethodEff "getSeconds" dt

-- | Returns the time-zone offset for a date, according to the current machine's
-- | date/time locale.
getTimezoneOffset :: JSDate -> Effect Number
getTimezoneOffset dt = runFn2 dateMethodEff "getTimezoneOffset" dt

-- | Returns the date portion of a date value as a human-readable string.
toDateString :: JSDate -> String
toDateString dt = runFn2 dateMethod "toDateString" dt

-- | Converts a date value to an ISO 8601 Extended format date string.
toISOString :: JSDate -> Effect String
toISOString dt = runFn2 dateMethodEff "toISOString" dt

-- | Returns a string representing for a date value.
toString :: JSDate -> String
toString dt = runFn2 dateMethod "toString" dt

-- | Returns the time portion of a date value as a human-readable string.
toTimeString :: JSDate -> String
toTimeString dt = runFn2 dateMethod "toTimeString" dt

-- | Returns the date as a string using the UTC timezone.
toUTCString :: JSDate -> String
toUTCString dt = runFn2 dateMethod "toUTCString" dt

-- | Returns the date at a number of milliseconds since 1970-01-01 00:00:00 UTC.
foreign import fromTime :: Number -> JSDate

-- | A module providing a type and operations for the native JavaScript `Date`
-- | object.
-- |
-- | The `JSDate` type and associated functions are provided for interop
-- | purposes with JavaScript, but for working with dates in PureScript it is
-- | recommended that `DateTime` representation is used instead - `DateTime`
-- | offers greater type safety, a more PureScript-friendly interface, and has
-- | a `Generic` instance.
module Data.JSDate
  ( JSDate
  , readDate
  , isValid
  , fromDateTime
  , toDateTime
  , toDate
  , fromInstant
  , toInstant
  , jsdate
  , jsdateLocal
  , now
  , parse
  , getTime
  , getUTCDate
  , getUTCDay
  , getUTCFullYear
  , getUTCHours
  , getUTCMilliseconds
  , getUTCMinutes
  , getUTCMonth
  , getUTCSeconds
  , getDate
  , getDay
  , getFullYear
  , getHours
  , getMilliseconds
  , getMinutes
  , getMonth
  , getSeconds
  , getTimezoneOffset
  , toDateString
  , toISOString
  , toString
  , toTimeString
  , toUTCString
  , fromTime
  ) where

import Prelude

import Data.Date as Date
import Data.DateTime (DateTime(..), Date)
import Data.DateTime as DateTime
import Data.DateTime.Instant (Instant)
import Data.DateTime.Instant as Instant
import Data.Enum (fromEnum)
import Data.Function.Uncurried (Fn2, runFn2)
import Data.Int (toNumber)
import Data.Maybe (Maybe(..))
import Data.Time as Time
import Data.Time.Duration (Milliseconds(..))
import Effect (Effect)
import Foreign (F, Foreign, unsafeReadTagged)

-- | The type of JavaScript `Date` objects.
foreign import data JSDate :: Type

instance eqJSDate :: Eq JSDate where
  eq a b = getTime a == getTime b

instance ordJSDate :: Ord JSDate where
  compare a b = getTime a `compare` getTime b

instance showJSDate :: Show JSDate where
  show a = "(fromTime " <> show (getTime a) <> ")"

-- | Attempts to read a `Foreign` value as a `JSDate`.
readDate :: Foreign -> F JSDate
readDate = unsafeReadTagged "Date"

-- | Checks whether a date value is valid. When a date is invalid, the majority
-- | of the functions return `NaN`, `"Invalid Date"`, or throw an exception.
foreign import isValid :: JSDate -> Boolean

-- | Converts a `DateTime` value into a native JavaScript date object. The
-- | resulting date value is guaranteed to be valid.
fromDateTime :: DateTime -> JSDate
fromDateTime (DateTime d t) = jsdate
  { year: toNumber (fromEnum (Date.year d))
  , month: toNumber (fromEnum (Date.month d) - 1)
  , day: toNumber (fromEnum (Date.day d))
  , hour: toNumber (fromEnum (Time.hour t))
  , minute: toNumber (fromEnum (Time.minute t))
  , second: toNumber (fromEnum (Time.second t))
  , millisecond: toNumber (fromEnum (Time.millisecond t))
  }

-- | Attempts to construct a `DateTime` value for a `JSDate`. `Nothing` is
-- | returned only when the date value is an invalid date.
toDateTime :: JSDate -> Maybe DateTime
toDateTime = map Instant.toDateTime <$> toInstant

-- | Attempts to construct a `Date` value for a `JSDate`, ignoring any time
-- | component of the `JSDate`. `Nothing` is returned only when the date value
-- | is an invalid date.
toDate :: JSDate -> Maybe Date
toDate = map DateTime.date <$> toDateTime

-- | Creates a `JSDate` from an `Instant` value.
foreign import fromInstant :: Instant -> JSDate

-- | Attempts to construct an `Instant` for a `JSDate`. `Nothing` is returned
-- | only when the date value is an invalid date.
toInstant :: JSDate -> Maybe Instant
toInstant = Instant.instant <<< Milliseconds <=< toInstantImpl Just Nothing

foreign import toInstantImpl
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> JSDate
  -> Maybe Number

-- | Constructs a new `JSDate` from UTC component values. If any of the values
-- | are `NaN` the resulting date will be invalid.
foreign import jsdate
  :: { year :: Number
     , month :: Number
     , day :: Number
     , hour :: Number
     , minute :: Number
     , second :: Number
     , millisecond :: Number
     }
  -> JSDate

-- | Constructs a new `JSDate` from component values using the current machine's
-- | locale. If any of the values are `NaN` the resulting date will be invalid.
foreign import jsdateLocal
  :: { year :: Number
     , month :: Number
     , day :: Number
     , hour :: Number
     , minute :: Number
     , second :: Number
     , millisecond :: Number
     }
  -> Effect JSDate

foreign import dateMethodEff :: forall a. Fn2 String JSDate (Effect a)
foreign import dateMethod :: forall a. Fn2 String JSDate a

-- | Attempts to parse a date from a string. The behaviour of this function is
-- | implementation specific until ES5, so may not always have the same
-- | behaviour for a given string. The RFC2822 and ISO8601 date string formats
-- | should parse consistently.
-- |
-- | This function is effectful because if no time zone is specified in the
-- | string the current locale's time zone will be used instead.
foreign import parse :: String -> Effect JSDate

-- | Gets a `JSDate` value for the date and time according to the current
-- | machine's clock.
-- |
-- | Unless a `JSDate` is required specifically, consider using the functions in
-- | `Effect.Now` instead.
foreign import now :: Effect JSDate

-- | Returns the date as a number of milliseconds since 1970-01-01 00:00:00 UTC.
getTime :: JSDate -> Number
getTime dt = runFn2 dateMethod "getTime" dt

-- | Returns the day of the month for a date, according to UTC.
getUTCDate :: JSDate -> Number
getUTCDate dt = runFn2 dateMethod "getUTCDate" dt

-- | Returns the day of the week for a date, according to UTC.
getUTCDay :: JSDate -> Number
getUTCDay dt = runFn2 dateMethod "getUTCDay" dt

-- | Returns the year for a date, according to UTC.
getUTCFullYear :: JSDate -> Number
getUTCFullYear dt = runFn2 dateMethod "getUTCFullYear" dt

-- | Returns the hours for a date, according to UTC.
getUTCHours :: JSDate -> Number
getUTCHours dt = runFn2 dateMethod "getUTCHours" dt

-- | Returns the milliseconds for a date, according to UTC.
getUTCMilliseconds :: JSDate -> Number
getUTCMilliseconds dt = runFn2 dateMethod "getUTCMilliseconds" dt

-- | Returns the minutes for a date, according to UTC.
getUTCMinutes :: JSDate -> Number
getUTCMinutes dt = runFn2 dateMethod "getUTCMinutes" dt

-- | Returns the month for a date, according to UTC.
getUTCMonth :: JSDate -> Number
getUTCMonth dt = runFn2 dateMethod "getUTCMonth" dt

-- | Returns the seconds for a date, according to UTC.
getUTCSeconds :: JSDate -> Number
getUTCSeconds dt = runFn2 dateMethod "getUTCSeconds" dt

-- | Returns the day of the month for a date, according to the current
-- | machine's date/time locale.
getDate :: JSDate -> Effect Number
getDate dt = runFn2 dateMethodEff "getDate" dt

-- | Returns the day of the week for a date, according to the current
-- | machine's date/time locale.
getDay :: JSDate -> Effect Number
getDay dt = runFn2 dateMethodEff "getDay" dt

-- | Returns the year for a date, according to the current machine's date/time
-- | locale.
getFullYear :: JSDate -> Effect Number
getFullYear dt = runFn2 dateMethodEff "getFullYear" dt

-- | Returns the hour for a date, according to the current machine's date/time
-- | locale.
getHours :: JSDate -> Effect Number
getHours dt = runFn2 dateMethodEff "getHours" dt

-- | Returns the milliseconds for a date, according to the current machine's
-- | date/time locale.
getMilliseconds :: JSDate -> Effect Number
getMilliseconds dt = runFn2 dateMethodEff "getMilliseconds" dt

-- | Returns the minutes for a date, according to the current machine's
-- | date/time locale.
getMinutes :: JSDate -> Effect Number
getMinutes dt = runFn2 dateMethodEff "getMinutes" dt

-- | Returns the month for a date, according to the current machine's
-- | date/time locale.
getMonth :: JSDate -> Effect Number
getMonth dt = runFn2 dateMethodEff "getMonth" dt

-- | Returns the seconds for a date, according to the current machine's
-- | date/time locale.
getSeconds :: JSDate -> Effect Number
getSeconds dt = runFn2 dateMethodEff "getSeconds" dt

-- | Returns the time-zone offset for a date, according to the current machine's
-- | date/time locale.
getTimezoneOffset :: JSDate -> Effect Number
getTimezoneOffset dt = runFn2 dateMethodEff "getTimezoneOffset" dt

-- | Returns the date portion of a date value as a human-readable string.
toDateString :: JSDate -> String
toDateString dt = runFn2 dateMethod "toDateString" dt

-- | Converts a date value to an ISO 8601 Extended format date string.
toISOString :: JSDate -> Effect String
toISOString dt = runFn2 dateMethodEff "toISOString" dt

-- | Returns a string representing for a date value.
toString :: JSDate -> String
toString dt = runFn2 dateMethod "toString" dt

-- | Returns the time portion of a date value as a human-readable string.
toTimeString :: JSDate -> String
toTimeString dt = runFn2 dateMethod "toTimeString" dt

-- | Returns the date as a string using the UTC timezone.
toUTCString :: JSDate -> String
toUTCString dt = runFn2 dateMethod "toUTCString" dt

-- | Returns the date at a number of milliseconds since 1970-01-01 00:00:00 UTC.
foreign import fromTime :: Number -> JSDate


reword comment

reword comment

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

import Prelude

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

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

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

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

foreign import writeIsMounted :: forall props state e. ReactThis props state -> Boolean -> Eff e Unit

foreign import readIsMounted :: forall props state e. ReactThis props state -> Eff e Boolean

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

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

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

derive instance newtypeConnectState :: Newtype (ConnectState state) _

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

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

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

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

    -- | Subscription to redox store happens in `componentDidMount`, rather than
    -- | on `componentWillMount`.  This is because `componentWillUnmount` and
    -- | `componentDidMount` do not fire in SSR. Otherwise we'd have a memory
    -- | leak.  Note that if a child component triggers an action in its
    -- | `componentWillMount` method its changes might be missed.
    componentDidMount this = do
      writeIsMounted this true
      ctx <- unsafeCoerceEff $ ctxEff this
      sid <- Redox.subscribe ctx.store $ update this
      st <- readState this
      void $ writeState this (over ConnectState (_ { sid = Just sid }) st)

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

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

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

-- | You must wrap the resulting component with `ReactHocs.accessContext` from
-- | `purescript-react-hocs`.  Checkout `connect` bellow.  This function makes
-- | the redox store and dispatch function available through the context.
-- | The first argument is a `Lens` that identifies the part of the store state
-- | that you want to subscribe for.
-- | The second argument let you combine state and additional properties
-- | `props'` to get props of the class that you are connecting to the store.
-- | You can read the context with:
-- | ```purescript
-- | ReactHocs.readContext this >>= pure <<< _.redox :: Eff eff (RedoxContext state (Free dsl (state -> state))  eff)
-- | ```
connect'
  :: forall state state' dsl props props' reff eff
   . Proxy state
  -> Getter' state state'
  -> (DispatchFn state dsl (read :: ReadRedox, subscribe :: SubscribeRedox | reff) eff -> state' -> props' -> props)
  -> ReactClass props
  -> ReactSpec props' (ConnectState state') ( context :: CONTEXT, redox :: RedoxStore (read :: ReadRedox, subscribe :: SubscribeRedox | reff) | eff )
connect' _ _lns _iso cls = _connect ctxEff _lns _iso cls
  where
    ctxEff this = _.redox <$> ctx
      where
        ctx = readContext (Proxy :: Proxy ({ redox :: RedoxContext state dsl (read :: ReadRedox, subscribe :: SubscribeRedox | reff) eff })) this

connect
  :: forall state state' dsl props props' reff eff'
   . Proxy state
  -> Getter' state state'
  -> (DispatchFn state dsl (read :: ReadRedox, subscribe :: SubscribeRedox | reff) eff' -> state' -> props' -> props)
  -> ReactClass props
  -> ReactClass props'
connect p _lns _iso cls = accessContext $ R.createClass $ connect' p _lns _iso cls

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

dispatch
  :: forall dsl rProps rState state reff eff
   . ReactThis rProps rState
  -> Free dsl (state -> state)
  -> Eff (context :: CONTEXT, redox :: RedoxStore reff | eff) (Canceler (context :: CONTEXT, redox :: RedoxStore reff | eff))
dispatch this dsl = do
  { dispatch: disp } <- _.redox <$> readContext (Proxy :: Proxy ({ redox :: RedoxContext state dsl reff (context :: CONTEXT | eff) }) ) this
  disp dsl

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

import Prelude

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

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

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

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

foreign import writeIsMounted :: forall props state e. ReactThis props state -> Boolean -> Eff e Unit

foreign import readIsMounted :: forall props state e. ReactThis props state -> Eff e Boolean

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

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

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

derive instance newtypeConnectState :: Newtype (ConnectState state) _

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

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

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

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

    -- | Subscription to redox store happens in `componentDidMount`, rather than
    -- | on `componentWillMount`.  This is because `componentWillUnmount` and
    -- | `componentDidMount` do not fire in SSR. Otherwise we'd have a memory
    -- | leak.  Note that if a child triggers an action in its
    -- | `componentWillMount` it's change might be
    -- | missed.
    componentDidMount this = do
      writeIsMounted this true
      ctx <- unsafeCoerceEff $ ctxEff this
      sid <- Redox.subscribe ctx.store $ update this
      st <- readState this
      void $ writeState this (over ConnectState (_ { sid = Just sid }) st)

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

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

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

-- | You must wrap the resulting component with `ReactHocs.accessContext` from
-- | `purescript-react-hocs`.  Checkout `connect` bellow.  This function makes
-- | the redox store and dispatch function available through the context.
-- | The first argument is a `Lens` that identifies the part of the store state
-- | that you want to subscribe for.
-- | The second argument let you combine state and additional properties
-- | `props'` to get props of the class that you are connecting to the store.
-- | You can read the context with:
-- | ```purescript
-- | ReactHocs.readContext this >>= pure <<< _.redox :: Eff eff (RedoxContext state (Free dsl (state -> state))  eff)
-- | ```
connect'
  :: forall state state' dsl props props' reff eff
   . Proxy state
  -> Getter' state state'
  -> (DispatchFn state dsl (read :: ReadRedox, subscribe :: SubscribeRedox | reff) eff -> state' -> props' -> props)
  -> ReactClass props
  -> ReactSpec props' (ConnectState state') ( context :: CONTEXT, redox :: RedoxStore (read :: ReadRedox, subscribe :: SubscribeRedox | reff) | eff )
connect' _ _lns _iso cls = _connect ctxEff _lns _iso cls
  where
    ctxEff this = _.redox <$> ctx
      where
        ctx = readContext (Proxy :: Proxy ({ redox :: RedoxContext state dsl (read :: ReadRedox, subscribe :: SubscribeRedox | reff) eff })) this

connect
  :: forall state state' dsl props props' reff eff'
   . Proxy state
  -> Getter' state state'
  -> (DispatchFn state dsl (read :: ReadRedox, subscribe :: SubscribeRedox | reff) eff' -> state' -> props' -> props)
  -> ReactClass props
  -> ReactClass props'
connect p _lns _iso cls = accessContext $ R.createClass $ connect' p _lns _iso cls

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

dispatch
  :: forall dsl rProps rState state reff eff
   . ReactThis rProps rState
  -> Free dsl (state -> state)
  -> Eff (context :: CONTEXT, redox :: RedoxStore reff | eff) (Canceler (context :: CONTEXT, redox :: RedoxStore reff | eff))
dispatch this dsl = do
  { dispatch: disp } <- _.redox <$> readContext (Proxy :: Proxy ({ redox :: RedoxContext state dsl reff (context :: CONTEXT | eff) }) ) this
  disp dsl


update test: withStore returns Eff monadic value

module Test.ServerSideRendering where

import Control.Comonad.Cofree (Cofree, exploreM, unfoldCofree)
import Control.Monad.Aff (Aff, Canceler)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Free (Free, liftF)
import Data.Lens (to)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype, over, un)
import Prelude (class Functor, Unit, bind, const, discard, id, pure, unit, void, ($), (<$>))
import React (ReactClass, createClass, createClassStateless, createElement, getProps, spec)
import React.DOM (div', text)
import React.Redox (connect, withStore)
import ReactDOM (renderToString)
import Redox (CreateRedox, RedoxStore, Store, ReadWriteRedox, mkStore)
import Redox (dispatch) as Redox
import Test.Unit (TestSuite, suite, test)
import Test.Unit.Assert (equal)
import Type.Proxy (Proxy(..))

data Command a
  = PutMsg String a
  | Reset a

derive instance functorCommand :: Functor Command

putMsg :: forall a. String -> Free Command (a -> a)
putMsg msg = liftF (PutMsg msg id)

reset :: forall a. Free Command (a -> a)
reset = liftF (Reset id)

newtype Run eff a = Run
  { putMsg :: String -> Aff eff a
  , reset :: Aff eff a
  }

derive instance functorRun :: Functor (Run eff)

newtype State = State { msg :: Maybe String }

derive instance newtypeState :: Newtype State _

mkInterp :: forall eff. State -> Cofree (Run eff) State
mkInterp state = unfoldCofree id next state
  where
    next :: State -> Run eff State
    next st = Run
      { putMsg: \msg -> pure $ over State (_ { msg = (Just msg) }) st
      , reset: pure $ over State (_ { msg = Nothing } ) st
      }

pair :: forall eff x y. Command (x -> y) -> Run eff x -> Aff eff y
pair (PutMsg msg next) (Run i) = next <$> (i.putMsg msg)
pair (Reset next) (Run i) = next <$> i.reset

runInterp :: forall eff. Store State -> Free Command (State -> State) -> State -> Aff eff State
runInterp store cmds state = exploreM pair cmds (mkInterp state)

testSuite :: forall e. TestSuite (redox :: RedoxStore (create :: CreateRedox) | e)
testSuite =
  suite "server side rendering"
    let
      disp
        :: forall e1
         . Store State
        -> Free Command (State -> State)
        -> Eff
            ( redox :: RedoxStore ReadWriteRedox | e1)
            (Canceler ( redox :: RedoxStore ReadWriteRedox | e1))
      disp store = Redox.dispatch (const $ pure unit) (runInterp store) store

      cls :: ReactClass { msg :: Maybe String }
      cls = createClass (spec unit renderCls)
      renderCls this = do
        { msg } <- getProps this
        let msg_ = fromMaybe "" msg
        pure (div' [ text msg_ ])

      connCls :: ReactClass Unit
      connCls = connect
        (Proxy :: Proxy State)
        (to (un State))
        (\_ { msg } _ -> { msg })
        cls
    in do
      test "connect"
        do
          str <- liftEff do
            store <- mkStore (State { msg: Just "hello" })
            top <- withStore store disp (createClassStateless \_ -> createElement connCls unit [])
            pure $ renderToString (createElement top unit [])
          equal str """
hello
"""

      test "componentWillMount" do
        str <- liftEff do
          store <- mkStore (State { msg: Nothing })
          let

            topSpec = (spec unit renderTop)
              { componentWillMount = componentWillMount
              , componentDidMount = componentDidMount
              }

            renderTop _ = pure $ createElement connCls unit []

            componentWillMount _ = do
              -- is called
              void $ disp store (putMsg "hello")

            componentDidMount _ = do
              -- is not called
              void $ disp store reset

          top <- withStore store disp (createClass topSpec)
          pure $ renderToString (createElement top unit [])
        equal str """
hello
"""

module Test.ServerSideRendering where

import Control.Comonad.Cofree (Cofree, exploreM, unfoldCofree)
import Control.Monad.Aff (Aff, Canceler)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Free (Free, liftF)
import Data.Lens (to)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype, over, un)
import Prelude (class Functor, Unit, bind, const, discard, id, pure, unit, void, ($), (<$>))
import React (ReactClass, createClass, createClassStateless, createElement, getProps, spec)
import React.DOM (div', text)
import React.Redox (connect, withStore)
import ReactDOM (renderToString)
import Redox (CreateRedox, RedoxStore, Store, ReadWriteRedox, mkStore)
import Redox (dispatch) as Redox
import Test.Unit (TestSuite, suite, test)
import Test.Unit.Assert (equal)
import Type.Proxy (Proxy(..))

data Command a
  = PutMsg String a
  | Reset a

derive instance functorCommand :: Functor Command

putMsg :: forall a. String -> Free Command (a -> a)
putMsg msg = liftF (PutMsg msg id)

reset :: forall a. Free Command (a -> a)
reset = liftF (Reset id)

newtype Run eff a = Run
  { putMsg :: String -> Aff eff a
  , reset :: Aff eff a
  }

derive instance functorRun :: Functor (Run eff)

newtype State = State { msg :: Maybe String }

derive instance newtypeState :: Newtype State _

mkInterp :: forall eff. State -> Cofree (Run eff) State
mkInterp state = unfoldCofree id next state
  where
    next :: State -> Run eff State
    next st = Run
      { putMsg: \msg -> pure $ over State (_ { msg = (Just msg) }) st
      , reset: pure $ over State (_ { msg = Nothing } ) st
      }

pair :: forall eff x y. Command (x -> y) -> Run eff x -> Aff eff y
pair (PutMsg msg next) (Run i) = next <$> (i.putMsg msg)
pair (Reset next) (Run i) = next <$> i.reset

runInterp :: forall eff. Store State -> Free Command (State -> State) -> State -> Aff eff State
runInterp store cmds state = exploreM pair cmds (mkInterp state)

testSuite :: forall e. TestSuite (redox :: RedoxStore (create :: CreateRedox) | e)
testSuite =
  suite "server side rendering"
    let
      disp
        :: forall e1
         . Store State
        -> Free Command (State -> State)
        -> Eff
            ( redox :: RedoxStore ReadWriteRedox | e1)
            (Canceler ( redox :: RedoxStore ReadWriteRedox | e1))
      disp store = Redox.dispatch (const $ pure unit) (runInterp store) store

      cls :: ReactClass { msg :: Maybe String }
      cls = createClass (spec unit renderCls)
      renderCls this = do
        { msg } <- getProps this
        let msg_ = fromMaybe "" msg
        pure (div' [ text msg_ ])

      connCls :: ReactClass Unit
      connCls = connect
        (Proxy :: Proxy State)
        (to (un State))
        (\_ { msg } _ -> { msg })
        cls
    in do
      test "connect"
        do
          str <- liftEff do
            store <- mkStore (State { msg: Just "hello" })
            let
              top = withStore store disp
                $ createClassStateless \_ -> createElement connCls unit []
            pure $ renderToString (createElement top unit [])
          equal str """
hello
"""

      test "componentWillMount" do
        str <- liftEff do
          store <- mkStore (State { msg: Nothing })
          let

            topSpec = (spec unit renderTop)
              { componentWillMount = componentWillMount
              , componentDidMount = componentDidMount
              }

            renderTop _ = pure $ createElement connCls unit []

            componentWillMount _ = do
              -- is called
              void $ disp store (putMsg "hello")

            componentDidMount _ = do
              -- is not called
              void $ disp store reset

            top = withStore store disp
                $ createClass topSpec
          pure $ renderToString (createElement top unit [])
        equal str """
hello
"""