fix type of dispatch

fix type of dispatch

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

import Prelude
import React as R
import Redox as Redox
import Control.Monad.Free (Free)
import Control.Monad.Aff (Canceler)
import Control.Monad.Eff (Eff, kind Effect)
import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
import Data.Lens (Lens', view)
import Data.Maybe (Maybe(..))
import React (ReactClass, ReactSpec, ReactThis)
import ReactHocs (CONTEXT, withContext, accessContext, readContext, getDisplayName)
import Redox (ReadRedox, SubscribeRedox, ReadWriteSubscribeRedox, Store, SubscriptionId)
import Type.Proxy (Proxy(..))

type DispatchFn state dsl eff = Free dsl (state -> state) -> Eff (ReadWriteSubscribeRedox eff) (Canceler (ReadWriteSubscribeRedox eff))

-- | 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 eff
  -- redox store
   . Store state
  -- bound redox dispatch function
  -> (Store state -> DispatchFn state dsl eff)
  -> ReactClass props
  -> ReactClass props
withStore store dispatch_ cls =
  withContext cls { redox: { store, dispatch: dispatch_ store } }

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

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

_connect
  :: forall state state' dsl props props' eff
   . (ReactThis props' (ConnectState state')
      -> Eff (context :: CONTEXT, readRedox :: ReadRedox, subscribeRedox :: SubscribeRedox | eff) (RedoxContext state dsl eff))
  -> Lens' state state'
  -> ((DispatchFn state dsl eff) -> state' -> props' -> props)
  -> ReactClass props
  -> ReactSpec props' (ConnectState state') ( context :: CONTEXT, readRedox :: ReadRedox, subscribeRedox :: SubscribeRedox | eff )
_connect ctxEff _lns _iso cls = (R.spec' getInitialState renderFn)
    { displayName = getDisplayName cls <> "Connect"
    , componentWillMount = componentWillMount
    , componentWillUnmount = componentWillUnmount
    }
  where

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

    update this state = R.transformState this (_ { state = view _lns state })

    getInitialState this = do
      ctx <- addReactDisallowedEff $ ctxEff this
      state <- Redox.getState ctx.store
      pure { state: view _lns state, sid: Nothing }

    componentWillMount this = do
      ctx <- addReactEff $ ctxEff this
      sid <- Redox.subscribe ctx.store $ update this
      R.transformState this (_ { sid = Just sid })

    componentWillUnmount this = do
      ctx <- addReactReadOnlyEff $ ctxEff this
      msid <- (R.readState this) >>= pure <<< _.sid
      case msid of
        Nothing -> pure unit
        Just sid -> Redox.unsubscribe ctx.store sid

    renderFn this = do
      props' <- R.getProps this
      ctx <- unsafeCoerceEff $ ctxEff this
      state <- unsafeCoerceEff $ R.readState this >>= pure <<< _.state
      pure $ R.createElement cls_ (_iso ctx.dispatch state props') []

    addReactEff :: forall a e. Eff e a -> Eff ( props :: R.ReactProps, state :: R.ReactState R.ReadWrite, refs :: R.ReactRefs (() :: # Effect) | e ) a
    addReactEff = unsafeCoerceEff

    addReactDisallowedEff :: forall a e. Eff e a -> Eff ( props :: R.ReactProps, state :: R.ReactState R.Disallowed, refs :: R.ReactRefs R.Disallowed | e ) a
    addReactDisallowedEff = unsafeCoerceEff

    addReactReadOnlyEff :: forall a e. Eff e a -> Eff ( props :: R.ReactProps, state :: R.ReactState R.ReadOnly, refs :: R.ReactRefs R.ReadOnly | e) a
    addReactReadOnlyEff = unsafeCoerceEff

-- | 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' eff
   . Lens' state state'
  -> (DispatchFn state dsl eff -> state' -> props' -> props)
  -> ReactClass props
  -> ReactSpec props' (ConnectState state') ( context :: CONTEXT, readRedox :: ReadRedox, subscribeRedox :: SubscribeRedox | eff )
connect' _lns _iso cls = _connect ctxEff _lns _iso cls
  where
    ctxEff this = readContext (Proxy :: Proxy (RedoxContext state dsl eff)) this

connect
  :: forall state state' dsl props props' eff'
   . Lens' state state'
  -> (DispatchFn state dsl eff' -> state' -> props' -> props)
  -> ReactClass props
  -> ReactClass props'
connect _lns _iso cls = accessContext $ R.createClass $ connect' _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' eff
   . Store state
  -> DispatchFn state dsl eff
  -> Lens' state state'
  -> (DispatchFn state dsl eff -> state' -> props' -> props)
  -> ReactClass props
  -> ReactSpec props' (ConnectState state') ( context :: CONTEXT, readRedox :: ReadRedox, subscribeRedox :: SubscribeRedox | eff )
connectStore store dispatch_ _lns _iso cls = _connect (const $ pure {store, dispatch: dispatch_}) _lns _iso cls

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

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

import Prelude
import React as R
import Redox as Redox
import Control.Monad.Free (Free)
import Control.Monad.Aff (Canceler)
import Control.Monad.Eff (Eff, kind Effect)
import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
import Data.Lens (Lens', view)
import Data.Maybe (Maybe(..))
import React (ReactClass, ReactSpec, ReactThis)
import ReactHocs (CONTEXT, withContext, accessContext, readContext, getDisplayName)
import Redox (ReadRedox, SubscribeRedox, ReadWriteSubscribeRedox, Store, SubscriptionId)
import Type.Proxy (Proxy(..))

type DispatchFn state dsl eff = Free dsl (state -> state) -> Eff (ReadWriteSubscribeRedox eff) (Canceler (ReadWriteSubscribeRedox eff))

-- | 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 eff
  -- redox store
   . Store state
  -- bound redox dispatch function
  -> (Store state -> DispatchFn state dsl eff)
  -> ReactClass props
  -> ReactClass props
withStore store dispatch_ cls =
  withContext cls { redox: { store, dispatch: dispatch_ store } }

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

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

_connect
  :: forall state state' dsl props props' eff
   . (ReactThis props' (ConnectState state')
      -> Eff (context :: CONTEXT, readRedox :: ReadRedox, subscribeRedox :: SubscribeRedox | eff) (RedoxContext state dsl eff))
  -> Lens' state state'
  -> ((DispatchFn state dsl eff) -> state' -> props' -> props)
  -> ReactClass props
  -> ReactSpec props' (ConnectState state') ( context :: CONTEXT, readRedox :: ReadRedox, subscribeRedox :: SubscribeRedox | eff )
_connect ctxEff _lns _iso cls = (R.spec' getInitialState renderFn)
    { displayName = getDisplayName cls <> "Connect"
    , componentWillMount = componentWillMount
    , componentWillUnmount = componentWillUnmount
    }
  where

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

    update this state = R.transformState this (_ { state = view _lns state })

    getInitialState this = do
      ctx <- addReactDisallowedEff $ ctxEff this
      state <- Redox.getState ctx.store
      pure { state: view _lns state, sid: Nothing }

    componentWillMount this = do
      ctx <- addReactEff $ ctxEff this
      sid <- Redox.subscribe ctx.store $ update this
      R.transformState this (_ { sid = Just sid })

    componentWillUnmount this = do
      ctx <- addReactReadOnlyEff $ ctxEff this
      msid <- (R.readState this) >>= pure <<< _.sid
      case msid of
        Nothing -> pure unit
        Just sid -> Redox.unsubscribe ctx.store sid

    renderFn this = do
      props' <- R.getProps this
      ctx <- unsafeCoerceEff $ ctxEff this
      state <- unsafeCoerceEff $ R.readState this >>= pure <<< _.state
      pure $ R.createElement cls_ (_iso ctx.dispatch state props') []

    addReactEff :: forall a e. Eff e a -> Eff ( props :: R.ReactProps, state :: R.ReactState R.ReadWrite, refs :: R.ReactRefs (() :: # Effect) | e ) a
    addReactEff = unsafeCoerceEff

    addReactDisallowedEff :: forall a e. Eff e a -> Eff ( props :: R.ReactProps, state :: R.ReactState R.Disallowed, refs :: R.ReactRefs R.Disallowed | e ) a
    addReactDisallowedEff = unsafeCoerceEff

    addReactReadOnlyEff :: forall a e. Eff e a -> Eff ( props :: R.ReactProps, state :: R.ReactState R.ReadOnly, refs :: R.ReactRefs R.ReadOnly | e) a
    addReactReadOnlyEff = unsafeCoerceEff

-- | 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' eff
   . Lens' state state'
  -> (DispatchFn state dsl eff -> state' -> props' -> props)
  -> ReactClass props
  -> ReactSpec props' (ConnectState state') ( context :: CONTEXT, readRedox :: ReadRedox, subscribeRedox :: SubscribeRedox | eff )
connect' _lns _iso cls = _connect ctxEff _lns _iso cls
  where
    ctxEff this = readContext (Proxy :: Proxy (RedoxContext state dsl eff)) this

connect
  :: forall state state' dsl props props' eff'
   . Lens' state state'
  -> (DispatchFn state dsl eff' -> state' -> props' -> props)
  -> ReactClass props
  -> ReactClass props'
connect _lns _iso cls = accessContext $ R.createClass $ connect' _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' eff
   . Store state
  -> DispatchFn state dsl eff
  -> Lens' state state'
  -> (DispatchFn state dsl eff -> state' -> props' -> props)
  -> ReactClass props
  -> ReactSpec props' (ConnectState state') ( context :: CONTEXT, readRedox :: ReadRedox, subscribeRedox :: SubscribeRedox | eff )
connectStore store dispatch_ _lns _iso cls = _connect (const $ pure {store, dispatch: dispatch_}) _lns _iso cls

dispatch
  :: forall dsl props state eff
   . ReactThis props state
  -> Free dsl (state -> state)
  -> Eff (ReadWriteSubscribeRedox (context :: CONTEXT | eff)) (Canceler (ReadWriteSubscribeRedox (context :: CONTEXT | eff)))
dispatch this dsl = do
  _dispatch <- _.redox.dispatch <$> readContext (Proxy :: Proxy ({ redox :: RedoxContext state dsl (context :: CONTEXT | eff) }) ) this
  _dispatch dsl


Fixed h functions

Fixed h functions

module Halogen.HTML.Elements
  ( Node
  , Leaf
  , element
  , keyed
  , 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_
  , 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
  ) where

import Prelude (Unit)
import Data.Tuple (Tuple)

import DOM.HTML.Indexed as I

import Halogen.HTML.Core (HTML(..), Prop, ElemName(..))
import Halogen.HTML.Core as Core
import Halogen.HTML.Properties (IProp)
import Halogen.Query.InputF (InputF)
import Halogen.VDom as VDom

import Unsafe.Coerce (unsafeCoerce)

-- | An HTML element that admits children.
type Node r p i
   = Array (IProp r i)
  -> Array (HTML p i)
  -> HTML p i

-- | An HTML element that does not admit children.
type Leaf r p i
   = Array (IProp r i)
  -> HTML p i

-- | Creates an HTML element that expects indexed properties.
element :: forall r p i. ElemName -> Array (IProp r i) -> Array (HTML p i) -> HTML p i
element = (unsafeCoerce :: (ElemName -> Array (Prop i) -> Array (HTML p i) -> HTML p i) -> ElemName -> Array (IProp r i) -> Array (HTML p i) -> HTML p i) Core.element

-- | Creates an HTML element that expects indexed properties, with keyed
-- | children.
keyed :: forall r p i. ElemName -> Array (IProp r i) -> Array (Tuple String (HTML p i)) -> HTML p i
keyed = (unsafeCoerce :: (ElemName -> Array (Prop i) -> Array (Tuple String (HTML p i)) -> HTML p i) -> ElemName -> Array (IProp r i) -> Array (Tuple String (HTML p i)) -> HTML p i) Core.keyed

withKeys :: forall r p i. (Array (IProp r i) -> Array (HTML p i) -> HTML p i) -> Array (IProp r i) -> Array (Tuple String (HTML p i)) -> HTML p i
withKeys ctor props children =
  case ctor props [] of
    HTML (VDom.Elem spec _) -> HTML (VDom.Keyed spec (coe children))
    h -> h
  where
  coe :: Array (Tuple String (HTML p i)) -> Array (Tuple String (VDom.VDom (Array (Prop (InputF Unit i))) p))
  coe = unsafeCoerce

withKeys_ :: forall p i. (Array (HTML p i) -> HTML p i) -> Array (Tuple String (HTML p i)) -> HTML p i
withKeys_ ctor children =
  case ctor [] of
    HTML (VDom.Elem spec _) -> HTML (VDom.Keyed spec (coe children))
    h -> h
  where
  coe :: Array (Tuple String (HTML p i)) -> Array (Tuple String (VDom.VDom (Array (Prop (InputF Unit i))) p))
  coe = unsafeCoerce

a :: forall p i. Node I.HTMLa p i
a = element (ElemName "a")

a_ :: forall p i. Array (HTML p i) -> HTML p i
a_ = a []

abbr :: forall p i. Node I.HTMLabbr p i
abbr = element (ElemName "abbr")

abbr_ :: forall p i. Array (HTML p i) -> HTML p i
abbr_ = abbr []

address :: forall p i. Node I.HTMLaddress p i
address = element (ElemName "address")

address_ :: forall p i. Array (HTML p i) -> HTML p i
address_ = address []

area :: forall p i. Leaf I.HTMLarea p i
area props = element (ElemName "area") props []

article :: forall p i. Node I.HTMLarticle p i
article = element (ElemName "article")

article_ :: forall p i. Array (HTML p i) -> HTML p i
article_ = article []

aside :: forall p i. Node I.HTMLaside p i
aside = element (ElemName "aside")

aside_ :: forall p i. Array (HTML p i) -> HTML p i
aside_ = aside []

audio :: forall p i. Node I.HTMLaudio p i
audio = element (ElemName "audio")

audio_ :: forall p i. Array (HTML p i) -> HTML p i
audio_ = audio []

b :: forall p i. Node I.HTMLb p i
b = element (ElemName "b")

b_ :: forall p i. Array (HTML p i) -> HTML p i
b_ = b []

base :: forall p i. Leaf I.HTMLbase p i
base props = element (ElemName "base") props []

bdi :: forall p i. Node I.HTMLbdi p i
bdi = element (ElemName "bdi")

bdi_ :: forall p i. Array (HTML p i) -> HTML p i
bdi_ = bdi []

bdo :: forall p i. Node I.HTMLbdo p i
bdo = element (ElemName "bdo")

bdo_ :: forall p i. Array (HTML p i) -> HTML p i
bdo_ = bdo []

blockquote :: forall p i. Node I.HTMLblockquote p i
blockquote = element (ElemName "blockquote")

blockquote_ :: forall p i. Array (HTML p i) -> HTML p i
blockquote_ = blockquote []

body :: forall p i. Node I.HTMLbody p i
body = element (ElemName "body")

body_ :: forall p i. Array (HTML p i) -> HTML p i
body_ = body []

br :: forall p i. Leaf I.HTMLbr p i
br props = element (ElemName "br") props []

br_ :: forall p i. HTML p i
br_ = br []

button :: forall p i. Node I.HTMLbutton p i
button = element (ElemName "button")

button_ :: forall p i. Array (HTML p i) -> HTML p i
button_ = button []

canvas :: forall p i. Leaf I.HTMLcanvas p i
canvas props = element (ElemName "canvas") props []

caption :: forall p i. Node I.HTMLcaption p i
caption = element (ElemName "caption")

caption_ :: forall p i. Array (HTML p i) -> HTML p i
caption_ = caption []

cite :: forall p i. Node I.HTMLcite p i
cite = element (ElemName "cite")

cite_ :: forall p i. Array (HTML p i) -> HTML p i
cite_ = cite []

code :: forall p i. Node I.HTMLcode p i
code = element (ElemName "code")

code_ :: forall p i. Array (HTML p i) -> HTML p i
code_ = code []

col :: forall p i. Leaf I.HTMLcol p i
col props = element (ElemName "col") props []

colgroup :: forall p i. Node I.HTMLcolgroup p i
colgroup = element (ElemName "colgroup")

colgroup_ :: forall p i. Array (HTML p i) -> HTML p i
colgroup_ = colgroup []

command :: forall p i. Leaf I.HTMLcommand p i
command props = element (ElemName "command") props []

datalist :: forall p i. Node I.HTMLdatalist p i
datalist = element (ElemName "datalist")

datalist_ :: forall p i. Array (HTML p i) -> HTML p i
datalist_ = datalist []

dd :: forall p i. Node I.HTMLdd p i
dd = element (ElemName "dd")

dd_ :: forall p i. Array (HTML p i) -> HTML p i
dd_ = dd []

del :: forall p i. Node I.HTMLdel p i
del = element (ElemName "del")

del_ :: forall p i. Array (HTML p i) -> HTML p i
del_ = del []

details :: forall p i. Node I.HTMLdetails p i
details = element (ElemName "details")

details_ :: forall p i. Array (HTML p i) -> HTML p i
details_ = details []

dfn :: forall p i. Node I.HTMLdfn p i
dfn = element (ElemName "dfn")

dfn_ :: forall p i. Array (HTML p i) -> HTML p i
dfn_ = dfn []

dialog :: forall p i. Node I.HTMLdialog p i
dialog = element (ElemName "dialog")

dialog_ :: forall p i. Array (HTML p i) -> HTML p i
dialog_ = dialog []

div :: forall p i. Node I.HTMLdiv p i
div = element (ElemName "div")

div_ :: forall p i. Array (HTML p i) -> HTML p i
div_ = div []

dl :: forall p i. Node I.HTMLdl p i
dl = element (ElemName "dl")

dl_ :: forall p i. Array (HTML p i) -> HTML p i
dl_ = dl []

dt :: forall p i. Node (I.HTMLdt) p i
dt = element (ElemName "dt")

dt_ :: forall p i. Array (HTML p i) -> HTML p i
dt_ = dt []

em :: forall p i. Node I.HTMLem p i
em = element (ElemName "em")

em_ :: forall p i. Array (HTML p i) -> HTML p i
em_ = em []

embed :: forall p i. Node I.HTMLembed p i
embed = element (ElemName "embed")

embed_ :: forall p i. Array (HTML p i) -> HTML p i
embed_ = embed []

fieldset :: forall p i. Node I.HTMLfieldset p i
fieldset = element (ElemName "fieldset")

fieldset_ :: forall p i. Array (HTML p i) -> HTML p i
fieldset_ = fieldset []

figcaption :: forall p i. Node I.HTMLfigcaption p i
figcaption = element (ElemName "figcaption")

figcaption_ :: forall p i. Array (HTML p i) -> HTML p i
figcaption_ = figcaption []

figure :: forall p i. Node I.HTMLfigure p i
figure = element (ElemName "figure")

figure_ :: forall p i. Array (HTML p i) -> HTML p i
figure_ = figure []

footer :: forall p i. Node I.HTMLfooter p i
footer = element (ElemName "footer")

footer_ :: forall p i. Array (HTML p i) -> HTML p i
footer_ = footer []

form :: forall p i. Node I.HTMLform p i
form = element (ElemName "form")

form_ :: forall p i. Array (HTML p i) -> HTML p i
form_ = form []

h1 :: forall p i. Node I.HTMLh1 p i
h1 = element (ElemName "h1")

h1_ :: forall p i. Array (HTML p i) -> HTML p i
h1_ = h1 []

h2 :: forall p i. Node I.HTMLh2 p i
h2 = element (ElemName "h2")

h2_ :: forall p i. Array (HTML p i) -> HTML p i
h2_ = h2 []

h3 :: forall p i. Node I.HTMLh3 p i
h3 = element (ElemName "h3")

h3_ :: forall p i. Array (HTML p i) -> HTML p i
h3_ = h3 []

h4 :: forall p i. Node I.HTMLh4 p i
h4 = element (ElemName "h4")

h4_ :: forall p i. Array (HTML p i) -> HTML p i
h4_ = h4 []

h5 :: forall p i. Node I.HTMLh5 p i
h5 = element (ElemName "h5")

h5_ :: forall p i. Array (HTML p i) -> HTML p i
h5_ = h5 []

h6 :: forall p i. Node I.HTMLh6 p i
h6 = element (ElemName "h6")

h6_ :: forall p i. Array (HTML p i) -> HTML p i
h6_ = h6 []

head :: forall p i. Node I.HTMLhead p i
head = element (ElemName "head")

head_ :: forall p i. Array (HTML p i) -> HTML p i
head_ = head []

header :: forall p i. Node I.HTMLheader p i
header = element (ElemName "header")

header_ :: forall p i. Array (HTML p i) -> HTML p i
header_ = header []

hr :: forall p i. Leaf I.HTMLhr p i
hr props = element (ElemName "hr") props []

hr_ :: forall p i. HTML p i
hr_ = hr []

html :: forall p i. Node I.HTMLhtml p i
html = element (ElemName "html")

html_ :: forall p i. Array (HTML p i) -> HTML p i
html_ = html []

i :: forall p i. Node I.HTMLi p i
i = element (ElemName "i")

i_ :: forall p i. Array (HTML p i) -> HTML p i
i_ = i []

iframe :: forall p i. Leaf I.HTMLiframe p i
iframe props = element (ElemName "iframe") props []

img :: forall p i. Leaf I.HTMLimg p i
img props = element (ElemName "img") props []

input :: forall p i. Leaf I.HTMLinput p i
input props = element (ElemName "input") props []

ins :: forall p i. Node I.HTMLins p i
ins = element (ElemName "ins")

ins_ :: forall p i. Array (HTML p i) -> HTML p i
ins_ = ins []

kbd :: forall p i. Node I.HTMLkbd p i
kbd = element (ElemName "kbd")

kbd_ :: forall p i. Array (HTML p i) -> HTML p i
kbd_ = kbd []

label :: forall p i. Node I.HTMLlabel p i
label = element (ElemName "label")

label_ :: forall p i. Array (HTML p i) -> HTML p i
label_ = label []

legend :: forall p i. Node I.HTMLlegend p i
legend = element (ElemName "legend")

legend_ :: forall p i. Array (HTML p i) -> HTML p i
legend_ = legend []

li :: forall p i. Node I.HTMLli p i
li = element (ElemName "li")

li_ :: forall p i. Array (HTML p i) -> HTML p i
li_ = li []

link :: forall p i. Leaf I.HTMLlink p i
link props = element (ElemName "link") props []

main :: forall p i. Node I.HTMLmain p i
main = element (ElemName "main")

main_ :: forall p i. Array (HTML p i) -> HTML p i
main_ = main []

map :: forall p i. Node I.HTMLmap p i
map = element (ElemName "map")

map_ :: forall p i. Array (HTML p i) -> HTML p i
map_ = map []

mark :: forall p i. Node I.HTMLmark p i
mark = element (ElemName "mark")

mark_ :: forall p i. Array (HTML p i) -> HTML p i
mark_ = mark []

menu :: forall p i. Node I.HTMLmenu p i
menu = element (ElemName "menu")

menu_ :: forall p i. Array (HTML p i) -> HTML p i
menu_ = menu []

menuitem :: forall p i. Node I.HTMLmenuitem p i
menuitem = element (ElemName "menuitem")

menuitem_ :: forall p i. Array (HTML p i) -> HTML p i
menuitem_ = menuitem []

meta :: forall p i. Leaf I.HTMLmeta p i
meta props = element (ElemName "meta") props []

meter :: forall p i. Node I.HTMLmeter p i
meter = element (ElemName "meter")

meter_ :: forall p i. Array (HTML p i) -> HTML p i
meter_ = meter []

nav :: forall p i. Node I.HTMLnav p i
nav = element (ElemName "nav")

nav_ :: forall p i. Array (HTML p i) -> HTML p i
nav_ = nav []

noscript :: forall p i. Node I.HTMLnoscript p i
noscript = element (ElemName "noscript")

noscript_ :: forall p i. Array (HTML p i) -> HTML p i
noscript_ = noscript []

object :: forall p i. Node I.HTMLobject p i
object = element (ElemName "object")

object_ :: forall p i. Array (HTML p i) -> HTML p i
object_ = object []

ol :: forall p i. Node I.HTMLol p i
ol = element (ElemName "ol")

ol_ :: forall p i. Array (HTML p i) -> HTML p i
ol_ = ol []

optgroup :: forall p i. Node I.HTMLoptgroup p i
optgroup = element (ElemName "optgroup")

optgroup_ :: forall p i. Array (HTML p i) -> HTML p i
optgroup_ = optgroup []

option :: forall p i. Node I.HTMLoption p i
option = element (ElemName "option")

option_ :: forall p i. Array (HTML p i) -> HTML p i
option_ = option []

output :: forall p i. Node I.HTMLoutput p i
output = element (ElemName "output")

output_ :: forall p i. Array (HTML p i) -> HTML p i
output_ = output []

p :: forall p i. Node I.HTMLp p i
p = element (ElemName "p")

p_ :: forall p i. Array (HTML p i) -> HTML p i
p_ = p []

param :: forall p i. Leaf I.HTMLparam p i
param props = element (ElemName "param") props []

pre :: forall p i. Node I.HTMLpre p i
pre = element (ElemName "pre")

pre_ :: forall p i. Array (HTML p i) -> HTML p i
pre_ = pre []

progress :: forall p i. Node I.HTMLprogress p i
progress = element (ElemName "progress")

progress_ :: forall p i. Array (HTML p i) -> HTML p i
progress_ = progress []

q :: forall p i. Node I.HTMLq p i
q = element (ElemName "q")

q_ :: forall p i. Array (HTML p i) -> HTML p i
q_ = q []

rp :: forall p i. Node I.HTMLrp p i
rp = element (ElemName "rp")

rp_ :: forall p i. Array (HTML p i) -> HTML p i
rp_ = rp []

rt :: forall p i. Node I.HTMLrt p i
rt = element (ElemName "rt")

rt_ :: forall p i. Array (HTML p i) -> HTML p i
rt_ = rt []

ruby :: forall p i. Node I.HTMLruby p i
ruby = element (ElemName "ruby")

ruby_ :: forall p i. Array (HTML p i) -> HTML p i
ruby_ = ruby []

samp :: forall p i. Node I.HTMLsamp p i
samp = element (ElemName "samp")

samp_ :: forall p i. Array (HTML p i) -> HTML p i
samp_ = samp []

script :: forall p i. Node I.HTMLscript p i
script = element (ElemName "script")

script_ :: forall p i. Array (HTML p i) -> HTML p i
script_ = script []

section :: forall p i. Node I.HTMLsection p i
section = element (ElemName "section")

section_ :: forall p i. Array (HTML p i) -> HTML p i
section_ = section []

select :: forall p i. Node I.HTMLselect p i
select = element (ElemName "select")

select_ :: forall p i. Array (HTML p i) -> HTML p i
select_ = select []

small :: forall p i. Node I.HTMLsmall p i
small = element (ElemName "small")

small_ :: forall p i. Array (HTML p i) -> HTML p i
small_ = small []

source :: forall p i. Leaf I.HTMLsource p i
source props = element (ElemName "source") props []

span :: forall p i. Node I.HTMLspan p i
span = element (ElemName "span")

span_ :: forall p i. Array (HTML p i) -> HTML p i
span_ = span []

strong :: forall p i. Node I.HTMLstrong p i
strong = element (ElemName "strong")

strong_ :: forall p i. Array (HTML p i) -> HTML p i
strong_ = strong []

style :: forall p i. Node I.HTMLstyle p i
style = element (ElemName "style")

style_ :: forall p i. Array (HTML p i) -> HTML p i
style_ = style []

sub :: forall p i. Node I.HTMLsub p i
sub = element (ElemName "sub")

sub_ :: forall p i. Array (HTML p i) -> HTML p i
sub_ = sub []

summary :: forall p i. Node I.HTMLsummary p i
summary = element (ElemName "summary")

summary_ :: forall p i. Array (HTML p i) -> HTML p i
summary_ = summary []

sup :: forall p i. Node I.HTMLsup p i
sup = element (ElemName "sup")

sup_ :: forall p i. Array (HTML p i) -> HTML p i
sup_ = sup []

table :: forall p i. Node I.HTMLtable p i
table = element (ElemName "table")

table_ :: forall p i. Array (HTML p i) -> HTML p i
table_ = table []

tbody :: forall p i. Node I.HTMLtbody p i
tbody = element (ElemName "tbody")

tbody_ :: forall p i. Array (HTML p i) -> HTML p i
tbody_ = tbody []

td :: forall p i. Node I.HTMLtd p i
td = element (ElemName "td")

td_ :: forall p i. Array (HTML p i) -> HTML p i
td_ = td []

textarea :: forall p i. Leaf I.HTMLtextarea p i
textarea es = element (ElemName "textarea") es []

tfoot :: forall p i. Node I.HTMLtfoot p i
tfoot = element (ElemName "tfoot")

tfoot_ :: forall p i. Array (HTML p i) -> HTML p i
tfoot_ = tfoot []

th :: forall p i. Node I.HTMLth p i
th = element (ElemName "th")

th_ :: forall p i. Array (HTML p i) -> HTML p i
th_ = th []

thead :: forall p i. Node I.HTMLthead p i
thead = element (ElemName "thead")

thead_ :: forall p i. Array (HTML p i) -> HTML p i
thead_ = thead []

time :: forall p i. Node I.HTMLtime p i
time = element (ElemName "time")

time_ :: forall p i. Array (HTML p i) -> HTML p i
time_ = time []

title :: forall p i. Node I.HTMLtitle p i
title = element (ElemName "title")

title_ :: forall p i. Array (HTML p i) -> HTML p i
title_ = title []

tr :: forall p i. Node I.HTMLtr p i
tr = element (ElemName "tr")

tr_ :: forall p i. Array (HTML p i) -> HTML p i
tr_ = tr []

track :: forall p i. Leaf I.HTMLtrack p i
track props = element (ElemName "track") props []

u :: forall p i. Node I.HTMLu p i
u = element (ElemName "u")

u_ :: forall p i. Array (HTML p i) -> HTML p i
u_ = u []

ul :: forall p i. Node I.HTMLul p i
ul = element (ElemName "ul")

ul_ :: forall p i. Array (HTML p i) -> HTML p i
ul_ = ul []

var :: forall p i. Node I.HTMLvar p i
var = element (ElemName "var")

var_ :: forall p i. Array (HTML p i) -> HTML p i
var_ = var []

video :: forall p i. Node I.HTMLvideo p i
video = element (ElemName "video")

video_ :: forall p i. Array (HTML p i) -> HTML p i
video_ = video []

wbr :: forall p i. Leaf I.HTMLwbr p i
wbr props = element (ElemName "wbr") props []

module Halogen.HTML.Elements
  ( Node
  , Leaf
  , element
  , keyed
  , 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_
  , 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
  ) where

import Prelude (Unit)
import Data.Tuple (Tuple)

import DOM.HTML.Indexed as I

import Halogen.HTML.Core (HTML(..), Prop, ElemName(..))
import Halogen.HTML.Core as Core
import Halogen.HTML.Properties (IProp)
import Halogen.Query.InputF (InputF)
import Halogen.VDom as VDom

import Unsafe.Coerce (unsafeCoerce)

-- | An HTML element that admits children.
type Node r p i
   = Array (IProp r i)
  -> Array (HTML p i)
  -> HTML p i

-- | An HTML element that does not admit children.
type Leaf r p i
   = Array (IProp r i)
  -> HTML p i

-- | Creates an HTML element that expects indexed properties.
element :: forall r p i. ElemName -> Array (IProp r i) -> Array (HTML p i) -> HTML p i
element = (unsafeCoerce :: (ElemName -> Array (Prop i) -> Array (HTML p i) -> HTML p i) -> ElemName -> Array (IProp r i) -> Array (HTML p i) -> HTML p i) Core.element

-- | Creates an HTML element that expects indexed properties, with keyed
-- | children.
keyed :: forall r p i. ElemName -> Array (IProp r i) -> Array (Tuple String (HTML p i)) -> HTML p i
keyed = (unsafeCoerce :: (ElemName -> Array (Prop i) -> Array (Tuple String (HTML p i)) -> HTML p i) -> ElemName -> Array (IProp r i) -> Array (Tuple String (HTML p i)) -> HTML p i) Core.keyed

withKeys :: forall r p i. (Array (IProp r i) -> Array (HTML p i) -> HTML p i) -> Array (IProp r i) -> Array (Tuple String (HTML p i)) -> HTML p i
withKeys ctor props children =
  case ctor props [] of
    HTML (VDom.Elem spec _) -> HTML (VDom.Keyed spec (coe children))
    h -> h
  where
  coe :: Array (Tuple String (HTML p i)) -> Array (Tuple String (VDom.VDom (Array (Prop (InputF Unit i))) p))
  coe = unsafeCoerce

withKeys_ :: forall p i. (Array (HTML p i) -> HTML p i) -> Array (Tuple String (HTML p i)) -> HTML p i
withKeys_ ctor children =
  case ctor [] of
    HTML (VDom.Elem spec _) -> HTML (VDom.Keyed spec (coe children))
    h -> h
  where
  coe :: Array (Tuple String (HTML p i)) -> Array (Tuple String (VDom.VDom (Array (Prop (InputF Unit i))) p))
  coe = unsafeCoerce

a :: forall p i. Node I.HTMLa p i
a = element (ElemName "a")

a_ :: forall p i. Array (HTML p i) -> HTML p i
a_ = a []

abbr :: forall p i. Node I.HTMLabbr p i
abbr = element (ElemName "abbr")

abbr_ :: forall p i. Array (HTML p i) -> HTML p i
abbr_ = abbr []

address :: forall p i. Node I.HTMLaddress p i
address = element (ElemName "address")

address_ :: forall p i. Array (HTML p i) -> HTML p i
address_ = address []

area :: forall p i. Leaf I.HTMLarea p i
area props = element (ElemName "area") props []

article :: forall p i. Node I.HTMLarticle p i
article = element (ElemName "article")

article_ :: forall p i. Array (HTML p i) -> HTML p i
article_ = article []

aside :: forall p i. Node I.HTMLaside p i
aside = element (ElemName "aside")

aside_ :: forall p i. Array (HTML p i) -> HTML p i
aside_ = aside []

audio :: forall p i. Node I.HTMLaudio p i
audio = element (ElemName "audio")

audio_ :: forall p i. Array (HTML p i) -> HTML p i
audio_ = audio []

b :: forall p i. Node I.HTMLb p i
b = element (ElemName "b")

b_ :: forall p i. Array (HTML p i) -> HTML p i
b_ = b []

base :: forall p i. Leaf I.HTMLbase p i
base props = element (ElemName "base") props []

bdi :: forall p i. Node I.HTMLbdi p i
bdi = element (ElemName "bdi")

bdi_ :: forall p i. Array (HTML p i) -> HTML p i
bdi_ = bdi []

bdo :: forall p i. Node I.HTMLbdo p i
bdo = element (ElemName "bdo")

bdo_ :: forall p i. Array (HTML p i) -> HTML p i
bdo_ = bdo []

blockquote :: forall p i. Node I.HTMLblockquote p i
blockquote = element (ElemName "blockquote")

blockquote_ :: forall p i. Array (HTML p i) -> HTML p i
blockquote_ = blockquote []

body :: forall p i. Node I.HTMLbody p i
body = element (ElemName "body")

body_ :: forall p i. Array (HTML p i) -> HTML p i
body_ = body []

br :: forall p i. Leaf I.HTMLbr p i
br props = element (ElemName "br") props []

br_ :: forall p i. HTML p i
br_ = br []

button :: forall p i. Node I.HTMLbutton p i
button = element (ElemName "button")

button_ :: forall p i. Array (HTML p i) -> HTML p i
button_ = button []

canvas :: forall p i. Leaf I.HTMLcanvas p i
canvas props = element (ElemName "canvas") props []

caption :: forall p i. Node I.HTMLcaption p i
caption = element (ElemName "caption")

caption_ :: forall p i. Array (HTML p i) -> HTML p i
caption_ = caption []

cite :: forall p i. Node I.HTMLcite p i
cite = element (ElemName "cite")

cite_ :: forall p i. Array (HTML p i) -> HTML p i
cite_ = cite []

code :: forall p i. Node I.HTMLcode p i
code = element (ElemName "code")

code_ :: forall p i. Array (HTML p i) -> HTML p i
code_ = code []

col :: forall p i. Leaf I.HTMLcol p i
col props = element (ElemName "col") props []

colgroup :: forall p i. Node I.HTMLcolgroup p i
colgroup = element (ElemName "colgroup")

colgroup_ :: forall p i. Array (HTML p i) -> HTML p i
colgroup_ = colgroup []

command :: forall p i. Leaf I.HTMLcommand p i
command props = element (ElemName "command") props []

datalist :: forall p i. Node I.HTMLdatalist p i
datalist = element (ElemName "datalist")

datalist_ :: forall p i. Array (HTML p i) -> HTML p i
datalist_ = datalist []

dd :: forall p i. Node I.HTMLdd p i
dd = element (ElemName "dd")

dd_ :: forall p i. Array (HTML p i) -> HTML p i
dd_ = dd []

del :: forall p i. Node I.HTMLdel p i
del = element (ElemName "del")

del_ :: forall p i. Array (HTML p i) -> HTML p i
del_ = del []

details :: forall p i. Node I.HTMLdetails p i
details = element (ElemName "details")

details_ :: forall p i. Array (HTML p i) -> HTML p i
details_ = details []

dfn :: forall p i. Node I.HTMLdfn p i
dfn = element (ElemName "dfn")

dfn_ :: forall p i. Array (HTML p i) -> HTML p i
dfn_ = dfn []

dialog :: forall p i. Node I.HTMLdialog p i
dialog = element (ElemName "dialog")

dialog_ :: forall p i. Array (HTML p i) -> HTML p i
dialog_ = dialog []

div :: forall p i. Node I.HTMLdiv p i
div = element (ElemName "div")

div_ :: forall p i. Array (HTML p i) -> HTML p i
div_ = div []

dl :: forall p i. Node I.HTMLdl p i
dl = element (ElemName "dl")

dl_ :: forall p i. Array (HTML p i) -> HTML p i
dl_ = dl []

dt :: forall p i. Node (I.HTMLdt) p i
dt = element (ElemName "dt")

dt_ :: forall p i. Array (HTML p i) -> HTML p i
dt_ = dt []

em :: forall p i. Node I.HTMLem p i
em = element (ElemName "em")

em_ :: forall p i. Array (HTML p i) -> HTML p i
em_ = em []

embed :: forall p i. Node I.HTMLembed p i
embed = element (ElemName "embed")

embed_ :: forall p i. Array (HTML p i) -> HTML p i
embed_ = embed []

fieldset :: forall p i. Node I.HTMLfieldset p i
fieldset = element (ElemName "fieldset")

fieldset_ :: forall p i. Array (HTML p i) -> HTML p i
fieldset_ = fieldset []

figcaption :: forall p i. Node I.HTMLfigcaption p i
figcaption = element (ElemName "figcaption")

figcaption_ :: forall p i. Array (HTML p i) -> HTML p i
figcaption_ = figcaption []

figure :: forall p i. Node I.HTMLfigure p i
figure = element (ElemName "figure")

figure_ :: forall p i. Array (HTML p i) -> HTML p i
figure_ = figure []

footer :: forall p i. Node I.HTMLfooter p i
footer = element (ElemName "footer")

footer_ :: forall p i. Array (HTML p i) -> HTML p i
footer_ = footer []

form :: forall p i. Node I.HTMLform p i
form = element (ElemName "form")

form_ :: forall p i. Array (HTML p i) -> HTML p i
form_ = form []

h1 :: forall p i. Node I.HTMLh1 p i
h1 = element (ElemName "h1")

h1_ :: forall p i. Array (HTML p i) -> HTML p i
h1_ = h1 []

h2 :: forall p i. Node I.HTMLh2 p i
h2 = element (ElemName "h2")

h2_ :: forall p i. Array (HTML p i) -> HTML p i
h2_ = h1 []

h3 :: forall p i. Node I.HTMLh3 p i
h3 = element (ElemName "h3")

h3_ :: forall p i. Array (HTML p i) -> HTML p i
h3_ = h1 []

h4 :: forall p i. Node I.HTMLh4 p i
h4 = element (ElemName "h4")

h4_ :: forall p i. Array (HTML p i) -> HTML p i
h4_ = h1 []

h5 :: forall p i. Node I.HTMLh5 p i
h5 = element (ElemName "h5")

h5_ :: forall p i. Array (HTML p i) -> HTML p i
h5_ = h1 []

h6 :: forall p i. Node I.HTMLh6 p i
h6 = element (ElemName "h6")

h6_ :: forall p i. Array (HTML p i) -> HTML p i
h6_ = h1 []

head :: forall p i. Node I.HTMLhead p i
head = element (ElemName "head")

head_ :: forall p i. Array (HTML p i) -> HTML p i
head_ = head []

header :: forall p i. Node I.HTMLheader p i
header = element (ElemName "header")

header_ :: forall p i. Array (HTML p i) -> HTML p i
header_ = header []

hr :: forall p i. Leaf I.HTMLhr p i
hr props = element (ElemName "hr") props []

hr_ :: forall p i. HTML p i
hr_ = hr []

html :: forall p i. Node I.HTMLhtml p i
html = element (ElemName "html")

html_ :: forall p i. Array (HTML p i) -> HTML p i
html_ = html []

i :: forall p i. Node I.HTMLi p i
i = element (ElemName "i")

i_ :: forall p i. Array (HTML p i) -> HTML p i
i_ = i []

iframe :: forall p i. Leaf I.HTMLiframe p i
iframe props = element (ElemName "iframe") props []

img :: forall p i. Leaf I.HTMLimg p i
img props = element (ElemName "img") props []

input :: forall p i. Leaf I.HTMLinput p i
input props = element (ElemName "input") props []

ins :: forall p i. Node I.HTMLins p i
ins = element (ElemName "ins")

ins_ :: forall p i. Array (HTML p i) -> HTML p i
ins_ = ins []

kbd :: forall p i. Node I.HTMLkbd p i
kbd = element (ElemName "kbd")

kbd_ :: forall p i. Array (HTML p i) -> HTML p i
kbd_ = kbd []

label :: forall p i. Node I.HTMLlabel p i
label = element (ElemName "label")

label_ :: forall p i. Array (HTML p i) -> HTML p i
label_ = label []

legend :: forall p i. Node I.HTMLlegend p i
legend = element (ElemName "legend")

legend_ :: forall p i. Array (HTML p i) -> HTML p i
legend_ = legend []

li :: forall p i. Node I.HTMLli p i
li = element (ElemName "li")

li_ :: forall p i. Array (HTML p i) -> HTML p i
li_ = li []

link :: forall p i. Leaf I.HTMLlink p i
link props = element (ElemName "link") props []

main :: forall p i. Node I.HTMLmain p i
main = element (ElemName "main")

main_ :: forall p i. Array (HTML p i) -> HTML p i
main_ = main []

map :: forall p i. Node I.HTMLmap p i
map = element (ElemName "map")

map_ :: forall p i. Array (HTML p i) -> HTML p i
map_ = map []

mark :: forall p i. Node I.HTMLmark p i
mark = element (ElemName "mark")

mark_ :: forall p i. Array (HTML p i) -> HTML p i
mark_ = mark []

menu :: forall p i. Node I.HTMLmenu p i
menu = element (ElemName "menu")

menu_ :: forall p i. Array (HTML p i) -> HTML p i
menu_ = menu []

menuitem :: forall p i. Node I.HTMLmenuitem p i
menuitem = element (ElemName "menuitem")

menuitem_ :: forall p i. Array (HTML p i) -> HTML p i
menuitem_ = menuitem []

meta :: forall p i. Leaf I.HTMLmeta p i
meta props = element (ElemName "meta") props []

meter :: forall p i. Node I.HTMLmeter p i
meter = element (ElemName "meter")

meter_ :: forall p i. Array (HTML p i) -> HTML p i
meter_ = meter []

nav :: forall p i. Node I.HTMLnav p i
nav = element (ElemName "nav")

nav_ :: forall p i. Array (HTML p i) -> HTML p i
nav_ = nav []

noscript :: forall p i. Node I.HTMLnoscript p i
noscript = element (ElemName "noscript")

noscript_ :: forall p i. Array (HTML p i) -> HTML p i
noscript_ = noscript []

object :: forall p i. Node I.HTMLobject p i
object = element (ElemName "object")

object_ :: forall p i. Array (HTML p i) -> HTML p i
object_ = object []

ol :: forall p i. Node I.HTMLol p i
ol = element (ElemName "ol")

ol_ :: forall p i. Array (HTML p i) -> HTML p i
ol_ = ol []

optgroup :: forall p i. Node I.HTMLoptgroup p i
optgroup = element (ElemName "optgroup")

optgroup_ :: forall p i. Array (HTML p i) -> HTML p i
optgroup_ = optgroup []

option :: forall p i. Node I.HTMLoption p i
option = element (ElemName "option")

option_ :: forall p i. Array (HTML p i) -> HTML p i
option_ = option []

output :: forall p i. Node I.HTMLoutput p i
output = element (ElemName "output")

output_ :: forall p i. Array (HTML p i) -> HTML p i
output_ = output []

p :: forall p i. Node I.HTMLp p i
p = element (ElemName "p")

p_ :: forall p i. Array (HTML p i) -> HTML p i
p_ = p []

param :: forall p i. Leaf I.HTMLparam p i
param props = element (ElemName "param") props []

pre :: forall p i. Node I.HTMLpre p i
pre = element (ElemName "pre")

pre_ :: forall p i. Array (HTML p i) -> HTML p i
pre_ = pre []

progress :: forall p i. Node I.HTMLprogress p i
progress = element (ElemName "progress")

progress_ :: forall p i. Array (HTML p i) -> HTML p i
progress_ = progress []

q :: forall p i. Node I.HTMLq p i
q = element (ElemName "q")

q_ :: forall p i. Array (HTML p i) -> HTML p i
q_ = q []

rp :: forall p i. Node I.HTMLrp p i
rp = element (ElemName "rp")

rp_ :: forall p i. Array (HTML p i) -> HTML p i
rp_ = rp []

rt :: forall p i. Node I.HTMLrt p i
rt = element (ElemName "rt")

rt_ :: forall p i. Array (HTML p i) -> HTML p i
rt_ = rt []

ruby :: forall p i. Node I.HTMLruby p i
ruby = element (ElemName "ruby")

ruby_ :: forall p i. Array (HTML p i) -> HTML p i
ruby_ = ruby []

samp :: forall p i. Node I.HTMLsamp p i
samp = element (ElemName "samp")

samp_ :: forall p i. Array (HTML p i) -> HTML p i
samp_ = samp []

script :: forall p i. Node I.HTMLscript p i
script = element (ElemName "script")

script_ :: forall p i. Array (HTML p i) -> HTML p i
script_ = script []

section :: forall p i. Node I.HTMLsection p i
section = element (ElemName "section")

section_ :: forall p i. Array (HTML p i) -> HTML p i
section_ = section []

select :: forall p i. Node I.HTMLselect p i
select = element (ElemName "select")

select_ :: forall p i. Array (HTML p i) -> HTML p i
select_ = select []

small :: forall p i. Node I.HTMLsmall p i
small = element (ElemName "small")

small_ :: forall p i. Array (HTML p i) -> HTML p i
small_ = small []

source :: forall p i. Leaf I.HTMLsource p i
source props = element (ElemName "source") props []

span :: forall p i. Node I.HTMLspan p i
span = element (ElemName "span")

span_ :: forall p i. Array (HTML p i) -> HTML p i
span_ = span []

strong :: forall p i. Node I.HTMLstrong p i
strong = element (ElemName "strong")

strong_ :: forall p i. Array (HTML p i) -> HTML p i
strong_ = strong []

style :: forall p i. Node I.HTMLstyle p i
style = element (ElemName "style")

style_ :: forall p i. Array (HTML p i) -> HTML p i
style_ = style []

sub :: forall p i. Node I.HTMLsub p i
sub = element (ElemName "sub")

sub_ :: forall p i. Array (HTML p i) -> HTML p i
sub_ = sub []

summary :: forall p i. Node I.HTMLsummary p i
summary = element (ElemName "summary")

summary_ :: forall p i. Array (HTML p i) -> HTML p i
summary_ = summary []

sup :: forall p i. Node I.HTMLsup p i
sup = element (ElemName "sup")

sup_ :: forall p i. Array (HTML p i) -> HTML p i
sup_ = sup []

table :: forall p i. Node I.HTMLtable p i
table = element (ElemName "table")

table_ :: forall p i. Array (HTML p i) -> HTML p i
table_ = table []

tbody :: forall p i. Node I.HTMLtbody p i
tbody = element (ElemName "tbody")

tbody_ :: forall p i. Array (HTML p i) -> HTML p i
tbody_ = tbody []

td :: forall p i. Node I.HTMLtd p i
td = element (ElemName "td")

td_ :: forall p i. Array (HTML p i) -> HTML p i
td_ = td []

textarea :: forall p i. Leaf I.HTMLtextarea p i
textarea es = element (ElemName "textarea") es []

tfoot :: forall p i. Node I.HTMLtfoot p i
tfoot = element (ElemName "tfoot")

tfoot_ :: forall p i. Array (HTML p i) -> HTML p i
tfoot_ = tfoot []

th :: forall p i. Node I.HTMLth p i
th = element (ElemName "th")

th_ :: forall p i. Array (HTML p i) -> HTML p i
th_ = th []

thead :: forall p i. Node I.HTMLthead p i
thead = element (ElemName "thead")

thead_ :: forall p i. Array (HTML p i) -> HTML p i
thead_ = thead []

time :: forall p i. Node I.HTMLtime p i
time = element (ElemName "time")

time_ :: forall p i. Array (HTML p i) -> HTML p i
time_ = time []

title :: forall p i. Node I.HTMLtitle p i
title = element (ElemName "title")

title_ :: forall p i. Array (HTML p i) -> HTML p i
title_ = title []

tr :: forall p i. Node I.HTMLtr p i
tr = element (ElemName "tr")

tr_ :: forall p i. Array (HTML p i) -> HTML p i
tr_ = tr []

track :: forall p i. Leaf I.HTMLtrack p i
track props = element (ElemName "track") props []

u :: forall p i. Node I.HTMLu p i
u = element (ElemName "u")

u_ :: forall p i. Array (HTML p i) -> HTML p i
u_ = u []

ul :: forall p i. Node I.HTMLul p i
ul = element (ElemName "ul")

ul_ :: forall p i. Array (HTML p i) -> HTML p i
ul_ = ul []

var :: forall p i. Node I.HTMLvar p i
var = element (ElemName "var")

var_ :: forall p i. Array (HTML p i) -> HTML p i
var_ = var []

video :: forall p i. Node I.HTMLvideo p i
video = element (ElemName "video")

video_ :: forall p i. Array (HTML p i) -> HTML p i
video_ = video []

wbr :: forall p i. Leaf I.HTMLwbr p i
wbr props = element (ElemName "wbr") props []


Use replicateM

Use replicateM

-- | This module is a partial port of the Haskell QuickCheck library.
-- |
-- | QuickCheck provides a way to write _property-based_ tests.
-- |
-- | The `Arbitrary` and `CoArbitrary` type classes allow us to create
-- | random data with which we can run our tests. This module provides
-- | instances of both classes for PureScript's core data structures,
-- | as well as functions for writing new instances.
-- |
-- | Test suites can use the `quickCheck` and `quickCheckPure` functions
-- | to test properties.
-- |
-- | For example:
-- |
-- | ```purescript
-- | main = quickCheck \n -> n + 1 > n
-- | ```
module Test.QuickCheck where

import Control.Monad (replicateM)
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Exception (Exception(), throwException, error)
import Control.Monad.Eff.Random (Random(), random)
import Data.Int (Int(), fromNumber, toNumber)
import Debug.Trace (Trace(), trace)
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Gen

-- | A type synonym which represents the effects used by the `quickCheck` function.
type QC a = forall eff. Eff (trace :: Trace, random :: Random, err :: Exception | eff) a

-- | Test a property.
-- |
-- | This function generates a new random seed, runs 100 tests and
-- | prints the test results to the console.
quickCheck :: forall prop. (Testable prop) => prop -> QC Unit
quickCheck prop = quickCheck' (fromNumber 100) prop

-- | A variant of the `quickCheck` function which accepts an extra parameter
-- | representing the number of tests which should be run.
quickCheck' :: forall prop. (Testable prop) => Int -> prop -> QC Unit
quickCheck' n prop = do
  seed <- fromNumber <<< (1073741824 *) <$> random
  let results = quickCheckPure seed n prop
  let successes = countSuccesses results
  trace $ show (toNumber successes) ++ "/" ++ show (toNumber n) ++ " test(s) passed."
  throwOnFirstFailure one results

  where

  throwOnFirstFailure :: Int -> [Result] -> QC Unit
  throwOnFirstFailure _ [] = return unit
  throwOnFirstFailure n (Failed msg : _) = throwException $ error $ "Test " ++ show (toNumber n) ++ " failed: \n" ++ msg
  throwOnFirstFailure n (_ : rest) = throwOnFirstFailure (n + one) rest

  countSuccesses :: [Result] -> Int
  countSuccesses [] = zero
  countSuccesses (Success : rest) = one + countSuccesses rest
  countSuccesses (_ : rest) = countSuccesses rest

-- | Test a property, returning all test results as an array.
-- |
-- | The first argument is the _random seed_ to be passed to the random generator.
-- | The second argument is the number of tests to run.
quickCheckPure :: forall prop. (Testable prop) => Int -> Int -> prop -> [Result]
quickCheckPure s n prop = evalGen (replicateM n (test prop)) { newSeed: s, size: fromNumber 10 }

-- | The `Testable` class represents _testable properties_.
-- |
-- | A testable property is a function of zero or more `Arbitrary` arguments,
-- | returning a `Boolean` or `Result`.
-- |
-- | Testable properties can be passed to the `quickCheck` function.
class Testable prop where
  test :: prop -> Gen Result

instance testableResult :: Testable Result where
  test = return

instance testableBoolean :: Testable Boolean where
  test true = return Success
  test false = return $ Failed "Test returned false"

instance testableFunction :: (Arbitrary t, Testable prop) => Testable (t -> prop) where
  test f = arbitrary >>= test <<< f

-- | The result of a test: success or failure (with an error message).
data Result = Success | Failed String

instance showResult :: Show Result where
  show Success = "Success"
  show (Failed msg) = "Failed: " ++ msg

-- | This operator attaches an error message to a failed test.
-- |
-- | For example:
-- |
-- | ```purescript
-- | test x = myProperty x <?> ("myProperty did not hold for " <> show x)
-- | ```
(<?>) :: Boolean -> String -> Result
(<?>) true _ = Success
(<?>) false msg = Failed msg

-- | Self-documenting equality assertion
(===) :: forall a b. (Eq a, Show a) => a -> a -> Result
(===) a b = a == b <?> show a ++ " /= " ++ show b

-- | Self-documenting inequality assertion
(/==) :: forall a b. (Eq a, Show a) => a -> a -> Result
(/==) a b = a /= b <?> show a ++ " == " ++ show b

-- | This module is a partial port of the Haskell QuickCheck library.
-- |
-- | QuickCheck provides a way to write _property-based_ tests.
-- |
-- | The `Arbitrary` and `CoArbitrary` type classes allow us to create
-- | random data with which we can run our tests. This module provides
-- | instances of both classes for PureScript's core data structures,
-- | as well as functions for writing new instances.
-- |
-- | Test suites can use the `quickCheck` and `quickCheckPure` functions
-- | to test properties.
-- |
-- | For example:
-- |
-- | ```purescript
-- | main = quickCheck \n -> n + 1 > n
-- | ```
module Test.QuickCheck where

import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Exception (Exception(), throwException, error)
import Control.Monad.Eff.Random (Random(), random)
import Data.Int (Int(), fromNumber, toNumber)
import Debug.Trace (Trace(), trace)
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Gen

-- | A type synonym which represents the effects used by the `quickCheck` function.
type QC a = forall eff. Eff (trace :: Trace, random :: Random, err :: Exception | eff) a

-- | Test a property.
-- |
-- | This function generates a new random seed, runs 100 tests and
-- | prints the test results to the console.
quickCheck :: forall prop. (Testable prop) => prop -> QC Unit
quickCheck prop = quickCheck' (fromNumber 100) prop

-- | A variant of the `quickCheck` function which accepts an extra parameter
-- | representing the number of tests which should be run.
quickCheck' :: forall prop. (Testable prop) => Int -> prop -> QC Unit
quickCheck' n prop = do
  seed <- fromNumber <<< (1073741824 *) <$> random
  let results = quickCheckPure seed n prop
  let successes = countSuccesses results
  trace $ show (toNumber successes) ++ "/" ++ show (toNumber n) ++ " test(s) passed."
  throwOnFirstFailure one results

  where

  throwOnFirstFailure :: Int -> [Result] -> QC Unit
  throwOnFirstFailure _ [] = return unit
  throwOnFirstFailure n (Failed msg : _) = throwException $ error $ "Test " ++ show (toNumber n) ++ " failed: \n" ++ msg
  throwOnFirstFailure n (_ : rest) = throwOnFirstFailure (n + one) rest

  countSuccesses :: [Result] -> Int
  countSuccesses [] = zero
  countSuccesses (Success : rest) = one + countSuccesses rest
  countSuccesses (_ : rest) = countSuccesses rest

-- | Test a property, returning all test results as an array.
-- |
-- | The first argument is the _random seed_ to be passed to the random generator.
-- | The second argument is the number of tests to run.
quickCheckPure :: forall prop. (Testable prop) => Int -> Int -> prop -> [Result]
quickCheckPure s = quickCheckPure' { newSeed: s, size: fromNumber 10 } where
  quickCheckPure' st n prop = evalGen (go n) st
    where
    go n | n <= zero = return []
    go n = do
      result <- test prop
      rest <- go (n - one)
      return $ result : rest

-- | The `Testable` class represents _testable properties_.
-- |
-- | A testable property is a function of zero or more `Arbitrary` arguments,
-- | returning a `Boolean` or `Result`.
-- |
-- | Testable properties can be passed to the `quickCheck` function.
class Testable prop where
  test :: prop -> Gen Result

instance testableResult :: Testable Result where
  test = return

instance testableBoolean :: Testable Boolean where
  test true = return Success
  test false = return $ Failed "Test returned false"

instance testableFunction :: (Arbitrary t, Testable prop) => Testable (t -> prop) where
  test f = do
    t <- arbitrary
    test (f t)

-- | The result of a test: success or failure (with an error message).
data Result = Success | Failed String

instance showResult :: Show Result where
  show Success = "Success"
  show (Failed msg) = "Failed: " ++ msg

-- | This operator attaches an error message to a failed test.
-- |
-- | For example:
-- |
-- | ```purescript
-- | test x = myProperty x <?> ("myProperty did not hold for " <> show x)
-- | ```
(<?>) :: Boolean -> String -> Result
(<?>) true _ = Success
(<?>) false msg = Failed msg

-- | Self-documenting equality assertion
(===) :: forall a b. (Eq a, Show a) => a -> a -> Result
(===) a b = a == b <?> msg
  where
    msg = show a ++ " /= " ++ show b

-- | Self-documenting inequality assertion
(/==) :: forall a b. (Eq a, Show a) => a -> a -> Result
(/==) a b = a /= b <?> msg
  where
    msg = show a ++ " == " ++ show b


source getter

source getter

module Content.Interop (getSource) where

import Prelude (bind, pure, show, ($))
import Data.Either (either)
import Control.Monad.Aff (attempt, Aff)
import Network.HTTP.Affjax (AJAX, get)

getSource :: forall r.
      Aff
        ( ajax :: AJAX
        | r
        )
        String
getSource = do
  res <- attempt $ get "/functional-and-serverless.present.md"
  let decode r = r.response
  pure $ either show decode res

module Interop where

import Prelude (bind, pure, show, ($), (<<<))
import Data.Either (Either(..), either)
import Data.Maybe (Maybe(..))
import Control.Monad.Aff (attempt, Aff)
import Network.HTTP.Affjax (AJAX, get)
import Data.Argonaut (class DecodeJson, decodeJson, (.?))

type Todos = Array Todo

newtype Todo = Todo
  { id :: Int
  , title :: String }

data Event = RequestTodos | ReceiveTodos (Either String Todos)

instance decodeJsonTodo :: DecodeJson Todo where
  decodeJson json = do
    obj <- decodeJson json
    id <- obj .? "id"
    title <- obj .? "title"
    pure $ Todo { id: id, title: title }

getSomething :: forall r.
      Aff
        ( ajax :: AJAX
        | r
        )
        (Maybe Event)
getSomething =  do
      res <- attempt $ get "http://jsonplaceholder.typicode.com/users/1/todos"
      let decode r = decodeJson r.response :: Either String Todos
      let todos = either (Left <<< show) decode res
      pure $ Just $ ReceiveTodos todos


Implemented exercise 4 from chapter 3.

Implemented exercise 4 from chapter 3.

module Data.PhoneBook (
  Entry(..),
  PhoneBook(..),
  emptyBook,
  showEntry,
  insertEntry,
  findEntry,
  containsEntry,
  findByPhone,
  findByName,
  containsPhone,
  containsName,
  removeDuplicates
  ) where

import Data.Maybe
import Data.List

import Control.Plus (empty)

type Entry = { firstName :: String, lastName :: String, phone :: String }
type PhoneBook = List Entry

emptyBook :: PhoneBook
emptyBook = empty

showEntry :: Entry -> String
showEntry entry = entry.lastName ++ ", " ++
                  entry.firstName ++ ": " ++
                  entry.phone

insertEntry :: Entry -> PhoneBook -> PhoneBook
insertEntry entry book = Cons entry book

filterByPhone :: String -> Entry -> Boolean
filterByPhone phone entry = entry.phone == phone

filterByName :: String -> String -> Entry -> Boolean
filterByName firstName lastName entry = entry.firstName == firstName && entry.lastName == lastName

findEntry :: forall a. (a -> Boolean) -> Data.List.List a -> Maybe a
findEntry fn book = head $ filter fn book

containsEntry :: forall a. (a -> Boolean) -> Data.List.List a -> Boolean
containsEntry fn book = not $ null $ filter fn book

findByPhone :: String -> PhoneBook -> Maybe Entry
findByPhone phone book = findEntry (filterByPhone phone) book

findByName :: String -> String -> PhoneBook -> Maybe Entry
findByName firstName lastName book = findEntry (filterByName firstName lastName) book

containsPhone :: String -> PhoneBook -> Boolean
containsPhone phone book = containsEntry (filterByPhone phone) book

containsName :: String -> String -> PhoneBook -> Boolean
containsName firstName lastName book = containsEntry (filterByName firstName lastName) book

duplicateEntry :: Entry -> Entry -> Boolean
duplicateEntry entry1 entry2 = entry1.firstName == entry2.firstName && entry1.lastName == entry2.lastName

removeDuplicates :: PhoneBook -> PhoneBook
removeDuplicates book = nubBy duplicateEntry book

-- > :i Data.PhoneBook
-- > :i Data.List
-- > let john = { firstName: "John", lastName: "Smith", phone: "555-555-5555" }
-- > let book1 = insertEntry john emptyBook
-- > let book2 = insertEntry john book1
-- > let printEntry firstName lastName book = showEntry <$> findByName firstName lastName book
-- > length book1
-- 1
-- > length book2
-- 2
-- > printEntry "John" "Smith" book1
-- Just ("Smith, John: 555-555-5555")
-- > showEntry <$> findEntry (\entry -> entry.phone == "555-555-5555") book1
-- Just ("Smith, John: 555-555-5555")
-- > showEntry <$> findEntry (\entry -> entry.firstName == "John" && entry.lastName == "Smith") book1
-- Just ("Smith, John: 555-555-5555")
-- > showEntry <$> findEntry (\entry -> entry.firstName == "John" && entry.lastName == "Foo") book1
-- Nothing
-- > showEntry <$> findByPhone "555-555-5555" book1
-- Just ("Smith, John: 555-555-5555")
-- > showEntry <$> findByPhone "bogus" book1
-- Nothing
-- > showEntry <$> findByName "John" "Smith" book1
-- Just ("Smith, John: 555-555-5555")
-- > showEntry <$> findByName "John" "Bogus" book1
-- Nothing
-- > containsName "John" "Smith" book1
-- true
-- > containsName "John" "Bogus" book1
-- false
-- > containsPhone "555-555-5555" book1
-- true
-- > containsPhone "Bogus" book1
-- false
-- > length $ removeDuplicates book1
-- 1
-- > length $ removeDuplicates book2
-- 1

module Data.PhoneBook (
  Entry(..),
  PhoneBook(..),
  emptyBook,
  showEntry,
  insertEntry,
  findEntry,
  containsEntry,
  findByPhone,
  findByName,
  containsPhone,
  containsName
  ) where

import Data.Maybe
import Data.List

import Control.Plus (empty)

type Entry = { firstName :: String, lastName :: String, phone :: String }
type PhoneBook = List Entry

emptyBook :: PhoneBook
emptyBook = empty

showEntry :: Entry -> String
showEntry entry = entry.lastName ++ ", " ++
                  entry.firstName ++ ": " ++
                  entry.phone

insertEntry :: Entry -> PhoneBook -> PhoneBook
insertEntry entry book = Cons entry book

filterByPhone :: String -> Entry -> Boolean
filterByPhone phone entry = entry.phone == phone

filterByName :: String -> String -> Entry -> Boolean
filterByName firstName lastName entry = entry.firstName == firstName && entry.lastName == lastName

findEntry :: forall a. (a -> Boolean) -> Data.List.List a -> Maybe a
findEntry fn book = head $ filter fn book

containsEntry :: forall a. (a -> Boolean) -> Data.List.List a -> Boolean
containsEntry fn book = not $ null $ filter fn book

findByPhone :: String -> PhoneBook -> Maybe Entry
findByPhone phone book = findEntry (filterByPhone phone) book

findByName :: String -> String -> PhoneBook -> Maybe Entry
findByName firstName lastName book = findEntry (filterByName firstName lastName) book

containsPhone :: String -> PhoneBook -> Boolean
containsPhone phone book = containsEntry (filterByPhone phone) book

containsName :: String -> String -> PhoneBook -> Boolean
containsName firstName lastName book = containsEntry (filterByName firstName lastName) book

-- > :i Data.PhoneBook
-- > let example = { firstName: "John", lastName: "Smith", phone: "555-555-5555" }
-- > let john = { firstName: "John", lastName: "Smith", phone: "555-555-5555" }
-- > let book1 = insertEntry john emptyBook
-- > let printEntry firstName lastName book = showEntry <$> findByName firstName lastName book
-- > printEntry "John" "Smith" book1
-- Just ("Smith, John: 555-555-5555")
-- > showEntry <$> findEntry (\entry -> entry.phone == "555-555-5555") book1
-- Just ("Smith, John: 555-555-5555")
-- > showEntry <$> findEntry (\entry -> entry.firstName == "John" && entry.lastName == "Smith") book1
-- Just ("Smith, John: 555-555-5555")
-- > showEntry <$> findEntry (\entry -> entry.firstName == "John" && entry.lastName == "Foo") book1
-- Nothing
-- > showEntry <$> findByPhone "555-555-5555" book1
-- Just ("Smith, John: 555-555-5555")
-- > showEntry <$> findByPhone "bogus" book1
-- Nothing
-- > showEntry <$> findByName "John" "Smith" book1
-- Just ("Smith, John: 555-555-5555")
-- > showEntry <$> findByName "John" "Bogus" book1
-- Nothing
-- > containsName "John" "Smith" book1
-- true
-- > containsName "John" "Bogus" book1
-- false
-- > containsPhone "555-555-5555" book1
-- true
-- > containsPhone "Bogus" book1
-- false


Correct some straggling single-quotes in the "SQL^2" rendering code

{-
Copyright 2016 SlamData, Inc.

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-}

module SlamData.Notebook.Cell.Search.Interpret
  ( queryToSQL
  ) where

import Prelude

import Control.Bind (join)

import Data.Array (filter, catMaybes, head, nub)
import Data.Foldable
import Data.Int as Int
import Data.List (fromList, List())
import Data.Maybe
import Data.Semiring.Free
import Data.String (joinWith, indexOf)
import Data.String.Regex as RX

import Data.SQL2.Literal as SQL2

import Text.SlamSearch.Types as SS

-- TODO: We need to really obliterate this module and replace these regular
-- expressions and ad hoc renderers with something that targets a SQL^2 A(S/B)T,
-- which is then serialized separately. Blocked by SD-1391.

queryToSQL
  :: Array String
  -> SS.SearchQuery
  -> String
queryToSQL fields query =
     "SELECT"
  <> (if needDistinct whereClause then " DISTINCT " else " ")
  <> topFields
  <> " from {{path}} where " <> whereOrFalse
  where
    topFields :: String
    topFields =
        joinWith ", "
      $ nub
      $ map (RX.replace firstDot "")
      $ catMaybes
      $ map join
      $ map head
      $ catMaybes
      $ map (RX.match topFieldRegex)
      $ fields

    topFieldRegex :: RX.Regex
    topFieldRegex = RX.regex "^\\.[^\\.\\[]+|^\\[.+\\]/" RX.noFlags

    whereOrFalse :: String
    whereOrFalse = if whereClause == "()" then "FALSE" else whereClause

    whereClause :: String
    whereClause =
        joinWith " OR "
      $ map oneWhereInput
      $ fromList
      $ runFree
      $ map (termToSQL fields) query

    oneWhereInput :: List String -> String
    oneWhereInput s = pars $ joinWith " AND " $ fromList s

needDistinct :: String -> Boolean
needDistinct input =
  (isJust $ indexOf "{*}" input) || (isJust $ indexOf "[*]" input)

termToSQL
  :: Array String
  -> SS.Term
  -> String
termToSQL fields (SS.Term {include: include, predicate: p, labels: ls}) =
  if not include
    then "NOT " <> pars (termToSQL fields $ SS.Term {include: true, predicate: p, labels: ls})
    else renderPredicate p $ labelsProjection fields (fromList ls)
  where
    renderPredicate :: SS.Predicate -> Array String -> String
    renderPredicate p prj =
      joinWith " OR " (predicateToSQL p <$> prj)

predicateToSQL
  :: SS.Predicate
  -> String
  -> String
predicateToSQL (SS.Contains (SS.Text v)) s =
  joinWith " OR " $
    [s <> " ~* " <> SQL2. renderLiteral (SQL2.string (globToRegex (containsToGlob v)))]
    <> (if needUnq v then renderLowercased v else [])
    <> (if not (needDateTime v) && needDate v then render date else [ ])
    <> (if needTime v then render time  else [])
    <> (if needDateTime v then render ts else [])
    <> (if needInterval v then render i else [])

  where
    containsToGlob :: String -> String
    containsToGlob v =
      if hasSpecialChars v
      then v
      else "*" <> v <> "*"

    hasSpecialChars :: String -> Boolean
    hasSpecialChars v =
      isJust (indexOf "*" v) || isJust (indexOf "?" v)

    date = SQL2.renderLiteral $ SQL2.date v
    time = SQL2.renderLiteral $ SQL2.time v
    ts = SQL2.renderLiteral $ SQL2.dateTime v
    i = SQL2.renderLiteral $ SQL2.interval v

    renderLowercased v = [ "LOWER(" <> s <> ") = " <> v]
    render v = [s <> " = " <> v ]

predicateToSQL (SS.Range (SS.Text v) (SS.Text v')) s =
  joinWith " OR " $
    [ forR' (quote v) (quote v') ]
    <> (if needUnq v && needUnq v' then [ forR v v' ] else [ ])
    <> (if needDate v && needDate v' then [ forR date date' ] else [ ])

  where
    date = SQL2.renderLiteral $ SQL2.date v
    date' = SQL2.renderLiteral $ SQL2.date v'

    forR' :: String -> String -> String
    forR' v v' =
      fold ["(LOWER(", s, ") >=", v, " AND LOWER(", s, ") <= ", v', ")"]

    forR :: String -> String -> String
    forR v v' =
      fold ["(", s, " >= ", v, " AND ", s, " <= ", v', ")"]

predicateToSQL (SS.Range (SS.Tag val) val') s =
  predicateToSQL (SS.Range (SS.Text val) val') s
predicateToSQL (SS.Range val (SS.Tag val')) s =
  predicateToSQL (SS.Range val (SS.Text val')) s
predicateToSQL (SS.Contains (SS.Tag v)) s =
  predicateToSQL (SS.Contains (SS.Text v)) s
predicateToSQL (SS.Eq v) s = renderBinRel s "=" v
predicateToSQL (SS.Gt v) s = renderBinRel s ">" v
predicateToSQL (SS.Gte v) s = renderBinRel s ">=" v
predicateToSQL (SS.Lt v) s = renderBinRel s "<" v
predicateToSQL (SS.Lte v) s = renderBinRel s "<=" v
predicateToSQL (SS.Ne v) s = renderBinRel s "<>" v
predicateToSQL (SS.Like v) s = s <> " ~* " <> SQL2.renderLiteral (SQL2.string v)

globToRegex :: String -> String
globToRegex =
  (\x -> "^" <> x <> "$")
    <<< RX.replace askRegex "."
    <<< RX.replace starRegex ".*"
    <<< RX.replace globEscapeRegex "\\$&"
  where
    globEscapeRegex =
      RX.regex
        "[\\-\\[\\]\\/\\{\\}\\(\\)\\+\\.\\\\\\^\\$\\|]"
        RX.noFlags { global = true }

    starRegex = RX.regex "\\*" RX.noFlags { global = true }
    askRegex = RX.regex "\\?" RX.noFlags { global = true }

renderBinRel
  :: String
  -> String
  -> SS.Value
  -> String
renderBinRel s op v = pars $
  joinWith " OR " $
    [ forV' (quote unquoted) ]
    <> (if needUnq unquoted then [ forV unquoted ] else [])
    <> (if not (needDateTime unquoted) && needDate unquoted then [ forV date ] else [])
    <> (if needTime unquoted then [ forV time ] else [])
    <> (if needDateTime unquoted then [ forV ts ] else [])
    <> (if needInterval unquoted then [ forV i ] else [])
  where
    unquoted = valueToSQL v
    date = SQL2.renderLiteral $ SQL2.date unquoted
    time = SQL2.renderLiteral $ SQL2.time unquoted
    ts = SQL2.renderLiteral $ SQL2.dateTime unquoted
    i = SQL2.renderLiteral $ SQL2.interval unquoted

    forV' v = fold ["LOWER(", s, ") ", op, " ", v]
    forV v = fold [s, " ", op, " ", v]

-- | Whether the string should be rendered without quotes
needUnq :: String -> Boolean
needUnq s =
  fromMaybe false ((show >>> (== s)) <$> Int.fromString s)
  || fromMaybe false ((show >>> (== s)) <$> Utils.stringToNumber s)
  || s == "true"
  || s == "false"

needDate :: String -> Boolean
needDate = RX.test dateRegex
  where
    dateRegex =
      RX.regex
        """^(((19|20)([2468][048]|[13579][26]|0[48])|2000)[-]02[-]29|((19|20)[0-9]{2}[-](0[4678]|1[02])[-](0[1-9]|[12][0-9]|30)|(19|20)[0-9]{2}[-](0[1359]|11)[-](0[1-9]|[12][0-9]|3[01])|(19|20)[0-9]{2}[-]02[-](0[1-9]|1[0-9]|2[0-8])))$"""
        RX.noFlags

needTime :: String -> Boolean
needTime = RX.test timeRegex
  where
    timeRegex =
      RX.regex
        "^([0-1]?[0-9]|2[0-3]):[0-5][0-9](:[0-5][0-9])?$"
        RX.noFlags

needDateTime :: String -> Boolean
needDateTime = RX.test dtRegex
  where
    dtRegex =
      RX.regex
        "^(-?(?:[1-9][0-9]*)?[0-9]{4})-(1[0-2]|0[1-9])-(3[0-1]|0[1-9]|[1-2][0-9]) (2[0-3]|[0-1][0-9]):([0-5][0-9]):([0-5][0-9])(\\.[0-9]+)?(Z|[+-](?:2[0-3]|[0-1][0-9]):[0-5][0-9])?$"
        RX.noFlags

needInterval :: String -> Boolean
needInterval = RX.test intervalRegex
  where
    intervalRegex =
      RX.regex
        "P((([0-9]*\\.?[0-9]*)Y)?(([0-9]*\\.?[0-9]*)M)?(([0-9]*\\.?[0-9]*)W)?(([0-9]*\\.?[0-9]*)D)?)?(T(([0-9]*\\.?[0-9]*)H)?(([0-9]*\\.?[0-9]*)M)?(([0-9]*\\.?[0-9]*)S)?)?"
        RX.noFlags

valueToSQL :: SS.Value -> String
valueToSQL v =
  case v of
    SS.Text v -> v
    SS.Tag v -> v

labelsProjection :: Array String -> Array SS.Label -> Array String
labelsProjection fields ls =
  nub
  $ RX.replace arrFieldRgx "[*]"
  <$> RX.replace firstDot ""
  <$> filter (RX.test $ labelsRegex ls) fields
  where
    arrFieldRgx :: RX.Regex
    arrFieldRgx = RX.regex "\\[\\d+\\]" RX.noFlags{global = true}

labelsRegex :: Array SS.Label -> RX.Regex
labelsRegex [] = RX.regex ".*" RX.noFlags
labelsRegex ls =
  RX.regex ("^" <> (foldMap mapFn ls) <> "$") RX.noFlags{ignoreCase = true}
  where
  mapFn :: SS.Label -> String
  mapFn (SS.Meta l) = mapFn (SS.Common l)
  mapFn (SS.Common "{*}") = "(\\.[^\\.]+)"
  mapFn (SS.Common "[*]") = "(\\[\\d+\\])"
  mapFn (SS.Common "*") = "(\\.[^\\.]+|\\[\\d+\\])"
  mapFn (SS.Common l)
    | RX.test (RX.regex "\\[\\d+\\]" RX.noFlags) l =
        RX.replace openSquare "\\["
      $ RX.replace closeSquare "\\]"
      $ l
    | otherwise = "(\\.`" <> l <> "`|\\." <> l <> ")"

  openSquare :: RX.Regex
  openSquare = RX.regex "\\[" RX.noFlags

  closeSquare :: RX.Regex
  closeSquare = RX.regex "\\]" RX.noFlags

firstDot :: RX.Regex
firstDot = RX.regex "^\\." RX.noFlags

quote :: String -> String
quote s = SQL2.renderLiteral $ SQL2.string s

pars :: String -> String
pars s = "(" <> s <> ")"

{-
Copyright 2016 SlamData, Inc.

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
-}

module SlamData.Notebook.Cell.Search.Interpret
  ( queryToSQL
  ) where

import Prelude

import Control.Bind (join)

import Data.Array (filter, catMaybes, head, nub)
import Data.Foldable
import Data.Int as Int
import Data.List (fromList, List())
import Data.Maybe
import Data.Semiring.Free
import Data.String (joinWith, indexOf)
import Data.String.Regex as RX

import Data.SQL2.Literal as SQL2

import Text.SlamSearch.Types as SS

-- TODO: We need to really obliterate this module and replace these regular
-- expressions and ad hoc renderers with something that targets a SQL^2 A(S/B)T,
-- which is then serialized separately. Blocked by SD-1391.

queryToSQL
  :: Array String
  -> SS.SearchQuery
  -> String
queryToSQL fields query =
     "SELECT"
  <> (if needDistinct whereClause then " DISTINCT " else " ")
  <> topFields
  <> " from {{path}} where " <> whereOrFalse
  where
    topFields :: String
    topFields =
        joinWith ", "
      $ nub
      $ map (RX.replace firstDot "")
      $ catMaybes
      $ map join
      $ map head
      $ catMaybes
      $ map (RX.match topFieldRegex)
      $ fields

    topFieldRegex :: RX.Regex
    topFieldRegex = RX.regex "^\\.[^\\.\\[]+|^\\[.+\\]/" RX.noFlags

    whereOrFalse :: String
    whereOrFalse = if whereClause == "()" then "FALSE" else whereClause

    whereClause :: String
    whereClause =
        joinWith " OR "
      $ map oneWhereInput
      $ fromList
      $ runFree
      $ map (termToSQL fields) query

    oneWhereInput :: List String -> String
    oneWhereInput s = pars $ joinWith " AND " $ fromList s

needDistinct :: String -> Boolean
needDistinct input =
  (isJust $ indexOf "{*}" input) || (isJust $ indexOf "[*]" input)

termToSQL
  :: Array String
  -> SS.Term
  -> String
termToSQL fields (SS.Term {include: include, predicate: p, labels: ls}) =
  if not include
    then "NOT " <> pars (termToSQL fields $ SS.Term {include: true, predicate: p, labels: ls})
    else renderPredicate p $ labelsProjection fields (fromList ls)
  where
    renderPredicate :: SS.Predicate -> Array String -> String
    renderPredicate p prj =
      joinWith " OR " (predicateToSQL p <$> prj)

predicateToSQL
  :: SS.Predicate
  -> String
  -> String
predicateToSQL (SS.Contains (SS.Text v)) s =
  joinWith " OR " $
    [s <> " ~* '" <> (globToRegex $ containsToGlob v) <> "'"]
    <> (if needUnq v then renderLowercased v else [])
    <> (if not (needDateTime v) && needDate v then render date else [ ])
    <> (if needTime v then render time  else [])
    <> (if needDateTime v then render ts else [])
    <> (if needInterval v then render i else [])

  where
    containsToGlob :: String -> String
    containsToGlob v =
      if hasSpecialChars v
      then v
      else "*" <> v <> "*"

    hasSpecialChars :: String -> Boolean
    hasSpecialChars v =
      isJust (indexOf "*" v) || isJust (indexOf "?" v)

    date = SQL2.renderLiteral $ SQL2.date v
    time = SQL2.renderLiteral $ SQL2.time v
    ts = SQL2.renderLiteral $ SQL2.dateTime v
    i = SQL2.renderLiteral $ SQL2.interval v

    renderLowercased v = [ "LOWER(" <> s <> ") = " <> v]
    render v = [s <> " = " <> v ]

predicateToSQL (SS.Range (SS.Text v) (SS.Text v')) s =
  joinWith " OR " $
    [ forR' (quote v) (quote v') ]
    <> (if needUnq v && needUnq v' then [ forR v v' ] else [ ])
    <> (if needDate v && needDate v' then [ forR date date' ] else [ ])

  where
    date = SQL2.renderLiteral $ SQL2.date v
    date' = SQL2.renderLiteral $ SQL2.date v'

    forR' :: String -> String -> String
    forR' v v' =
      fold ["(LOWER(", s, ") >=", v, " AND LOWER(", s, ") <= ", v', ")"]

    forR :: String -> String -> String
    forR v v' =
      fold ["(", s, " >= ", v, " AND ", s, " <= ", v', ")"]

predicateToSQL (SS.Range (SS.Tag val) val') s =
  predicateToSQL (SS.Range (SS.Text val) val') s
predicateToSQL (SS.Range val (SS.Tag val')) s =
  predicateToSQL (SS.Range val (SS.Text val')) s
predicateToSQL (SS.Contains (SS.Tag v)) s =
  predicateToSQL (SS.Contains (SS.Text v)) s
predicateToSQL (SS.Eq v) s = renderBinRel s "=" v
predicateToSQL (SS.Gt v) s = renderBinRel s ">" v
predicateToSQL (SS.Gte v) s = renderBinRel s ">=" v
predicateToSQL (SS.Lt v) s = renderBinRel s "<" v
predicateToSQL (SS.Lte v) s = renderBinRel s "<=" v
predicateToSQL (SS.Ne v) s = renderBinRel s "<>" v
predicateToSQL (SS.Like v) s = s <> " ~* '" <> v <> "'"

globToRegex :: String -> String
globToRegex =
  (\x -> "^" <> x <> "$")
    <<< RX.replace askRegex "."
    <<< RX.replace starRegex ".*"
    <<< RX.replace globEscapeRegex "\\$&"
  where
    globEscapeRegex =
      RX.regex
        "[\\-\\[\\]\\/\\{\\}\\(\\)\\+\\.\\\\\\^\\$\\|]"
        RX.noFlags { global = true }

    starRegex = RX.regex "\\*" RX.noFlags { global = true }
    askRegex = RX.regex "\\?" RX.noFlags { global = true }

renderBinRel
  :: String
  -> String
  -> SS.Value
  -> String
renderBinRel s op v = pars $
  joinWith " OR " $
    [ forV' (quote unquoted) ]
    <> (if needUnq unquoted then [ forV unquoted ] else [])
    <> (if not (needDateTime unquoted) && needDate unquoted then [ forV date ] else [])
    <> (if needTime unquoted then [ forV time ] else [])
    <> (if needDateTime unquoted then [ forV ts ] else [])
    <> (if needInterval unquoted then [ forV i ] else [])
  where
    unquoted = valueToSQL v
    date = SQL2.renderLiteral $ SQL2.date unquoted
    time = SQL2.renderLiteral $ SQL2.time unquoted
    ts = SQL2.renderLiteral $ SQL2.dateTime unquoted
    i = SQL2.renderLiteral $ SQL2.interval unquoted

    forV' v = fold ["LOWER(", s, ") ", op, " ", v]
    forV v = fold [s, " ", op, " ", v]

-- | Whether the string should be rendered without quotes
needUnq :: String -> Boolean
needUnq s =
  fromMaybe false ((show >>> (== s)) <$> Int.fromString s)
  || fromMaybe false ((show >>> (== s)) <$> Utils.stringToNumber s)
  || s == "true"
  || s == "false"

needDate :: String -> Boolean
needDate = RX.test dateRegex
  where
    dateRegex =
      RX.regex
        """^(((19|20)([2468][048]|[13579][26]|0[48])|2000)[-]02[-]29|((19|20)[0-9]{2}[-](0[4678]|1[02])[-](0[1-9]|[12][0-9]|30)|(19|20)[0-9]{2}[-](0[1359]|11)[-](0[1-9]|[12][0-9]|3[01])|(19|20)[0-9]{2}[-]02[-](0[1-9]|1[0-9]|2[0-8])))$"""
        RX.noFlags

needTime :: String -> Boolean
needTime = RX.test timeRegex
  where
    timeRegex =
      RX.regex
        "^([0-1]?[0-9]|2[0-3]):[0-5][0-9](:[0-5][0-9])?$"
        RX.noFlags

needDateTime :: String -> Boolean
needDateTime = RX.test dtRegex
  where
    dtRegex =
      RX.regex
        "^(-?(?:[1-9][0-9]*)?[0-9]{4})-(1[0-2]|0[1-9])-(3[0-1]|0[1-9]|[1-2][0-9]) (2[0-3]|[0-1][0-9]):([0-5][0-9]):([0-5][0-9])(\\.[0-9]+)?(Z|[+-](?:2[0-3]|[0-1][0-9]):[0-5][0-9])?$"
        RX.noFlags

needInterval :: String -> Boolean
needInterval = RX.test intervalRegex
  where
    intervalRegex =
      RX.regex
        "P((([0-9]*\\.?[0-9]*)Y)?(([0-9]*\\.?[0-9]*)M)?(([0-9]*\\.?[0-9]*)W)?(([0-9]*\\.?[0-9]*)D)?)?(T(([0-9]*\\.?[0-9]*)H)?(([0-9]*\\.?[0-9]*)M)?(([0-9]*\\.?[0-9]*)S)?)?"
        RX.noFlags

valueToSQL :: SS.Value -> String
valueToSQL v =
  case v of
    SS.Text v -> v
    SS.Tag v -> v

labelsProjection :: Array String -> Array SS.Label -> Array String
labelsProjection fields ls =
  nub
  $ RX.replace arrFieldRgx "[*]"
  <$> RX.replace firstDot ""
  <$> filter (RX.test $ labelsRegex ls) fields
  where
    arrFieldRgx :: RX.Regex
    arrFieldRgx = RX.regex "\\[\\d+\\]" RX.noFlags{global = true}

labelsRegex :: Array SS.Label -> RX.Regex
labelsRegex [] = RX.regex ".*" RX.noFlags
labelsRegex ls =
  RX.regex ("^" <> (foldMap mapFn ls) <> "$") RX.noFlags{ignoreCase = true}
  where
  mapFn :: SS.Label -> String
  mapFn (SS.Meta l) = mapFn (SS.Common l)
  mapFn (SS.Common "{*}") = "(\\.[^\\.]+)"
  mapFn (SS.Common "[*]") = "(\\[\\d+\\])"
  mapFn (SS.Common "*") = "(\\.[^\\.]+|\\[\\d+\\])"
  mapFn (SS.Common l)
    | RX.test (RX.regex "\\[\\d+\\]" RX.noFlags) l =
        RX.replace openSquare "\\["
      $ RX.replace closeSquare "\\]"
      $ l
    | otherwise = "(\\.`" <> l <> "`|\\." <> l <> ")"

  openSquare :: RX.Regex
  openSquare = RX.regex "\\[" RX.noFlags

  closeSquare :: RX.Regex
  closeSquare = RX.regex "\\]" RX.noFlags

firstDot :: RX.Regex
firstDot = RX.regex "^\\." RX.noFlags

quote :: String -> String
quote s = SQL2.renderLiteral $ SQL2.string s

pars :: String -> String
pars s = "(" <> s <> ")"