Remove the explicit calls to >>=

Remove the explicit calls to >>=

(Medium) Rewrite the code in the Data.AddressBook.UI module without
explicit calls to >>=.

module Data.AddressBook.UI where

import Data.Maybe
import Data.Either
import Data.Foreign
import Data.Foreign.Class
import Data.AddressBook
import Data.AddressBook.Validation

import Data.Traversable

import Control.Bind

import Control.Monad.Eff
import Control.Monad.Eff.DOM

import Debug.Trace

valueOf :: forall eff. String -> Eff (dom :: DOM | eff) String
valueOf sel = do
  maybeEl <- querySelector sel
  case maybeEl of
    Nothing -> return ""
    Just el -> do
      value <- getValue el
      return $ case read value of
        Right s -> s
        _ -> ""

displayValidationErrors :: forall eff. [String] -> Eff (dom :: DOM | eff) Unit
displayValidationErrors errs = do
  alert <- createElement "div"

  foreachE errs $ \err -> do
    div <- createElement "div"
    x <- err `setText` div
    y <- "alert" `addClass` x
    z <- "alert-danger" `addClass` y
    z `appendChild` alert

    return unit

  Just validationErrors <- querySelector "#validationErrors"
  alert `appendChild` validationErrors

  return unit

validateControls :: forall eff. Eff (trace :: Trace, dom :: DOM | eff) (Either [String] Person)
validateControls = do
  trace "Running Validators"

  p <- person <$> valueOf "#inputFirstName"
              <*> valueOf "#inputLastName"
              <*> sequence (Just (address <$> valueOf "#inputStreet"
                                 <*> valueOf "#inputCity"
                                 <*> valueOf "#inputState"))
              <*> sequence [ phoneNumber HomePhone <$> valueOf "#inputHomePhone"
                           , phoneNumber CellPhone <$> valueOf "#inputCellPhone"
                           , phoneNumber WorkPhone <$> valueOf "#inputWorkPhone"
                           ]

  return $ validatePerson' p

validateAndUpdateUI :: forall eff. Eff (trace :: Trace, dom :: DOM | eff) Unit
validateAndUpdateUI = do
  Just validationErrors <- querySelector "#validationErrors"
  setInnerHTML "" validationErrors

  errorsOrResult <- validateControls

  case errorsOrResult of
    Left errs -> displayValidationErrors errs
    Right result -> print result

  return unit

setupEventHandlers :: forall eff. Eff (trace :: Trace, dom :: DOM | eff) Unit
setupEventHandlers = do
  body >>= addEventListener "change" validateAndUpdateUI

  return unit

module Data.AddressBook.UI where

import Data.Maybe
import Data.Either
import Data.Foreign
import Data.Foreign.Class
import Data.AddressBook
import Data.AddressBook.Validation

import Data.Traversable

import Control.Bind

import Control.Monad.Eff
import Control.Monad.Eff.DOM

import Debug.Trace

valueOf :: forall eff. String -> Eff (dom :: DOM | eff) String
valueOf sel = do
  maybeEl <- querySelector sel
  case maybeEl of
    Nothing -> return ""
    Just el -> do
      value <- getValue el
      return $ case read value of
        Right s -> s
        _ -> ""

displayValidationErrors :: forall eff. [String] -> Eff (dom :: DOM | eff) Unit
displayValidationErrors errs = do
  alert <- createElement "div"

  foreachE errs $ \err -> do
    div <- createElement "div"
      >>= setText err
      >>= addClass "alert"
      >>= addClass "alert-danger"
    div `appendChild` alert

    return unit

  Just validationErrors <- querySelector "#validationErrors"
  alert `appendChild` validationErrors

  return unit

validateControls :: forall eff. Eff (trace :: Trace, dom :: DOM | eff) (Either [String] Person)
validateControls = do
  trace "Running Validators"

  p <- person <$> valueOf "#inputFirstName"
              <*> valueOf "#inputLastName"
              <*> sequence (Just (address <$> valueOf "#inputStreet"
                                 <*> valueOf "#inputCity"
                                 <*> valueOf "#inputState"))
              <*> sequence [ phoneNumber HomePhone <$> valueOf "#inputHomePhone"
                           , phoneNumber CellPhone <$> valueOf "#inputCellPhone"
                           , phoneNumber WorkPhone <$> valueOf "#inputWorkPhone"
                           ]

  return $ validatePerson' p

validateAndUpdateUI :: forall eff. Eff (trace :: Trace, dom :: DOM | eff) Unit
validateAndUpdateUI = do
  Just validationErrors <- querySelector "#validationErrors"
  setInnerHTML "" validationErrors

  errorsOrResult <- validateControls

  case errorsOrResult of
    Left errs -> displayValidationErrors errs
    Right result -> print result

  return unit

setupEventHandlers :: forall eff. Eff (trace :: Trace, dom :: DOM | eff) Unit
setupEventHandlers = do
  body >>= addEventListener "change" validateAndUpdateUI

  return unit


different when impl

different when impl

module Data.DOM.Render.JQuery where

import Data.DOM

import Data.Foldable (for_)

import Control.Apply
import Control.Monad.Free
import Control.Monad.Eff
import Control.Monad.Eff.Unsafe (unsafeInterleaveEff)
import qualified Control.Monad.JQuery as JQuery
import qualified Control.Reactive as R
import qualified Control.Reactive.JQuery as RJ

createElement :: forall eff. String -> [Attribute] -> Eff (dom :: JQuery.DOM | eff) JQuery.JQuery
createElement elem attrs = do
  el <- JQuery.create $ "<" ++ elem ++ ">"
  for_ attrs $ \(Attribute key value) ->
    JQuery.setAttr key value el
  return el

renderJQuery :: forall a eff. JQuery.JQuery -> Html a -> Eff (dom :: JQuery.DOM, reactive :: R.Reactive | eff) a
renderJQuery root = iterM go
  where
  go (Element ed) = runElementData ed (\elem attrs children k -> do
    el <- createElement elem attrs
    b <- renderJQuery el children
    JQuery.append el root
    k b)
  go (Text s rest) = do
    JQuery.appendText s root
    rest
  go (Label c attrs rest) = do
    el <- createElement "span" attrs
    sub <- RJ.bindTextOneWay c el
    JQuery.append el root
    rest sub
  go (TextBox var attrs rest) = do
    el <- createElement "input" attrs
    sub <- RJ.bindValueTwoWay var el
    JQuery.append el root
    rest sub
  go (CheckBox var attrs rest) = do
    el <- createElement "input" (Attribute "type" "checkbox" : attrs)
    sub <- RJ.bindCheckedTwoWay var el
    JQuery.append el root
    rest sub
  go (Button text attrs action rest) = do
    el <- createElement "button" attrs
    flip (JQuery.on "click") el $ \_ -> action
    JQuery.appendText text el
    JQuery.append el root
    rest Data.Monoid.mempty
  go (ForEach fed) = runForEachData fed (\arr attrs body k -> do
    el <- createElement "div" attrs
    sub <- RJ.bindArray arr el $ \item index -> do
      itemEl <- createElement "div" []
      s <- renderJQuery itemEl (body item index)
      return { el: itemEl, subscription: s }
    JQuery.append el root
    k sub
    )
  go (When fed) = runWhenData fed (\pred onTrue onFalse k -> do
    b <- R.readRVar pred
    sub <- renderJQuery root $ if b then onTrue else onFalse
    k sub)

module Data.DOM.Render.JQuery where

import Data.DOM

import Data.Foldable (for_)

import Control.Apply
import Control.Monad.Free
import Control.Monad.Eff
import qualified Control.Monad.JQuery as JQuery
import qualified Control.Reactive as R
import qualified Control.Reactive.JQuery as RJ

createElement :: forall eff. String -> [Attribute] -> Eff (dom :: JQuery.DOM | eff) JQuery.JQuery
createElement elem attrs = do
  el <- JQuery.create $ "<" ++ elem ++ ">"
  for_ attrs $ \(Attribute key value) ->
    JQuery.setAttr key value el
  return el

renderJQuery :: forall a eff. JQuery.JQuery -> Html a -> Eff (dom :: JQuery.DOM, reactive :: R.Reactive | eff) a
renderJQuery root = iterM go
  where
  go (Element ed) = runElementData ed (\elem attrs children k -> do
    el <- createElement elem attrs
    b <- renderJQuery el children
    JQuery.append el root
    k b)
  go (Text s rest) = do
    JQuery.appendText s root
    rest
  go (Label c attrs rest) = do
    el <- createElement "span" attrs
    sub <- RJ.bindTextOneWay c el
    JQuery.append el root
    rest sub
  go (TextBox var attrs rest) = do
    el <- createElement "input" attrs
    sub <- RJ.bindValueTwoWay var el
    JQuery.append el root
    rest sub
  go (CheckBox var attrs rest) = do
    el <- createElement "input" (Attribute "type" "checkbox" : attrs)
    sub <- RJ.bindCheckedTwoWay var el
    JQuery.append el root
    rest sub
  go (Button text attrs action rest) = do
    el <- createElement "button" attrs
    flip (JQuery.on "click") el $ \_ -> action
    JQuery.appendText text el
    JQuery.append el root
    rest Data.Monoid.mempty
  go (ForEach fed) = runForEachData fed (\arr attrs body k -> do
    el <- createElement "div" attrs
    sub <- RJ.bindArray arr el $ \item index -> do
      itemEl <- createElement "div" []
      s <- renderJQuery itemEl (body item index)
      return { el: itemEl, subscription: s }
    JQuery.append el root
    k sub
    )
  go (When fed) = runWhenData fed (\pred onTrue onFalse k -> do
    sub <- R.subscribeComputed (R.toComputed pred) $ \b ->
      if b
      then renderJQuery root onTrue *> return {}
      else renderJQuery root onFalse *> return {}
    k sub)


Fix Invariant Maybe instance name

Fix Invariant Maybe instance name

module Data.Maybe where

import Prelude

import Control.Alt (Alt)
import Control.Alternative (Alternative)
import Control.Extend (Extend)
import Control.MonadPlus (MonadPlus)
import Control.Plus (Plus)
import Data.Functor.Invariant (Invariant, imapF)
import Data.Monoid (Monoid)

-- | The `Maybe` type is used to represent optional values and can be seen as
-- | something like a type-safe `null`, where `Nothing` is `null` and `Just x`
-- | is the non-null value `x`.
data Maybe a = Nothing | Just a

-- | Takes a default value, a function, and a `Maybe` value. If the `Maybe`
-- | value is `Nothing` the default value is returned, otherwise the function
-- | is applied to the value inside the `Just` and the result is returned.
-- |
-- | ``` purescript
-- | maybe x f Nothing == x
-- | maybe x f (Just y) == f y
-- | ```
maybe :: forall a b. b -> (a -> b) -> Maybe a -> b
maybe b _ Nothing = b
maybe _ f (Just a) = f a

-- | Takes a default value, and a `Maybe` value. If the `Maybe` value is
-- | `Nothing` the default value is returned, otherwise the value inside the
-- | `Just` is returned.
-- |
-- | ``` purescript
-- | fromMaybe x Nothing == x
-- | fromMaybe x (Just y) == y
-- | ```
fromMaybe :: forall a. a -> Maybe a -> a
fromMaybe a = maybe a (id :: forall a. a -> a)

-- | Returns `true` when the `Maybe` value was constructed with `Just`.
isJust :: forall a. Maybe a -> Boolean
isJust = maybe false (const true)

-- | Returns `true` when the `Maybe` value is `Nothing`.
isNothing :: forall a. Maybe a -> Boolean
isNothing = maybe true (const false)

-- | The `Functor` instance allows functions to transform the contents of a
-- | `Just` with the `<$>` operator:
-- |
-- | ``` purescript
-- | f <$> Just x == Just (f x)
-- | ```
-- |
-- | `Nothing` values are left untouched:
-- |
-- | ``` purescript
-- | f <$> Nothing == Nothing
-- | ```
instance functorMaybe :: Functor Maybe where
  map fn (Just x) = Just (fn x)
  map _  _        = Nothing

-- | The `Apply` instance allows functions contained within a `Just` to
-- | transform a value contained within a `Just` using the `apply` operator:
-- |
-- | ``` purescript
-- | Just f <*> Just x == Just (f x)
-- | ```
-- |
-- | `Nothing` values are left untouched:
-- |
-- | ``` purescript
-- | Just f <*> Nothing == Nothing
-- | Nothing <*> Just x == Nothing
-- | ```
-- |
-- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` can be used transform a
-- | pure function to take `Maybe`-typed arguments so `f :: a -> b -> c`
-- | becomes `f :: Maybe a -> Maybe b -> Maybe c`:
-- |
-- | ``` purescript
-- | f <$> Just x <*> Just y == Just (f x y)
-- | ```
-- |
-- | The `Nothing`-preserving behaviour of both operators means the result of
-- | an expression like the above but where any one of the values is `Nothing`
-- | means the whole result becomes `Nothing` also:
-- |
-- | ``` purescript
-- | f <$> Nothing <*> Just y == Nothing
-- | f <$> Just x <*> Nothing == Nothing
-- | f <$> Nothing <*> Nothing == Nothing
-- | ```
instance applyMaybe :: Apply Maybe where
  apply (Just fn) x = fn <$> x
  apply Nothing   _ = Nothing

-- | The `Applicative` instance enables lifting of values into `Maybe` with the
-- | `pure` or `return` function (`return` is an alias for `pure`):
-- |
-- | ``` purescript
-- | pure x :: Maybe _ == Just x
-- | return x :: Maybe _ == Just x
-- | ```
-- |
-- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` and `Applicative`'s
-- | `pure` can be used to pass a mixture of `Maybe` and non-`Maybe` typed
-- | values to a function that does not usually expect them, by using `pure`
-- | for any value that is not already `Maybe` typed:
-- |
-- | ``` purescript
-- | f <$> Just x <*> pure y == Just (f x y)
-- | ```
-- |
-- | Even though `pure = Just` it is recommended to use `pure` in situations
-- | like this as it allows the choice of `Applicative` to be changed later
-- | without having to go through and replace `Just` with a new constructor.
instance applicativeMaybe :: Applicative Maybe where
  pure = Just

-- | The `Alt` instance allows for a choice to be made between two `Maybe`
-- | values with the `<|>` operator, where the first `Just` encountered
-- | is taken.
-- |
-- | ``` purescript
-- | Just x <|> Just y == Just x
-- | Nothing <|> Just y == Just y
-- | Nothing <|> Nothing == Nothing
-- | ```
instance altMaybe :: Alt Maybe where
  alt Nothing r = r
  alt l       _ = l

-- | The `Plus` instance provides a default `Maybe` value:
-- |
-- | ``` purescript
-- | empty :: Maybe _ == Nothing
-- | ```
instance plusMaybe :: Plus Maybe where
  empty = Nothing

-- | The `Alternative` instance guarantees that there are both `Applicative` and
-- | `Plus` instances for `Maybe`.
instance alternativeMaybe :: Alternative Maybe

-- | The `Bind` instance allows sequencing of `Maybe` values and functions that
-- | return a `Maybe` by using the `>>=` operator:
-- |
-- | ``` purescript
-- | Just x >>= f = f x
-- | Nothing >>= f = Nothing
-- | ```
instance bindMaybe :: Bind Maybe where
  bind (Just x) k = k x
  bind Nothing  _ = Nothing

-- | The `Monad` instance guarantees that there are both `Applicative` and
-- | `Bind` instances for `Maybe`. This also enables the `do` syntactic sugar:
-- |
-- | ``` purescript
-- | do
-- |   x' <- x
-- |   y' <- y
-- |   pure (f x' y')
-- | ```
-- |
-- | Which is equivalent to:
-- |
-- | ``` purescript
-- | x >>= (\x' -> y >>= (\y' -> pure (f x' y')))
-- | ```
instance monadMaybe :: Monad Maybe

-- | The `MonadPlus` instance guarantees that there are both `Monad` and
-- | `Alternative` instances for `Maybe`.
instance monadPlusMaybe :: MonadPlus Maybe

-- | The `Extend` instance allows sequencing of `Maybe` values and functions
-- | that accept a `Maybe a` and return a non-`Maybe` result using the
-- | `<<=` operator.
-- |
-- | ``` purescript
-- | f <<= Nothing = Nothing
-- | f <<= Just x = Just (f x)
-- | ```
instance extendMaybe :: Extend Maybe where
  extend _ Nothing  = Nothing
  extend f x        = Just (f x)

instance invariantMaybe :: Invariant Maybe where
  imap = imapF

-- | The `Semigroup` instance enables use of the operator `<>` on `Maybe` values
-- | whenever there is a `Semigroup` instance for the type the `Maybe` contains.
-- | The exact behaviour of `<>` depends on the "inner" `Semigroup` instance,
-- | but generally captures the notion of appending or combining things.
-- |
-- | ``` purescript
-- | Just x <> Just y = Just (x <> y)
-- | Just x <> Nothing = Just x
-- | Nothing <> Just y = Just y
-- | Nothing <> Nothing = Nothing
-- | ```
instance semigroupMaybe :: (Semigroup a) => Semigroup (Maybe a) where
  append x y = append <$> x <*> y

instance monoidMaybe :: (Semigroup a) => Monoid (Maybe a) where
  mempty = Nothing

instance semiringMaybe :: (Semiring a) => Semiring (Maybe a) where
  add x y = add <$> x <*> y
  one = Just one
  mul x y = mul <$> x <*> y
  zero = Just zero

instance moduloSemiringMaybe :: (ModuloSemiring a) => ModuloSemiring (Maybe a) where
  mod x y = mod <$> x <*> y
  div x y = div <$> x <*> y

instance ringMaybe :: (Ring a) => Ring (Maybe a) where
  sub x y = sub <$> x <*> y

instance divisionRingMaybe :: (DivisionRing a) => DivisionRing (Maybe a)

instance numMaybe :: (Num a) => Num (Maybe a)

-- | The `Eq` instance allows `Maybe` values to be checked for equality with
-- | `==` and inequality with `/=` whenever there is an `Eq` instance for the
-- | type the `Maybe` contains.
instance eqMaybe :: (Eq a) => Eq (Maybe a) where
  eq Nothing   Nothing   = true
  eq (Just a1) (Just a2) = a1 == a2
  eq _         _         = false

-- | The `Ord` instance allows `Maybe` values to be compared with
-- | `compare`, `>`, `>=`, `<` and `<=` whenever there is an `Ord` instance for
-- | the type the `Maybe` contains.
-- |
-- | `Nothing` is considered to be less than any `Just` value.
instance ordMaybe :: (Ord a) => Ord (Maybe a) where
  compare (Just x) (Just y) = compare x y
  compare Nothing  Nothing  = EQ
  compare Nothing  _        = LT
  compare _        Nothing  = GT

instance boundedMaybe :: (Bounded a) => Bounded (Maybe a) where
  top = Just top
  bottom = Nothing

instance boundedOrdMaybe :: (BoundedOrd a) => BoundedOrd (Maybe a)

instance booleanAlgebraMaybe :: (BooleanAlgebra a) => BooleanAlgebra (Maybe a) where
  conj x y = conj <$> x <*> y
  disj x y = disj <$> x <*> y
  not = map not

-- | The `Show` instance allows `Maybe` values to be rendered as a string with
-- | `show` whenever there is an `Show` instance for the type the `Maybe`
-- | contains.
instance showMaybe :: (Show a) => Show (Maybe a) where
  show (Just x) = "Just (" ++ show x ++ ")"
  show Nothing  = "Nothing"

module Data.Maybe where

import Prelude

import Control.Alt (Alt)
import Control.Alternative (Alternative)
import Control.Extend (Extend)
import Control.MonadPlus (MonadPlus)
import Control.Plus (Plus)
import Data.Functor.Invariant (Invariant, imapF)
import Data.Monoid (Monoid)

-- | The `Maybe` type is used to represent optional values and can be seen as
-- | something like a type-safe `null`, where `Nothing` is `null` and `Just x`
-- | is the non-null value `x`.
data Maybe a = Nothing | Just a

-- | Takes a default value, a function, and a `Maybe` value. If the `Maybe`
-- | value is `Nothing` the default value is returned, otherwise the function
-- | is applied to the value inside the `Just` and the result is returned.
-- |
-- | ``` purescript
-- | maybe x f Nothing == x
-- | maybe x f (Just y) == f y
-- | ```
maybe :: forall a b. b -> (a -> b) -> Maybe a -> b
maybe b _ Nothing = b
maybe _ f (Just a) = f a

-- | Takes a default value, and a `Maybe` value. If the `Maybe` value is
-- | `Nothing` the default value is returned, otherwise the value inside the
-- | `Just` is returned.
-- |
-- | ``` purescript
-- | fromMaybe x Nothing == x
-- | fromMaybe x (Just y) == y
-- | ```
fromMaybe :: forall a. a -> Maybe a -> a
fromMaybe a = maybe a (id :: forall a. a -> a)

-- | Returns `true` when the `Maybe` value was constructed with `Just`.
isJust :: forall a. Maybe a -> Boolean
isJust = maybe false (const true)

-- | Returns `true` when the `Maybe` value is `Nothing`.
isNothing :: forall a. Maybe a -> Boolean
isNothing = maybe true (const false)

-- | The `Functor` instance allows functions to transform the contents of a
-- | `Just` with the `<$>` operator:
-- |
-- | ``` purescript
-- | f <$> Just x == Just (f x)
-- | ```
-- |
-- | `Nothing` values are left untouched:
-- |
-- | ``` purescript
-- | f <$> Nothing == Nothing
-- | ```
instance functorMaybe :: Functor Maybe where
  map fn (Just x) = Just (fn x)
  map _  _        = Nothing

-- | The `Apply` instance allows functions contained within a `Just` to
-- | transform a value contained within a `Just` using the `apply` operator:
-- |
-- | ``` purescript
-- | Just f <*> Just x == Just (f x)
-- | ```
-- |
-- | `Nothing` values are left untouched:
-- |
-- | ``` purescript
-- | Just f <*> Nothing == Nothing
-- | Nothing <*> Just x == Nothing
-- | ```
-- |
-- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` can be used transform a
-- | pure function to take `Maybe`-typed arguments so `f :: a -> b -> c`
-- | becomes `f :: Maybe a -> Maybe b -> Maybe c`:
-- |
-- | ``` purescript
-- | f <$> Just x <*> Just y == Just (f x y)
-- | ```
-- |
-- | The `Nothing`-preserving behaviour of both operators means the result of
-- | an expression like the above but where any one of the values is `Nothing`
-- | means the whole result becomes `Nothing` also:
-- |
-- | ``` purescript
-- | f <$> Nothing <*> Just y == Nothing
-- | f <$> Just x <*> Nothing == Nothing
-- | f <$> Nothing <*> Nothing == Nothing
-- | ```
instance applyMaybe :: Apply Maybe where
  apply (Just fn) x = fn <$> x
  apply Nothing   _ = Nothing

-- | The `Applicative` instance enables lifting of values into `Maybe` with the
-- | `pure` or `return` function (`return` is an alias for `pure`):
-- |
-- | ``` purescript
-- | pure x :: Maybe _ == Just x
-- | return x :: Maybe _ == Just x
-- | ```
-- |
-- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` and `Applicative`'s
-- | `pure` can be used to pass a mixture of `Maybe` and non-`Maybe` typed
-- | values to a function that does not usually expect them, by using `pure`
-- | for any value that is not already `Maybe` typed:
-- |
-- | ``` purescript
-- | f <$> Just x <*> pure y == Just (f x y)
-- | ```
-- |
-- | Even though `pure = Just` it is recommended to use `pure` in situations
-- | like this as it allows the choice of `Applicative` to be changed later
-- | without having to go through and replace `Just` with a new constructor.
instance applicativeMaybe :: Applicative Maybe where
  pure = Just

-- | The `Alt` instance allows for a choice to be made between two `Maybe`
-- | values with the `<|>` operator, where the first `Just` encountered
-- | is taken.
-- |
-- | ``` purescript
-- | Just x <|> Just y == Just x
-- | Nothing <|> Just y == Just y
-- | Nothing <|> Nothing == Nothing
-- | ```
instance altMaybe :: Alt Maybe where
  alt Nothing r = r
  alt l       _ = l

-- | The `Plus` instance provides a default `Maybe` value:
-- |
-- | ``` purescript
-- | empty :: Maybe _ == Nothing
-- | ```
instance plusMaybe :: Plus Maybe where
  empty = Nothing

-- | The `Alternative` instance guarantees that there are both `Applicative` and
-- | `Plus` instances for `Maybe`.
instance alternativeMaybe :: Alternative Maybe

-- | The `Bind` instance allows sequencing of `Maybe` values and functions that
-- | return a `Maybe` by using the `>>=` operator:
-- |
-- | ``` purescript
-- | Just x >>= f = f x
-- | Nothing >>= f = Nothing
-- | ```
instance bindMaybe :: Bind Maybe where
  bind (Just x) k = k x
  bind Nothing  _ = Nothing

-- | The `Monad` instance guarantees that there are both `Applicative` and
-- | `Bind` instances for `Maybe`. This also enables the `do` syntactic sugar:
-- |
-- | ``` purescript
-- | do
-- |   x' <- x
-- |   y' <- y
-- |   pure (f x' y')
-- | ```
-- |
-- | Which is equivalent to:
-- |
-- | ``` purescript
-- | x >>= (\x' -> y >>= (\y' -> pure (f x' y')))
-- | ```
instance monadMaybe :: Monad Maybe

-- | The `MonadPlus` instance guarantees that there are both `Monad` and
-- | `Alternative` instances for `Maybe`.
instance monadPlusMaybe :: MonadPlus Maybe

-- | The `Extend` instance allows sequencing of `Maybe` values and functions
-- | that accept a `Maybe a` and return a non-`Maybe` result using the
-- | `<<=` operator.
-- |
-- | ``` purescript
-- | f <<= Nothing = Nothing
-- | f <<= Just x = Just (f x)
-- | ```
instance extendMaybe :: Extend Maybe where
  extend _ Nothing  = Nothing
  extend f x        = Just (f x)

instance invariantFirst :: Invariant Maybe where
  imap = imapF

-- | The `Semigroup` instance enables use of the operator `<>` on `Maybe` values
-- | whenever there is a `Semigroup` instance for the type the `Maybe` contains.
-- | The exact behaviour of `<>` depends on the "inner" `Semigroup` instance,
-- | but generally captures the notion of appending or combining things.
-- |
-- | ``` purescript
-- | Just x <> Just y = Just (x <> y)
-- | Just x <> Nothing = Just x
-- | Nothing <> Just y = Just y
-- | Nothing <> Nothing = Nothing
-- | ```
instance semigroupMaybe :: (Semigroup a) => Semigroup (Maybe a) where
  append x y = append <$> x <*> y

instance monoidMaybe :: (Semigroup a) => Monoid (Maybe a) where
  mempty = Nothing

instance semiringMaybe :: (Semiring a) => Semiring (Maybe a) where
  add x y = add <$> x <*> y
  one = Just one
  mul x y = mul <$> x <*> y
  zero = Just zero

instance moduloSemiringMaybe :: (ModuloSemiring a) => ModuloSemiring (Maybe a) where
  mod x y = mod <$> x <*> y
  div x y = div <$> x <*> y

instance ringMaybe :: (Ring a) => Ring (Maybe a) where
  sub x y = sub <$> x <*> y

instance divisionRingMaybe :: (DivisionRing a) => DivisionRing (Maybe a)

instance numMaybe :: (Num a) => Num (Maybe a)

-- | The `Eq` instance allows `Maybe` values to be checked for equality with
-- | `==` and inequality with `/=` whenever there is an `Eq` instance for the
-- | type the `Maybe` contains.
instance eqMaybe :: (Eq a) => Eq (Maybe a) where
  eq Nothing   Nothing   = true
  eq (Just a1) (Just a2) = a1 == a2
  eq _         _         = false

-- | The `Ord` instance allows `Maybe` values to be compared with
-- | `compare`, `>`, `>=`, `<` and `<=` whenever there is an `Ord` instance for
-- | the type the `Maybe` contains.
-- |
-- | `Nothing` is considered to be less than any `Just` value.
instance ordMaybe :: (Ord a) => Ord (Maybe a) where
  compare (Just x) (Just y) = compare x y
  compare Nothing  Nothing  = EQ
  compare Nothing  _        = LT
  compare _        Nothing  = GT

instance boundedMaybe :: (Bounded a) => Bounded (Maybe a) where
  top = Just top
  bottom = Nothing

instance boundedOrdMaybe :: (BoundedOrd a) => BoundedOrd (Maybe a)

instance booleanAlgebraMaybe :: (BooleanAlgebra a) => BooleanAlgebra (Maybe a) where
  conj x y = conj <$> x <*> y
  disj x y = disj <$> x <*> y
  not = map not

-- | The `Show` instance allows `Maybe` values to be rendered as a string with
-- | `show` whenever there is an `Show` instance for the type the `Maybe`
-- | contains.
instance showMaybe :: (Show a) => Show (Maybe a) where
  show (Just x) = "Just (" ++ show x ++ ")"
  show Nothing  = "Nothing"


Some very basic styles

Some very basic styles

module App.Gauge where

import Prelude
import Data.Maybe
import Data.Array
import Data.Boolean
import Data.Map as Map
import CSS (border, marginLeft)
import CSS.Geometry (margin, marginRight)
import Control.Bind ((=<<))
import DOM.Node.Document (doctype)
import Data.Semigroup ((<>))
import Pux.CSS (width)
import Pux.Html.Attributes (z)

import Data.Map (Map)
import Data.Monoid (class Monoid, mempty)
import Data.Tuple (Tuple(..))

import CSS.Display
import CSS.Color
import CSS.Background
import CSS.Border
import CSS.Size
import CSS.Geometry
import CSS (borderRadius, padding)
--import Pux.CSS (class Background)
import Pux.Html.Attributes (style)
import Pux.Html.Events (onClick)
import Pux.CSS as PSS
import Pux.Html as H
import App.StatsTypes

data Action = UpdateStats LBStats | ChangeView ViewType

data ViewType = PerNode | PerBroker | PerNodeAndBroker | Aggregate

type State =
    { viewType:: ViewType
    , stats:: LBStats }

derive instance viewTypeEq :: Eq ViewType

instance viewTypeShow :: Show ViewType where
  show PerNode = "Per Node"
  show PerBroker = "Per Broker"
  show PerNodeAndBroker = "Per Node And Broker"
  show Aggregate = "Aggregate"

init :: State
init = { viewType : PerBroker, stats : [] }

update :: Action -> State -> State
update (UpdateStats us) s = s {stats = us}
update (ChangeView vt) s = s {viewType = vt}

view:: State -> H.Html Action
view {viewType,stats} =
    H.div [ centerStyle ]
        [ H.h2 [] [ numConnectionsView stats ]
        , selectView viewType
        , H.div [ statsDisplayStyle ]
                [ stats # viewAs viewType ]
        ]

numConnectionsView :: (Array NodeStats) -> H.Html Action
numConnectionsView stats =
    H.text $ "Total Connections: " <> (show $ stats # numConnections)

viewHealthyNodeAs :: ({ node :: Host, brokers:: Array BrokerStats} -> H.Html Action) -> NodeStats -> H.Html Action
viewHealthyNodeAs _ (BadNode node) = viewBadNode node
viewHealthyNodeAs f (NodeStats a) = f a

viewAs :: ViewType -> (Array NodeStats) -> H.Html Action
viewAs PerNode s =
    H.div [] (viewNodeStats <$> s)

viewAs PerBroker nodes =
    let
        statsPerBroker = nodes # concatMap _brokers
                           >>> map (\{broker, stats} -> Tuple broker stats)
                           >>> Map.fromFoldableWith  (<>)
                           >>> Map.toAscUnfoldable
    in
    H.div []
    (statsPerBroker # map \(Tuple broker agg) ->
         H.div []
            [ H.h2  [] [H.text $ show broker]
            , viewBStats agg ]
    )

viewAs PerNodeAndBroker nodes =
    H.div [] $
    viewNodeAndBrokerStats <$> nodes

viewAs Aggregate nodes =
    let agg = numConnections nodes in
    H.div []
        [
            H.h2  [] [H.text "Aggregate Stats"]
          , viewBStats agg
        ]

viewNodeStats :: NodeStats -> H.Html Action
viewNodeStats (NodeStats {node,brokers}) =
    let agg = brokers # map _.stats >>> fold in
    H.div []
        [
            H.h2  [] [H.text $ show node]
          , viewBStats agg
        ]

viewNodeStats (BadNode node) =
   viewBadNode node

viewNodeAndBrokerStats :: NodeStats -> H.Html Action
viewNodeAndBrokerStats (NodeStats {node,brokers}) =
    H.div [] $
        brokers # map \brokerStats ->
            H.div []
                [ H.h2  []
                        [ H.text $
                          "Node: " <> show node <>
                          " Broker: " <> show brokerStats.broker ]
                , viewBStats brokerStats.stats
                ]

viewNodeAndBrokerStats (BadNode node) =
         viewBadNode node

viewBadNode :: forall a b. (Show b) => b -> H.Html a
viewBadNode node =
     H.div []
        [ H.h2  [] [H.text $ show node]
        , H.h3  [style alertStyle] [H.text "Node Down"]
        ]

viewBStats :: BStats -> H.Html Action
viewBStats stats =
    H.div []
        [ H.h3 [] [H.text "Connections:"]
          , H.p  [] [H.text $ show stats]
        ]

selectView :: ViewType -> H.Html Action
selectView viewType =
    H.div [ PSS.style do
                    marginLeft (40.0 # px)
                    marginBottom (0.0 # px) ] $
     optionView viewType <$> availableViews

optionView :: ViewType -> ViewType -> H.Html Action
optionView sel v =
    H.div
         (if v == sel
            then selectedOptionStyle
            else  [ onClick $ const (ChangeView v) ]
                  <> nonSelectedOptionStyle
         )
        [H.text $ show v]

alertStyle :: Array (Tuple String String)
alertStyle =
    [Tuple "color" "red"]

availableViews :: Array ViewType
availableViews =
   [PerNode, PerBroker, PerNodeAndBroker, Aggregate]

numConnections :: Array NodeStats -> BStats
numConnections =
    concatMap _brokers
    >>> map _.stats
    >>> fold

areNodeStatsOnline :: NodeStats -> Boolean
areNodeStatsOnline (NodeStats _) = true
areNodeStatsOnline (BadNode _) = false

----------------------------------------------------------------------------
--- STYLES
--- TODO: Move to separate module
----------------------------------------------------------------------------

nonSelectedOptionStyle :: forall a. Array (H.Attribute a)
nonSelectedOptionStyle =
    [ z "99"
    , PSS.style do
        optionViewStyle
        background  (rgb 20 20 250)
    ]

selectedOptionStyle :: forall a. Array (H.Attribute a)
selectedOptionStyle =
    [ z "1"
    , PSS.style do
        optionViewStyle
        marginLeft (-10.0 # px)
        marginRight (-10.0 # px)
        background  (rgb 150 150 200 )
    ]

--selectViewStyle :: forall a. H.Attribute a
optionViewStyle :: PSS.StyleM Unit
optionViewStyle  = do
    float floatLeft
    padding (10.0 # px) (25.0 # px) (5.0 # px) (25.0 # px)
    border solid (1.0 # px) (rgb 0xff 0xff 0xff)
    borderRadius (15.0 # px) (15.0 # px) (0.0 # px) (0.0 # px)
    PSS.color (rgb 250 250 250)

centerStyle :: forall a. H.Attribute a
centerStyle =
          PSS.style do
            width (90.0 # pct)
            margin (40.0 # px) (40.0 # px) (40.0 # px) (40.0 # px)

statsDisplayStyle :: forall a. H.Attribute a
statsDisplayStyle =
    PSS.style do
        clear clearBoth
        minHeight (400.0 # px)
        border solid (2.0 # px) (rgb 0x00 0x00 0xff)
        margin (0.0 # px) (10.0 # px) (10.0 # px) (10.0 # px)
        marginTop (0.0 # px)
        padding (10.0 # px)  (10.0 # px) (10.0 # px) (10.0 # px)

module App.Gauge where

import Prelude
import Data.Maybe
import Data.Array
import Data.Boolean
import Data.Map as Map
import CSS (padding)
import Control.Bind ((=<<))

import Data.Map (Map)
import Data.Monoid (class Monoid, mempty)
import Data.Tuple (Tuple(..))

import CSS.Display
import CSS.Color
import CSS.Background
import CSS.Size
--import Pux.CSS (class Background)
import Pux.Html.Attributes (style)
import Pux.Html.Events (onClick)
import Pux.CSS as PSS
import Pux.Html as H
import App.StatsTypes

data Action = UpdateStats LBStats | ChangeView ViewType

data ViewType = PerNode | PerBroker | PerNodeAndBroker | Aggregate

type State =
    { viewType:: ViewType
    , stats:: LBStats }

derive instance viewTypeEq :: Eq ViewType

instance viewTypeShow :: Show ViewType where
  show PerNode = "Per Node"
  show PerBroker = "Per Broker"
  show PerNodeAndBroker = "Per Node And Broker"
  show Aggregate = "Aggregate"

init :: State
init = { viewType : PerBroker, stats : [] }

update :: Action -> State -> State
update (UpdateStats us) s = s {stats = us}
update (ChangeView vt) s = s {viewType = vt}

view:: State -> H.Html Action
view {viewType,stats} =
    H.div []
        [ H.h1 [] [numConnectionsView stats]
        , selectView viewType
        , stats # viewAs viewType ]

numConnectionsView :: (Array NodeStats) -> H.Html Action
numConnectionsView stats =
    H.text $ stats # numConnections >>> show

viewHealthyNodeAs :: ({ node :: Host, brokers:: Array BrokerStats} -> H.Html Action) -> NodeStats -> H.Html Action
viewHealthyNodeAs _ (BadNode node) = viewBadNode node
viewHealthyNodeAs f (NodeStats a) = f a

viewAs :: ViewType -> (Array NodeStats) -> H.Html Action
viewAs PerNode s =
    H.div [] (viewNodeStats <$> s)

viewAs PerBroker nodes =
    let
        statsPerBroker = nodes # concatMap _brokers
                           >>> map (\{broker, stats} -> Tuple broker stats)
                           >>> Map.fromFoldableWith  (<>)
                           >>> Map.toAscUnfoldable
    in
    H.div []
    (statsPerBroker # map \(Tuple broker agg) ->
         H.div []
            [ H.h1  [] [H.text $ show broker]
            , viewBStats agg]
    )

viewAs PerNodeAndBroker nodes =
    H.div [] $
    viewNodeAndBrokerStats <$> nodes

viewAs Aggregate nodes =
    let agg = numConnections nodes in
    H.div []
        [ H.h1  [] [H.text "Aggregate Stats"]
        , viewBStats agg]

viewNodeStats :: NodeStats -> H.Html Action
viewNodeStats (NodeStats {node,brokers}) =
    let agg = brokers # map _.stats >>> fold in
    H.div []
        [ H.h1  [] [H.text $ show node]
        , viewBStats agg ]

viewNodeStats (BadNode node) =
   viewBadNode node

viewNodeAndBrokerStats :: NodeStats -> H.Html Action
viewNodeAndBrokerStats (NodeStats {node,brokers}) =
    H.div [] $
        brokers # map \brokerStats ->
            H.div []
                    [ H.h1  [] [H.text $ "Node: " <> show node <> " Broker: " <> show brokerStats.broker]
                    , viewBStats brokerStats.stats]

viewNodeAndBrokerStats (BadNode node) =
         viewBadNode node

viewBadNode :: forall a b. (Show b) => b -> H.Html a
viewBadNode node =
     H.div []
        [ H.h1  [] [H.text $ show node]
        , H.h2  [style alertStyle] [H.text "Node Down"] ]

viewBStats :: BStats -> H.Html Action
viewBStats stats =
    H.div []
        [ H.h2 [] [H.text "Connections:"]
        , H.p  [] [H.text $ show stats] ]

selectView :: ViewType -> H.Html Action
selectView viewType =
    H.ul [ selectViewStyle ] $
     optionView viewType <$> availableViews

optionView :: ViewType -> ViewType -> H.Html Action
optionView sel v =
    H.li
        (if v == sel then [selectedStyle] else [onClick $ const (ChangeView v)])
        [H.text $ show v]

--selectedStyle :: Array (Tuple String String)
selectedStyle :: forall a. H.Attribute a
selectedStyle =
    PSS.style do
    PSS.background (rgb 10 100 200)
    PSS.color (rgb 255 255 255)

alertStyle :: Array (Tuple String String)
alertStyle =
    [Tuple "color" "red"]

availableViews :: Array ViewType
availableViews =
   [PerNode, PerBroker, PerNodeAndBroker, Aggregate]

numConnections :: Array NodeStats -> BStats
numConnections =
    concatMap _brokers
    >>> map _.stats
    >>> fold

areNodeStatsOnline :: NodeStats -> Boolean
areNodeStatsOnline (NodeStats _) = true
areNodeStatsOnline (BadNode _) = false

selectViewStyle :: forall a. H.Attribute a
selectViewStyle  =
    PSS.style do
        padding (15.0 # px) (15.0 # px) (15.0 # px) (15.0 # px)
        float floatLeft
        background  (rgb 200 240 250)
        PSS.color (rgb 10 100 200)


Update FFI call to use .value

Update FFI call to use .value

module Prelude
  ( flip
  , const
  , asTypeOf
  , Semigroupoid, (<<<), (>>>)
  , Category, id
  , ($), (#)
  , (:), cons
  , Show, show
  , Functor, (<$>), void
  , Apply, (<*>)
  , Applicative, pure, liftA1
  , Alternative, empty, (<|>)
  , Bind, (>>=)
  , Monad, return, liftM1, ap
  , Num, (+), (-), (*), (/), (%)
  , negate
  , Eq, (==), (/=), refEq, refIneq
  , Ord, Ordering(..), compare, (<), (>), (<=), (>=)
  , Bits, (&), (|), (^), shl, shr, zshr, complement
  , BoolLike, (&&), (||)
  , not
  , Semigroup, (<>), (++)
  , Unit(..), unit
  ) where

  flip :: forall a b c. (a -> b -> c) -> b -> a -> c
  flip f b a = f a b

  const :: forall a b. a -> b -> a
  const a _ = a

  asTypeOf :: forall a. a -> a -> a
  asTypeOf x _ = x

  infixr 9 >>>
  infixr 9 <<<

  class Semigroupoid a where
    (<<<) :: forall b c d. a c d -> a b c -> a b d

  instance semigroupoidArr :: Semigroupoid (->) where
    (<<<) f g x = f (g x)

  (>>>) :: forall a b c d. (Semigroupoid a) => a b c -> a c d -> a b d
  (>>>) f g = g <<< f

  class (Semigroupoid a) <= Category a where
    id :: forall t. a t t

  instance categoryArr :: Category (->) where
    id x = x

  infixr 0 $
  infixl 0 #

  ($) :: forall a b. (a -> b) -> a -> b
  ($) f x = f x

  (#) :: forall a b. a -> (a -> b) -> b
  (#) x f = f x

  infixr 6 :

  (:) :: forall a. a -> [a] -> [a]
  (:) = cons

  foreign import cons
    "function cons(e) {\
    \  return function (l) {\
    \    return [e].concat(l);\
    \  };\
    \}" :: forall a. a -> [a] -> [a]

  class Show a where
    show :: a -> String

  foreign import showStringImpl
    "function showStringImpl(s) {\
    \  return JSON.stringify(s);\
    \}" :: String -> String

  instance showUnit :: Show Unit where
    show (Unit {}) = "Unit {}"

  instance showString :: Show String where
    show = showStringImpl

  instance showBoolean :: Show Boolean where
    show true = "true"
    show false = "false"

  foreign import showNumberImpl "function showNumberImpl(n) {\
                                \  return n.toString();\
                                \}" :: Number -> String

  instance showNumber :: Show Number where
    show = showNumberImpl

  foreign import showArrayImpl
    "function showArrayImpl (f) {\
    \  return function (xs) {\
    \    var ss = [];\
    \    for (var i = 0, l = xs.length; i < l; i++) {\
    \      ss[i] = f(xs[i]);\
    \    }\
    \    return '[' + ss.join(',') + ']';\
    \  };\
    \}" :: forall a. (a -> String) -> [a] -> String

  instance showArray :: (Show a) => Show [a] where
    show = showArrayImpl show

  infixl 4 <$>

  class Functor f where
    (<$>) :: forall a b. (a -> b) -> f a -> f b

  void :: forall f a. (Functor f) => f a -> f Unit
  void fa = const unit <$> fa

  infixl 4 <*>

  class (Functor f) <= Apply f where
    (<*>) :: forall a b. f (a -> b) -> f a -> f b

  class (Apply f) <= Applicative f where
    pure :: forall a. a -> f a

  liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b
  liftA1 f a = pure f <*> a

  infixl 3 <|>

  class Alternative f where
    empty :: forall a. f a
    (<|>) :: forall a. f a -> f a -> f a

  infixl 1 >>=

  class (Apply m) <= Bind m where
    (>>=) :: forall a b. m a -> (a -> m b) -> m b

  class (Applicative m, Bind m) <= Monad m

  return :: forall m a. (Monad m) => a -> m a
  return = pure

  liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b
  liftM1 f a = do
    a' <- a
    return (f a')

  ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b
  ap f a = do
    f' <- f
    a' <- a
    return (f' a')

  instance functorArr :: Functor ((->) r) where
    (<$>) = (<<<)

  instance applyArr :: Apply ((->) r) where
    (<*>) f g x = f x (g x)

  instance applicativeArr :: Applicative ((->) r) where
    pure = const

  instance bindArr :: Bind ((->) r) where
    (>>=) m f x = f (m x) x

  instance monadArr :: Monad ((->) r)

  infixl 7 *
  infixl 7 /
  infixl 7 %

  infixl 6 -
  infixl 6 +

  class Num a where
    (+) :: a -> a -> a
    (-) :: a -> a -> a
    (*) :: a -> a -> a
    (/) :: a -> a -> a
    (%) :: a -> a -> a
    negate :: a -> a

  foreign import numAdd "function numAdd(n1) {\
                        \  return function(n2) {\
                        \    return n1 + n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numSub "function numSub(n1) {\
                        \  return function(n2) {\
                        \    return n1 - n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numMul "function numMul(n1) {\
                        \  return function(n2) {\
                        \    return n1 * n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numDiv "function numDiv(n1) {\
                        \  return function(n2) {\
                        \    return n1 / n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numMod "function numMod(n1) {\
                        \  return function(n2) {\
                        \    return n1 % n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numNegate "function numNegate(n) {\
                           \  return -n;\
                           \}" :: Number -> Number

  instance numNumber :: Num Number where
    (+) = numAdd
    (-) = numSub
    (*) = numMul
    (/) = numDiv
    (%) = numMod
    negate = numNegate

  data Unit = Unit {}

  unit :: Unit
  unit = Unit {}

  infix 4 ==
  infix 4 /=

  class Eq a where
    (==) :: a -> a -> Boolean
    (/=) :: a -> a -> Boolean

  foreign import refEq
    "function refEq(r1) {\
    \  return function(r2) {\
    \    return r1 === r2;\
    \  };\
    \}" :: forall a. a -> a -> Boolean

  foreign import refIneq
    "function refIneq(r1) {\
    \  return function(r2) {\
    \    return r1 !== r2;\
    \  };\
    \}" :: forall a. a -> a -> Boolean

  instance eqUnit :: Eq Unit where
    (==) (Unit {}) (Unit {}) = true
    (/=) (Unit {}) (Unit {}) = false

  instance eqString :: Eq String where
    (==) = refEq
    (/=) = refIneq

  instance eqNumber :: Eq Number where
    (==) = refEq
    (/=) = refIneq

  instance eqBoolean :: Eq Boolean where
    (==) = refEq
    (/=) = refIneq

  foreign import eqArrayImpl
    "function eqArrayImpl(f) {\
    \  return function(xs) {\
    \    return function(ys) {\
    \      if (xs.length !== ys.length) return false;\
    \      for (var i = 0; i < xs.length; i++) {\
    \        if (!f(xs[i])(ys[i])) return false;\
    \      }\
    \      return true;\
    \    };\
    \  };\
    \}" :: forall a. (a -> a -> Boolean) -> [a] -> [a] -> Boolean

  instance eqArray :: (Eq a) => Eq [a] where
    (==) xs ys = eqArrayImpl (==) xs ys
    (/=) xs ys = not (xs == ys)

  data Ordering = LT | GT | EQ

  instance eqOrdering :: Eq Ordering where
    (==) LT LT = true
    (==) GT GT = true
    (==) EQ EQ = true
    (==) _  _  = false
    (/=) x y = not (x == y)

  instance showOrdering :: Show Ordering where
    show LT = "LT"
    show GT = "GT"
    show EQ = "EQ"

  class (Eq a) <= Ord a where
    compare :: a -> a -> Ordering

  infixl 4 <

  (<) :: forall a. (Ord a) => a -> a -> Boolean
  (<) a1 a2 = case a1 `compare` a2 of
    LT -> true
    _ -> false

  infixl 4 >

  (>) :: forall a. (Ord a) => a -> a -> Boolean
  (>) a1 a2 = case a1 `compare` a2 of
    GT -> true
    _ -> false

  infixl 4 <=

  (<=) :: forall a. (Ord a) => a -> a -> Boolean
  (<=) a1 a2 = case a1 `compare` a2 of
    GT -> false
    _ -> true

  infixl 4 >=

  (>=) :: forall a. (Ord a) => a -> a -> Boolean
  (>=) a1 a2 = case a1 `compare` a2 of
    LT -> false
    _ -> true

  foreign import unsafeCompare
    "function unsafeCompare(n1) {\
    \  return function(n2) {\
    \    return n1 < n2 ? LT.value : n1 > n2 ? GT.value : EQ.value;\
    \  };\
    \}" :: forall a. a -> a -> Ordering

  instance ordUnit :: Ord Unit where
    compare (Unit {}) (Unit {}) = EQ

  instance ordBoolean :: Ord Boolean where
    compare false false = EQ
    compare false true  = LT
    compare true  true  = EQ
    compare true  false = GT

  instance ordNumber :: Ord Number where
    compare = unsafeCompare

  instance ordString :: Ord String where
    compare = unsafeCompare

  instance ordArray :: (Ord a) => Ord [a] where
    compare [] [] = EQ
    compare [] _ = LT
    compare _ [] = GT
    compare (x:xs) (y:ys) = case compare x y of
      EQ -> compare xs ys
      other -> other

  infixl 10 &
  infixl 10 |
  infixl 10 ^

  class Bits b where
    (&) :: b -> b -> b
    (|) :: b -> b -> b
    (^) :: b -> b -> b
    shl :: b -> Number -> b
    shr :: b -> Number -> b
    zshr :: b -> Number -> b
    complement :: b -> b

  foreign import numShl "function numShl(n1) {\
                        \  return function(n2) {\
                        \    return n1 << n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numShr "function numShr(n1) {\
                        \  return function(n2) {\
                        \    return n1 >> n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numZshr "function numZshr(n1) {\
                          \  return function(n2) {\
                          \    return n1 >>> n2;\
                          \  };\
                          \}" :: Number -> Number -> Number

  foreign import numAnd "function numAnd(n1) {\
                        \  return function(n2) {\
                        \    return n1 & n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numOr "function numOr(n1) {\
                       \  return function(n2) {\
                       \    return n1 | n2;\
                       \  };\
                       \}" :: Number -> Number -> Number

  foreign import numXor "function numXor(n1) {\
                        \  return function(n2) {\
                        \    return n1 ^ n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numComplement "function numComplement(n) {\
                               \  return ~n;\
                               \}" :: Number -> Number

  instance bitsNumber :: Bits Number where
    (&) = numAnd
    (|) = numOr
    (^) = numXor
    shl = numShl
    shr = numShr
    zshr = numZshr
    complement = numComplement

  infixr 2 ||
  infixr 3 &&

  class BoolLike b where
    (&&) :: b -> b -> b
    (||) :: b -> b -> b
    not :: b -> b

  foreign import boolAnd "function boolAnd(b1) {\
                         \  return function(b2) {\
                         \    return b1 && b2;\
                         \  };\
                         \}"  :: Boolean -> Boolean -> Boolean

  foreign import boolOr "function boolOr(b1) {\
                        \  return function(b2) {\
                        \    return b1 || b2;\
                        \  };\
                        \}" :: Boolean -> Boolean -> Boolean

  foreign import boolNot "function boolNot(b) {\
                         \  return !b;\
                         \}" :: Boolean -> Boolean

  instance boolLikeBoolean :: BoolLike Boolean where
    (&&) = boolAnd
    (||) = boolOr
    not = boolNot

  infixr 5 <>

  class Semigroup a where
    (<>) :: a -> a -> a

  foreign import concatString
    "function concatString(s1) {\
    \  return function(s2) {\
    \    return s1 + s2;\
    \  };\
    \}" :: String -> String -> String

  instance semigroupUnit :: Semigroup Unit where
    (<>) (Unit {}) (Unit {}) = Unit {}

  instance semigroupString :: Semigroup String where
    (<>) = concatString

  instance semigroupArr :: (Semigroup s') => Semigroup (s -> s') where
    (<>) f g = \x -> f x <> g x

  infixr 5 ++

  (++) :: forall s. (Semigroup s) => s -> s -> s
  (++) = (<>)

module Data.Function where

  on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c
  on f g x y = g x `f` g y

  foreign import data Fn0 :: * -> *
  foreign import data Fn1 :: * -> * -> *
  foreign import data Fn2 :: * -> * -> * -> *
  foreign import data Fn3 :: * -> * -> * -> * -> *
  foreign import data Fn4 :: * -> * -> * -> * -> * -> *
  foreign import data Fn5 :: * -> * -> * -> * -> * -> * -> *

  foreign import mkFn0
    "function mkFn0(f) {\
    \  return function() {\
    \    return f({});\
    \  };\
    \}" :: forall a. (Unit -> a) -> Fn0 a

  foreign import mkFn1
    "function mkFn1(f) {\
    \  return function(a) {\
    \    return f(a);\
    \  };\
    \}" :: forall a b. (a -> b) -> Fn1 a b

  foreign import mkFn2
    "function mkFn2(f) {\
    \  return function(a, b) {\
    \    return f(a)(b);\
    \  };\
    \}" :: forall a b c. (a -> b -> c) -> Fn2 a b c

  foreign import mkFn3
    "function mkFn3(f) {\
    \  return function(a, b, c) {\
    \    return f(a)(b)(c);\
    \  };\
    \}" :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d

  foreign import mkFn4
    "function mkFn4(f) {\
    \  return function(a, b, c, d) {\
    \    return f(a)(b)(c)(d);\
    \  };\
    \}" :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e

  foreign import mkFn5
    "function mkFn5(f) {\
    \  return function(a, b, c, d, e) {\
    \    return f(a)(b)(c)(d)(e);\
    \  };\
    \}" :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f

  foreign import runFn0
    "function runFn0(f) {\
    \  return f();\
    \}" :: forall a. Fn0 a -> a

  foreign import runFn1
    "function runFn1(f) {\
    \  return function(a) {\
    \    return f(a);\
    \  };\
    \}" :: forall a b. Fn1 a b -> a -> b

  foreign import runFn2
    "function runFn2(f) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return f(a, b);\
    \    };\
    \  };\
    \}" :: forall a b c. Fn2 a b c -> a -> b -> c

  foreign import runFn3
    "function runFn3(f) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return f(a, b, c);\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d

  foreign import runFn4
    "function runFn4(f) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return f(a, b, c, d);\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e

  foreign import runFn5
    "function runFn5(f) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return f(a, b, c, d, e);\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f

module Data.Eq where

  data Ref a = Ref a

  liftRef :: forall a b. (a -> a -> b) -> Ref a -> Ref a -> b
  liftRef f (Ref x) (Ref y) = f x y

  instance eqRef :: Eq (Ref a) where
    (==) = liftRef refEq
    (/=) = liftRef refIneq

  instance functorRef :: Functor Ref where
    (<$>) f (Ref x) = Ref (f x)

module Prelude.Unsafe where

  foreign import unsafeIndex
    "function unsafeIndex(xs) {\
    \  return function(n) {\
    \    return xs[n];\
    \  };\
    \}" :: forall a. [a] -> Number -> a

module Control.Monad.Eff where

  foreign import data Eff :: # ! -> * -> *

  foreign import returnE "function returnE(a) {\
                         \  return function() {\
                         \    return a;\
                         \  };\
                         \}" :: forall e a. a -> Eff e a

  foreign import bindE "function bindE(a) {\
                       \  return function(f) {\
                       \    return function() {\
                       \      return f(a())();\
                       \    };\
                       \  };\
                       \}" :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b

  type Pure a = forall e. Eff e a

  foreign import runPure "function runPure(f) {\
                         \  return f();\
                         \}" :: forall a. Pure a -> a

  instance functorEff :: Functor (Eff e) where
    (<$>) = liftA1

  instance applyEff :: Apply (Eff e) where
    (<*>) = ap

  instance applicativeEff :: Applicative (Eff e) where
    pure = returnE

  instance bindEff :: Bind (Eff e) where
    (>>=) = bindE

  instance monadEff :: Monad (Eff e)

  foreign import untilE "function untilE(f) {\
                        \  return function() {\
                        \    while (!f()) { }\
                        \    return {};\
                        \  };\
                        \}" :: forall e. Eff e Boolean -> Eff e Unit

  foreign import whileE "function whileE(f) {\
                        \  return function(a) {\
                        \    return function() {\
                        \      while (f()) {\
                        \        a();\
                        \      }\
                        \      return {};\
                        \    };\
                        \  };\
                        \}" :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit

  foreign import forE "function forE(lo) {\
                      \  return function(hi) {\
                      \    return function(f) {\
                      \      return function() {\
                      \        for (var i = lo; i < hi; i++) {\
                      \          f(i)();\
                      \        }\
                      \      };\
                      \    };\
                      \  };\
                      \}" :: forall e. Number -> Number -> (Number -> Eff e Unit) -> Eff e Unit

  foreign import foreachE "function foreachE(as) {\
                          \  return function(f) {\
                          \    return function() {\
                          \      for (var i = 0; i < as.length; i++) {\
                          \        f(as[i])();\
                          \      }\
                          \    };\
                          \  };\
                          \}" :: forall e a. [a] -> (a -> Eff e Unit) -> Eff e Unit

module Control.Monad.Eff.Unsafe where

  import Control.Monad.Eff

  foreign import unsafeInterleaveEff
    "function unsafeInterleaveEff(f) {\
    \  return f;\
    \}" :: forall eff1 eff2 a. Eff eff1 a -> Eff eff2 a

module Debug.Trace where

  import Control.Monad.Eff

  foreign import data Trace :: !

  foreign import trace "function trace(s) {\
                       \  return function() {\
                       \    console.log(s);\
                       \    return {};\
                       \  };\
                       \}" :: forall r. String -> Eff (trace :: Trace | r) Unit

  print :: forall a r. (Show a) => a -> Eff (trace :: Trace | r) Unit
  print o = trace (show o)

module Control.Monad.ST where

  import Control.Monad.Eff

  foreign import data ST :: * -> !

  foreign import data STRef :: * -> * -> *

  foreign import data STArray :: * -> * -> *

  foreign import newSTRef "function newSTRef(val) {\
                          \  return function () {\
                          \    return { value: val };\
                          \  };\
                          \}" :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)

  foreign import readSTRef "function readSTRef(ref) {\
                           \  return function() {\
                           \    return ref.value;\
                           \  };\
                           \}" :: forall a h r. STRef h a -> Eff (st :: ST h | r) a

  foreign import modifySTRef "function modifySTRef(ref) {\
                             \  return function(f) {\
                             \    return function() {\
                             \      return ref.value = f(ref.value);\
                             \    };\
                             \  };\
                             \}" :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a

  foreign import writeSTRef "function writeSTRef(ref) {\
                            \  return function(a) {\
                            \    return function() {\
                            \      return ref.value = a;\
                            \    };\
                            \  };\
                            \}" :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a

  foreign import newSTArray "function newSTArray(len) {\
                            \  return function(a) {\
                            \    return function() {\
                            \      var arr = [];\
                            \      for (var i = 0; i < len; i++) {\
                            \        arr[i] = a;\
                            \      };\
                            \      return arr;\
                            \    };\
                            \  };\
                            \}" :: forall a h r. Number -> a -> Eff (st :: ST h | r) (STArray h a)

  foreign import peekSTArray "function peekSTArray(arr) {\
                             \  return function(i) {\
                             \    return function() {\
                             \      return arr[i];\
                             \    };\
                             \  };\
                             \}" :: forall a h r. STArray h a -> Eff (st :: ST h | r) a

  foreign import pokeSTArray "function pokeSTArray(arr) {\
                             \  return function(i) {\
                             \    return function(a) {\
                             \      return function() {\
                             \        return arr[i] = a;\
                             \      };\
                             \    };\
                             \  };\
                             \}" :: forall a h r. STArray h a -> Number -> a -> Eff (st :: ST h | r) a

  foreign import runST "function runST(f) {\
                       \  return f;\
                       \}" :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a

  foreign import runSTArray "function runSTArray(f) {\
                            \  return f;\
                            \}" :: forall a r. (forall h. Eff (st :: ST h | r) (STArray h a)) -> Eff r [a]

module Prelude
  ( flip
  , const
  , asTypeOf
  , Semigroupoid, (<<<), (>>>)
  , Category, id
  , ($), (#)
  , (:), cons
  , Show, show
  , Functor, (<$>), void
  , Apply, (<*>)
  , Applicative, pure, liftA1
  , Alternative, empty, (<|>)
  , Bind, (>>=)
  , Monad, return, liftM1, ap
  , Num, (+), (-), (*), (/), (%)
  , negate
  , Eq, (==), (/=), refEq, refIneq
  , Ord, Ordering(..), compare, (<), (>), (<=), (>=)
  , Bits, (&), (|), (^), shl, shr, zshr, complement
  , BoolLike, (&&), (||)
  , not
  , Semigroup, (<>), (++)
  , Unit(..), unit
  ) where

  flip :: forall a b c. (a -> b -> c) -> b -> a -> c
  flip f b a = f a b

  const :: forall a b. a -> b -> a
  const a _ = a

  asTypeOf :: forall a. a -> a -> a
  asTypeOf x _ = x

  infixr 9 >>>
  infixr 9 <<<

  class Semigroupoid a where
    (<<<) :: forall b c d. a c d -> a b c -> a b d

  instance semigroupoidArr :: Semigroupoid (->) where
    (<<<) f g x = f (g x)

  (>>>) :: forall a b c d. (Semigroupoid a) => a b c -> a c d -> a b d
  (>>>) f g = g <<< f

  class (Semigroupoid a) <= Category a where
    id :: forall t. a t t

  instance categoryArr :: Category (->) where
    id x = x

  infixr 0 $
  infixl 0 #

  ($) :: forall a b. (a -> b) -> a -> b
  ($) f x = f x

  (#) :: forall a b. a -> (a -> b) -> b
  (#) x f = f x

  infixr 6 :

  (:) :: forall a. a -> [a] -> [a]
  (:) = cons

  foreign import cons
    "function cons(e) {\
    \  return function (l) {\
    \    return [e].concat(l);\
    \  };\
    \}" :: forall a. a -> [a] -> [a]

  class Show a where
    show :: a -> String

  foreign import showStringImpl
    "function showStringImpl(s) {\
    \  return JSON.stringify(s);\
    \}" :: String -> String

  instance showUnit :: Show Unit where
    show (Unit {}) = "Unit {}"

  instance showString :: Show String where
    show = showStringImpl

  instance showBoolean :: Show Boolean where
    show true = "true"
    show false = "false"

  foreign import showNumberImpl "function showNumberImpl(n) {\
                                \  return n.toString();\
                                \}" :: Number -> String

  instance showNumber :: Show Number where
    show = showNumberImpl

  foreign import showArrayImpl
    "function showArrayImpl (f) {\
    \  return function (xs) {\
    \    var ss = [];\
    \    for (var i = 0, l = xs.length; i < l; i++) {\
    \      ss[i] = f(xs[i]);\
    \    }\
    \    return '[' + ss.join(',') + ']';\
    \  };\
    \}" :: forall a. (a -> String) -> [a] -> String

  instance showArray :: (Show a) => Show [a] where
    show = showArrayImpl show

  infixl 4 <$>

  class Functor f where
    (<$>) :: forall a b. (a -> b) -> f a -> f b

  void :: forall f a. (Functor f) => f a -> f Unit
  void fa = const unit <$> fa

  infixl 4 <*>

  class (Functor f) <= Apply f where
    (<*>) :: forall a b. f (a -> b) -> f a -> f b

  class (Apply f) <= Applicative f where
    pure :: forall a. a -> f a

  liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b
  liftA1 f a = pure f <*> a

  infixl 3 <|>

  class Alternative f where
    empty :: forall a. f a
    (<|>) :: forall a. f a -> f a -> f a

  infixl 1 >>=

  class (Apply m) <= Bind m where
    (>>=) :: forall a b. m a -> (a -> m b) -> m b

  class (Applicative m, Bind m) <= Monad m

  return :: forall m a. (Monad m) => a -> m a
  return = pure

  liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b
  liftM1 f a = do
    a' <- a
    return (f a')

  ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b
  ap f a = do
    f' <- f
    a' <- a
    return (f' a')

  instance functorArr :: Functor ((->) r) where
    (<$>) = (<<<)

  instance applyArr :: Apply ((->) r) where
    (<*>) f g x = f x (g x)

  instance applicativeArr :: Applicative ((->) r) where
    pure = const

  instance bindArr :: Bind ((->) r) where
    (>>=) m f x = f (m x) x

  instance monadArr :: Monad ((->) r)

  infixl 7 *
  infixl 7 /
  infixl 7 %

  infixl 6 -
  infixl 6 +

  class Num a where
    (+) :: a -> a -> a
    (-) :: a -> a -> a
    (*) :: a -> a -> a
    (/) :: a -> a -> a
    (%) :: a -> a -> a
    negate :: a -> a

  foreign import numAdd "function numAdd(n1) {\
                        \  return function(n2) {\
                        \    return n1 + n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numSub "function numSub(n1) {\
                        \  return function(n2) {\
                        \    return n1 - n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numMul "function numMul(n1) {\
                        \  return function(n2) {\
                        \    return n1 * n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numDiv "function numDiv(n1) {\
                        \  return function(n2) {\
                        \    return n1 / n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numMod "function numMod(n1) {\
                        \  return function(n2) {\
                        \    return n1 % n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numNegate "function numNegate(n) {\
                           \  return -n;\
                           \}" :: Number -> Number

  instance numNumber :: Num Number where
    (+) = numAdd
    (-) = numSub
    (*) = numMul
    (/) = numDiv
    (%) = numMod
    negate = numNegate

  data Unit = Unit {}

  unit :: Unit
  unit = Unit {}

  infix 4 ==
  infix 4 /=

  class Eq a where
    (==) :: a -> a -> Boolean
    (/=) :: a -> a -> Boolean

  foreign import refEq
    "function refEq(r1) {\
    \  return function(r2) {\
    \    return r1 === r2;\
    \  };\
    \}" :: forall a. a -> a -> Boolean

  foreign import refIneq
    "function refIneq(r1) {\
    \  return function(r2) {\
    \    return r1 !== r2;\
    \  };\
    \}" :: forall a. a -> a -> Boolean

  instance eqUnit :: Eq Unit where
    (==) (Unit {}) (Unit {}) = true
    (/=) (Unit {}) (Unit {}) = false

  instance eqString :: Eq String where
    (==) = refEq
    (/=) = refIneq

  instance eqNumber :: Eq Number where
    (==) = refEq
    (/=) = refIneq

  instance eqBoolean :: Eq Boolean where
    (==) = refEq
    (/=) = refIneq

  foreign import eqArrayImpl
    "function eqArrayImpl(f) {\
    \  return function(xs) {\
    \    return function(ys) {\
    \      if (xs.length !== ys.length) return false;\
    \      for (var i = 0; i < xs.length; i++) {\
    \        if (!f(xs[i])(ys[i])) return false;\
    \      }\
    \      return true;\
    \    };\
    \  };\
    \}" :: forall a. (a -> a -> Boolean) -> [a] -> [a] -> Boolean

  instance eqArray :: (Eq a) => Eq [a] where
    (==) xs ys = eqArrayImpl (==) xs ys
    (/=) xs ys = not (xs == ys)

  data Ordering = LT | GT | EQ

  instance eqOrdering :: Eq Ordering where
    (==) LT LT = true
    (==) GT GT = true
    (==) EQ EQ = true
    (==) _  _  = false
    (/=) x y = not (x == y)

  instance showOrdering :: Show Ordering where
    show LT = "LT"
    show GT = "GT"
    show EQ = "EQ"

  class (Eq a) <= Ord a where
    compare :: a -> a -> Ordering

  infixl 4 <

  (<) :: forall a. (Ord a) => a -> a -> Boolean
  (<) a1 a2 = case a1 `compare` a2 of
    LT -> true
    _ -> false

  infixl 4 >

  (>) :: forall a. (Ord a) => a -> a -> Boolean
  (>) a1 a2 = case a1 `compare` a2 of
    GT -> true
    _ -> false

  infixl 4 <=

  (<=) :: forall a. (Ord a) => a -> a -> Boolean
  (<=) a1 a2 = case a1 `compare` a2 of
    GT -> false
    _ -> true

  infixl 4 >=

  (>=) :: forall a. (Ord a) => a -> a -> Boolean
  (>=) a1 a2 = case a1 `compare` a2 of
    LT -> false
    _ -> true

  foreign import unsafeCompare
    "function unsafeCompare(n1) {\
    \  return function(n2) {\
    \    return n1 < n2 ? LT : n1 > n2 ? GT : EQ;\
    \  };\
    \}" :: forall a. a -> a -> Ordering

  instance ordUnit :: Ord Unit where
    compare (Unit {}) (Unit {}) = EQ

  instance ordBoolean :: Ord Boolean where
    compare false false = EQ
    compare false true  = LT
    compare true  true  = EQ
    compare true  false = GT

  instance ordNumber :: Ord Number where
    compare = unsafeCompare

  instance ordString :: Ord String where
    compare = unsafeCompare

  instance ordArray :: (Ord a) => Ord [a] where
    compare [] [] = EQ
    compare [] _ = LT
    compare _ [] = GT
    compare (x:xs) (y:ys) = case compare x y of
      EQ -> compare xs ys
      other -> other

  infixl 10 &
  infixl 10 |
  infixl 10 ^

  class Bits b where
    (&) :: b -> b -> b
    (|) :: b -> b -> b
    (^) :: b -> b -> b
    shl :: b -> Number -> b
    shr :: b -> Number -> b
    zshr :: b -> Number -> b
    complement :: b -> b

  foreign import numShl "function numShl(n1) {\
                        \  return function(n2) {\
                        \    return n1 << n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numShr "function numShr(n1) {\
                        \  return function(n2) {\
                        \    return n1 >> n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numZshr "function numZshr(n1) {\
                          \  return function(n2) {\
                          \    return n1 >>> n2;\
                          \  };\
                          \}" :: Number -> Number -> Number

  foreign import numAnd "function numAnd(n1) {\
                        \  return function(n2) {\
                        \    return n1 & n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numOr "function numOr(n1) {\
                       \  return function(n2) {\
                       \    return n1 | n2;\
                       \  };\
                       \}" :: Number -> Number -> Number

  foreign import numXor "function numXor(n1) {\
                        \  return function(n2) {\
                        \    return n1 ^ n2;\
                        \  };\
                        \}" :: Number -> Number -> Number

  foreign import numComplement "function numComplement(n) {\
                               \  return ~n;\
                               \}" :: Number -> Number

  instance bitsNumber :: Bits Number where
    (&) = numAnd
    (|) = numOr
    (^) = numXor
    shl = numShl
    shr = numShr
    zshr = numZshr
    complement = numComplement

  infixr 2 ||
  infixr 3 &&

  class BoolLike b where
    (&&) :: b -> b -> b
    (||) :: b -> b -> b
    not :: b -> b

  foreign import boolAnd "function boolAnd(b1) {\
                         \  return function(b2) {\
                         \    return b1 && b2;\
                         \  };\
                         \}"  :: Boolean -> Boolean -> Boolean

  foreign import boolOr "function boolOr(b1) {\
                        \  return function(b2) {\
                        \    return b1 || b2;\
                        \  };\
                        \}" :: Boolean -> Boolean -> Boolean

  foreign import boolNot "function boolNot(b) {\
                         \  return !b;\
                         \}" :: Boolean -> Boolean

  instance boolLikeBoolean :: BoolLike Boolean where
    (&&) = boolAnd
    (||) = boolOr
    not = boolNot

  infixr 5 <>

  class Semigroup a where
    (<>) :: a -> a -> a

  foreign import concatString
    "function concatString(s1) {\
    \  return function(s2) {\
    \    return s1 + s2;\
    \  };\
    \}" :: String -> String -> String

  instance semigroupUnit :: Semigroup Unit where
    (<>) (Unit {}) (Unit {}) = Unit {}

  instance semigroupString :: Semigroup String where
    (<>) = concatString

  instance semigroupArr :: (Semigroup s') => Semigroup (s -> s') where
    (<>) f g = \x -> f x <> g x

  infixr 5 ++

  (++) :: forall s. (Semigroup s) => s -> s -> s
  (++) = (<>)

module Data.Function where

  on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c
  on f g x y = g x `f` g y

  foreign import data Fn0 :: * -> *
  foreign import data Fn1 :: * -> * -> *
  foreign import data Fn2 :: * -> * -> * -> *
  foreign import data Fn3 :: * -> * -> * -> * -> *
  foreign import data Fn4 :: * -> * -> * -> * -> * -> *
  foreign import data Fn5 :: * -> * -> * -> * -> * -> * -> *

  foreign import mkFn0
    "function mkFn0(f) {\
    \  return function() {\
    \    return f({});\
    \  };\
    \}" :: forall a. (Unit -> a) -> Fn0 a

  foreign import mkFn1
    "function mkFn1(f) {\
    \  return function(a) {\
    \    return f(a);\
    \  };\
    \}" :: forall a b. (a -> b) -> Fn1 a b

  foreign import mkFn2
    "function mkFn2(f) {\
    \  return function(a, b) {\
    \    return f(a)(b);\
    \  };\
    \}" :: forall a b c. (a -> b -> c) -> Fn2 a b c

  foreign import mkFn3
    "function mkFn3(f) {\
    \  return function(a, b, c) {\
    \    return f(a)(b)(c);\
    \  };\
    \}" :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d

  foreign import mkFn4
    "function mkFn4(f) {\
    \  return function(a, b, c, d) {\
    \    return f(a)(b)(c)(d);\
    \  };\
    \}" :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e

  foreign import mkFn5
    "function mkFn5(f) {\
    \  return function(a, b, c, d, e) {\
    \    return f(a)(b)(c)(d)(e);\
    \  };\
    \}" :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f

  foreign import runFn0
    "function runFn0(f) {\
    \  return f();\
    \}" :: forall a. Fn0 a -> a

  foreign import runFn1
    "function runFn1(f) {\
    \  return function(a) {\
    \    return f(a);\
    \  };\
    \}" :: forall a b. Fn1 a b -> a -> b

  foreign import runFn2
    "function runFn2(f) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return f(a, b);\
    \    };\
    \  };\
    \}" :: forall a b c. Fn2 a b c -> a -> b -> c

  foreign import runFn3
    "function runFn3(f) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return f(a, b, c);\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d

  foreign import runFn4
    "function runFn4(f) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return f(a, b, c, d);\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e

  foreign import runFn5
    "function runFn5(f) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return f(a, b, c, d, e);\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f

module Data.Eq where

  data Ref a = Ref a

  liftRef :: forall a b. (a -> a -> b) -> Ref a -> Ref a -> b
  liftRef f (Ref x) (Ref y) = f x y

  instance eqRef :: Eq (Ref a) where
    (==) = liftRef refEq
    (/=) = liftRef refIneq

  instance functorRef :: Functor Ref where
    (<$>) f (Ref x) = Ref (f x)

module Prelude.Unsafe where

  foreign import unsafeIndex
    "function unsafeIndex(xs) {\
    \  return function(n) {\
    \    return xs[n];\
    \  };\
    \}" :: forall a. [a] -> Number -> a

module Control.Monad.Eff where

  foreign import data Eff :: # ! -> * -> *

  foreign import returnE "function returnE(a) {\
                         \  return function() {\
                         \    return a;\
                         \  };\
                         \}" :: forall e a. a -> Eff e a

  foreign import bindE "function bindE(a) {\
                       \  return function(f) {\
                       \    return function() {\
                       \      return f(a())();\
                       \    };\
                       \  };\
                       \}" :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b

  type Pure a = forall e. Eff e a

  foreign import runPure "function runPure(f) {\
                         \  return f();\
                         \}" :: forall a. Pure a -> a

  instance functorEff :: Functor (Eff e) where
    (<$>) = liftA1

  instance applyEff :: Apply (Eff e) where
    (<*>) = ap

  instance applicativeEff :: Applicative (Eff e) where
    pure = returnE

  instance bindEff :: Bind (Eff e) where
    (>>=) = bindE

  instance monadEff :: Monad (Eff e)

  foreign import untilE "function untilE(f) {\
                        \  return function() {\
                        \    while (!f()) { }\
                        \    return {};\
                        \  };\
                        \}" :: forall e. Eff e Boolean -> Eff e Unit

  foreign import whileE "function whileE(f) {\
                        \  return function(a) {\
                        \    return function() {\
                        \      while (f()) {\
                        \        a();\
                        \      }\
                        \      return {};\
                        \    };\
                        \  };\
                        \}" :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit

  foreign import forE "function forE(lo) {\
                      \  return function(hi) {\
                      \    return function(f) {\
                      \      return function() {\
                      \        for (var i = lo; i < hi; i++) {\
                      \          f(i)();\
                      \        }\
                      \      };\
                      \    };\
                      \  };\
                      \}" :: forall e. Number -> Number -> (Number -> Eff e Unit) -> Eff e Unit

  foreign import foreachE "function foreachE(as) {\
                          \  return function(f) {\
                          \    return function() {\
                          \      for (var i = 0; i < as.length; i++) {\
                          \        f(as[i])();\
                          \      }\
                          \    };\
                          \  };\
                          \}" :: forall e a. [a] -> (a -> Eff e Unit) -> Eff e Unit

module Control.Monad.Eff.Unsafe where

  import Control.Monad.Eff

  foreign import unsafeInterleaveEff
    "function unsafeInterleaveEff(f) {\
    \  return f;\
    \}" :: forall eff1 eff2 a. Eff eff1 a -> Eff eff2 a

module Debug.Trace where

  import Control.Monad.Eff

  foreign import data Trace :: !

  foreign import trace "function trace(s) {\
                       \  return function() {\
                       \    console.log(s);\
                       \    return {};\
                       \  };\
                       \}" :: forall r. String -> Eff (trace :: Trace | r) Unit

  print :: forall a r. (Show a) => a -> Eff (trace :: Trace | r) Unit
  print o = trace (show o)

module Control.Monad.ST where

  import Control.Monad.Eff

  foreign import data ST :: * -> !

  foreign import data STRef :: * -> * -> *

  foreign import data STArray :: * -> * -> *

  foreign import newSTRef "function newSTRef(val) {\
                          \  return function () {\
                          \    return { value: val };\
                          \  };\
                          \}" :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)

  foreign import readSTRef "function readSTRef(ref) {\
                           \  return function() {\
                           \    return ref.value;\
                           \  };\
                           \}" :: forall a h r. STRef h a -> Eff (st :: ST h | r) a

  foreign import modifySTRef "function modifySTRef(ref) {\
                             \  return function(f) {\
                             \    return function() {\
                             \      return ref.value = f(ref.value);\
                             \    };\
                             \  };\
                             \}" :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a

  foreign import writeSTRef "function writeSTRef(ref) {\
                            \  return function(a) {\
                            \    return function() {\
                            \      return ref.value = a;\
                            \    };\
                            \  };\
                            \}" :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a

  foreign import newSTArray "function newSTArray(len) {\
                            \  return function(a) {\
                            \    return function() {\
                            \      var arr = [];\
                            \      for (var i = 0; i < len; i++) {\
                            \        arr[i] = a;\
                            \      };\
                            \      return arr;\
                            \    };\
                            \  };\
                            \}" :: forall a h r. Number -> a -> Eff (st :: ST h | r) (STArray h a)

  foreign import peekSTArray "function peekSTArray(arr) {\
                             \  return function(i) {\
                             \    return function() {\
                             \      return arr[i];\
                             \    };\
                             \  };\
                             \}" :: forall a h r. STArray h a -> Eff (st :: ST h | r) a

  foreign import pokeSTArray "function pokeSTArray(arr) {\
                             \  return function(i) {\
                             \    return function(a) {\
                             \      return function() {\
                             \        return arr[i] = a;\
                             \      };\
                             \    };\
                             \  };\
                             \}" :: forall a h r. STArray h a -> Number -> a -> Eff (st :: ST h | r) a

  foreign import runST "function runST(f) {\
                       \  return f;\
                       \}" :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a

  foreign import runSTArray "function runSTArray(f) {\
                            \  return f;\
                            \}" :: forall a r. (forall h. Eff (st :: ST h | r) (STArray h a)) -> Eff r [a]