Rejig  type signatures

Rejig  type signatures

-- | This module re-exports the types for the `HTML` DSL, and values for all
-- | supported HTML elements.
module Halogen.HTML
  ( module Halogen.HTML
  , module Halogen.HTML.Core
  , module Halogen.HTML.Elements
  , module Halogen.HTML.Properties
  ) where

import Prelude (Unit, (<<<))

import Data.Functor as F
import Data.Maybe (Maybe(..))

import Halogen.Component (Component, ParentHTML, mkComponentSlot, unComponent)
import Halogen.Component.ChildPath (ChildPath, injSlot, prjQuery, injQuery)
import Halogen.HTML.Core (class IsProp, AttrName(..), ClassName(..), HTML(..), Namespace(..), PropName(..), ElemName(..), text, handler)
import Halogen.HTML.Core as Core
import Halogen.HTML.Elements (Leaf, Node, withKeys, withKeys_, a, a_, abbr, abbr_, address, address_, area, article, article_, aside, aside_, audio, audio_, b, b_, base, bdi, bdi_, bdo, bdo_, blockquote, blockquote_, body, body_, br, br_, button, button_, canvas, caption, caption_, cite, cite_, code, code_, col, colgroup, colgroup_, command, datalist, datalist_, dd, dd_, del, del_, details, details_, dfn, dfn_, dialog, dialog_, div, div_, dl, dl_, dt, dt_, element, em, em_, embed, embed_, fieldset, fieldset_, figcaption, figcaption_, figure, figure_, footer, footer_, form, form_, h1, h1_, h2, h2_, h3, h3_, h4, h4_, h5, h5_, h6, h6_, head, head_, header, header_, hr, hr_, html, html_, i, i_, iframe, img, input, ins, ins_, kbd, kbd_, label, label_, legend, legend_, li, li_, link, main, main_, map, map_, mark, mark_, menu, menu_, menuitem, menuitem_, meta, meter, meter_, nav, nav_, noscript, noscript_, object, object_, ol, ol_, optgroup, optgroup_, option, option_, output, output_, p, p_, param, pre, pre_, progress, progress_, q, q_, rp, rp_, rt, rt_, ruby, ruby_, samp, samp_, script, script_, section, section_, select, select_, small, small_, source, span, span_, strong, strong_, style, style_, sub, sub_, summary, summary_, sup, sup_, table, table_, tbody, tbody_, td, td_, textarea, tfoot, tfoot_, th, th_, thead, thead_, time, time_, title, title_, tr, tr_, track, u, u_, ul, ul_, var, var_, video, video_, wbr)
import Halogen.HTML.Properties (IProp, attr, prop)

-- | Defines a slot for a child component. Takes:
-- | - the slot "address" value
-- | - the component for the slot
-- | - the input value to pass to the component
-- | - a function mapping outputs from the component to a query in the parent
slot
  :: forall f m p i o g
   . p
  -> Component HTML g i o m
  -> i
  -> (o -> Maybe (f Unit))
  -> ParentHTML f g p m
slot p component input outputQuery =
  let f = unComponent _.receiver component
  in Core.slot (mkComponentSlot p component input f outputQuery Just)

-- | Defines a slot for a child component when a parent has multiple types of
-- | child component. Takes:
-- | - the `ChildPath` for this particular child component type
-- | - the slot "address" value
-- | - the component for the slot
-- | - the input value to pass to the component
-- | - a function mapping outputs from the component to a query in the parent
slot'
  :: forall f g g' p p' i o m
   . ChildPath g g' p p'
  -> p
  -> Component HTML g i o m
  -> i
  -> (o -> Maybe (f Unit))
  -> ParentHTML f g' p' m
slot' i p component input outputQuery =
  let
    pq = prjQuery i
    f = F.map (injQuery i) <<< unComponent _.receiver component
  in
    Core.slot (mkComponentSlot (injSlot i p) component input f outputQuery pq)

-- | This module re-exports the types for the `HTML` DSL, and values for all
-- | supported HTML elements.
module Halogen.HTML
  ( module Halogen.HTML
  , module Halogen.HTML.Core
  , module Halogen.HTML.Elements
  , module Halogen.HTML.Properties
  ) where

import Prelude (Unit, class Functor, (<<<))

import Data.Functor as F
import Data.Maybe (Maybe(..))

import Halogen.Component (Component, ComponentSlot, mkComponentSlot, unComponent)
import Halogen.Component.ChildPath (ChildPath, injSlot, prjQuery, injQuery)
import Halogen.HTML.Core (class IsProp, AttrName(..), ClassName(..), HTML(..), Namespace(..), PropName(..), ElemName(..), text, handler)
import Halogen.HTML.Core as Core
import Halogen.HTML.Elements (Leaf, Node, withKeys, withKeys_, a, a_, abbr, abbr_, address, address_, area, article, article_, aside, aside_, audio, audio_, b, b_, base, bdi, bdi_, bdo, bdo_, blockquote, blockquote_, body, body_, br, br_, button, button_, canvas, caption, caption_, cite, cite_, code, code_, col, colgroup, colgroup_, command, datalist, datalist_, dd, dd_, del, del_, details, details_, dfn, dfn_, dialog, dialog_, div, div_, dl, dl_, dt, dt_, element, em, em_, embed, embed_, fieldset, fieldset_, figcaption, figcaption_, figure, figure_, footer, footer_, form, form_, h1, h1_, h2, h2_, h3, h3_, h4, h4_, h5, h5_, h6, h6_, head, head_, header, header_, hr, hr_, html, html_, i, i_, iframe, img, input, ins, ins_, kbd, kbd_, label, label_, legend, legend_, li, li_, link, main, main_, map, map_, mark, mark_, menu, menu_, menuitem, menuitem_, meta, meter, meter_, nav, nav_, noscript, noscript_, object, object_, ol, ol_, optgroup, optgroup_, option, option_, output, output_, p, p_, param, pre, pre_, progress, progress_, q, q_, rp, rp_, rt, rt_, ruby, ruby_, samp, samp_, script, script_, section, section_, select, select_, small, small_, source, span, span_, strong, strong_, style, style_, sub, sub_, summary, summary_, sup, sup_, table, table_, tbody, tbody_, td, td_, textarea, tfoot, tfoot_, th, th_, thead, thead_, time, time_, title, title_, tr, tr_, track, u, u_, ul, ul_, var, var_, video, video_, wbr)
import Halogen.HTML.Properties (IProp, attr, prop)

-- | Defines a slot for a child component. Takes:
-- | - the slot "address" value
-- | - the component for the slot
-- | - the input value to pass to the component
-- | - a function mapping outputs from the component to a query in the parent
slot
  :: forall f m p i o q
   . p
  -> Component HTML f i o m
  -> i
  -> (o -> Maybe (q Unit))
  -> HTML (ComponentSlot HTML f m p (q Unit)) (q Unit)
slot p component input outputQuery =
  let f = unComponent _.receiver component
  in Core.slot (mkComponentSlot p component input f outputQuery Just)

-- | Defines a slot for a child component when a parent has multiple types of
-- | child component. Takes:
-- | - the `ChildPath` for this particular child component type
-- | - the slot "address" value
-- | - the component for the slot
-- | - the input value to pass to the component
-- | - a function mapping outputs from the component to a query in the parent
slot'
  :: forall f f' m p p' i o q
   . Functor m
  => ChildPath f f' p p'
  -> p
  -> Component HTML f i o m
  -> i
  -> (o -> Maybe (q Unit))
  -> HTML (ComponentSlot HTML f' m p' (q Unit)) (q Unit)
slot' i p component input outputQuery =
  let
    pq = prjQuery i
    f = F.map (injQuery i) <<< unComponent _.receiver component
  in
    Core.slot (mkComponentSlot (injSlot i p) component input f outputQuery pq)


Remove note about specific effect type (#24)

-- | 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

-- | 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.
-- |
-- | The `LOCALE` effect is present here as 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


small code cleanup

small code cleanup

module Transformer where

import Types
import Data.Array
import Data.Maybe
import Data.Traversable
import Data.Foldable

type Transformer = Wall -> Wall

-- | Map a function over the two dimensional array
map2d :: (Cube -> Cube) -> Wall -> Wall
map2d = map <<< map

-- | Opposite of filter
reject :: forall a. (a -> Boolean) -> [a] -> [a]
reject f = filter (f >>> not)

-- | Successively apply all transformers to the initial wall and return
-- | all (intermediate) transformation steps
allSteps :: [Transformer] -> Wall -> [Wall]
allSteps ts wi = wi : scanl (flip ($)) wi ts

-- | Return the final step of the transformation chain
transformed :: [Transformer] -> Wall -> Wall
transformed ts wi = foldl (flip ($)) wi ts

-- | Remove emtpy stacks
tClearEmpty :: Transformer
tClearEmpty = reject null

-- | Drop lowest cube
tTail :: Transformer
tTail =  map (tail >>> fromMaybe []) >>> tClearEmpty

-- | Replace all occurences of a by b
tReplace :: Cube -> Cube -> Transformer
tReplace a b = map2d replace
    where replace x = if x == a then b else x

-- | Replace all occurences of a by bs and flattens
tReplaceMultiple :: Cube -> [Cube] -> Transformer
tReplaceMultiple a bs = map (concatMap replace)
   where replace x = if x == a then bs else [x]

-- | concat adjacent lists if they are equal
tStackEqual :: Transformer
tStackEqual [] = []
tStackEqual (s:ss) = concat (s:split.init) : tStackEqual split.rest
    where split = span (== s) ss

tFlatten :: Transformer
tFlatten = concat >>> map singleton

type TransformerRecord = {
    id :: String,
    name :: String,
    function :: Transformer
}

{--
transformers :: [TransformerRecord]
transformers = [
    {
        id: "stackEqual",
        name: "stackEqual",
        function: tStackEqual
    }, {
        id: "mapClone",
        name: "map({X} ↦ {X}{X})",
        function: map $ concatMap (\x -> [x, x])
    }, {
        id: "flatten",
        name: "flatten",
        function: tFlatten
    }, {
        id: "replaceYbyB",
        name: "map({Yellow} ↦ {Brown})",
        function: tReplace Yellow Brown
    }, {
        id: "replaceYbyBY",
        name: "map({Yellow} ↦ {Brown}{Yellow})",
        function: tReplaceMultiple Yellow [Brown, Yellow]
    }, {
        id: "replaceBbyBBB",
        name: "map({Brown} ↦ {Brown}{Brown}{Brown})",
        function: tReplaceMultiple Brown [Brown, Brown, Brown]
    }, {
        id: "replaceBbyOO",
        name: "map({Brown} ↦ {Orange}{Orange})",
        function: tReplaceMultiple Brown [Orange, Orange]
    }, {
        id: "rejectO",
        name: "reject({Orange})",
        function: map (reject (== Orange)) >>> tClearEmpty
    }, {
        id: "pushY",
        name: "map(push({Yellow}))",
        function: map (`snoc` Yellow)
    }, {
        id: "tail",
        name: "map(tail)",
        function: tTail
    }
]
--}

transformers :: [TransformerRecord]
transformers = [
    {
        id: "rejectSizeGE2",
        name: "reject(size > 2)",
        function: reject (\x -> length x > 2)
    }, {
        id: "mapYtoYR",
        name: "map({Yellow} ↦ {Yellow}{Red})",
        function: tReplaceMultiple Yellow [Yellow, Red]
    }, {
        id: "mapBtoRB",
        name: "map({Blue} ↦ {Red}{Blue})",
        function: tReplaceMultiple Blue [Red, Blue]
    }, {
        id: "rejectY",
        name: "reject({Yellow})",
        function: map (reject (== Yellow)) >>> tClearEmpty
    }, {
        id: "rejectB",
        name: "reject({Blue})",
        function: map (reject (== Blue)) >>> tClearEmpty
    }, {
        id: "filterContainsR",
        name: "filter(contains({Red}))",
        function: filter (\stack -> Red `elemIndex` stack /= -1) >>> tClearEmpty
    }, {
        id: "mapPushR",
        name: "map(push({Red}))",
        function: map (`snoc` Red)
    }, {
        id: "pushB",
        name: "push({Blue})",
        function: flip snoc [Blue]
    }, {
        id: "mapReverse",
        name: "map(reverse)",
        function: map reverse
    }
]
getTransformerById :: String -> Maybe Transformer
getTransformerById id = _.function <$> (head $ filter (\t -> t.id == id) transformers)

module Transformer where

import Types
import Data.Array
import Data.Maybe
import Data.Traversable
import Data.Foldable

type Transformer = Wall -> Wall

-- | Map a function over the two dimensional array
map2d :: (Cube -> Cube) -> Wall -> Wall
map2d = map <<< map

-- | Opposite of filter
reject :: forall a. (a -> Boolean) -> [a] -> [a]
reject f = filter (f >>> not)

-- | Successively apply all transformers to the initial wall and return
-- | all (intermediate) transformation steps
allSteps :: [Transformer] -> Wall -> [Wall]
allSteps ts wi = wi : scanl (flip ($)) wi ts

-- | Return the final step of the transformation chain
transformed :: [Transformer] -> Wall -> Wall
transformed ts wi = foldl (flip ($)) wi ts

-- | Remove emtpy stacks
tClearEmpty :: Transformer
tClearEmpty = reject null

-- | Drop lowest cube
tTail :: Transformer
tTail =  map (tail >>> fromMaybe []) >>> tClearEmpty

-- | Replace all occurences of a by b
tReplace :: Cube -> Cube -> Transformer
tReplace a b = map2d replace
    where replace x = if x == a then b else x

-- | Replace all occurences of a by bs and flattens
tReplaceMultiple :: Cube -> [Cube] -> Transformer
tReplaceMultiple a bs = map (concatMap replace)
   where replace x = if x == a then bs else [x]

-- | concat adjacent lists if they are equal
tStackEqual :: Transformer
tStackEqual [] = []
tStackEqual (s:ss) = concat (s:split.init) : tStackEqual split.rest
    where split = span (== s) ss

tFlatten :: Transformer
tFlatten = concat >>> map singleton

type TransformerRecord = {
    id :: String,
    name :: String,
    function :: Transformer
}

{--
transformers :: [TransformerRecord]
transformers = [
    {
        id: "stackEqual",
        name: "stackEqual",
        function: tStackEqual
    }, {
        id: "mapClone",
        name: "map({X} ↦ {X}{X})",
        function: map $ concatMap (\x -> [x, x])
    }, {
        id: "flatten",
        name: "flatten",
        function: tFlatten
    }, {
        id: "replaceYbyB",
        name: "map({Yellow} ↦ {Brown})",
        function: tReplace Yellow Brown
    }, {
        id: "replaceYbyBY",
        name: "map({Yellow} ↦ {Brown}{Yellow})",
        function: tReplaceMultiple Yellow [Brown, Yellow]
    }, {
        id: "replaceBbyBBB",
        name: "map({Brown} ↦ {Brown}{Brown}{Brown})",
        function: tReplaceMultiple Brown [Brown, Brown, Brown]
    }, {
        id: "replaceBbyOO",
        name: "map({Brown} ↦ {Orange}{Orange})",
        function: tReplaceMultiple Brown [Orange, Orange]
    }, {
        id: "rejectO",
        name: "reject({Orange})",
        function: map (reject (== Orange)) >>> tClearEmpty
    }, {
        id: "pushY",
        name: "map(push({Yellow}))",
        function: map (flip snoc Yellow)
    }, {
        id: "tail",
        name: "map(tail)",
        function: tTail
    }
]
--}

transformers :: [TransformerRecord]
transformers = [
    {
        id: "rejectSizeGE2",
        name: "reject(size > 2)",
        function: reject (\x -> length x > 2)
    }, {
        id: "mapYtoYR",
        name: "map({Yellow} ↦ {Yellow}{Red})",
        function: tReplaceMultiple Yellow [Yellow, Red]
    }, {
        id: "mapBtoRB",
        name: "map({Blue} ↦ {Red}{Blue})",
        function: tReplaceMultiple Blue [Red, Blue]
    }, {
        id: "rejectY",
        name: "reject({Yellow})",
        function: map (reject (== Yellow)) >>> tClearEmpty
    }, {
        id: "rejectB",
        name: "reject({Blue})",
        function: map (reject (== Blue)) >>> tClearEmpty
    }, {
        id: "filterContainsR",
        name: "filter(contains({Red}))",
        function: filter (\stack -> Red `elemIndex` stack /= -1) >>> tClearEmpty
    }, {
        id: "mapPushR",
        name: "map(push({Red}))",
        function: map (flip snoc Red)
    }, {
        id: "pushB",
        name: "push({Blue})",
        function: flip snoc [Blue]
    }, {
        id: "mapReverse",
        name: "map(reverse)",
        function: map reverse
    }
]
getTransformerById :: String -> Maybe Transformer
getTransformerById id = (\x -> x.function) <$> (head $ filter (\t -> t.id == id) transformers)