Cleanup JS function style in prelude.

Cleanup JS function style in prelude.

module Prelude
  ( flip
  , const
  , asTypeOf
  , Semigroupoid, (<<<), (>>>)
  , Category, id
  , ($), (#)
  , (:), cons
  , Show, show
  , Functor, (<$>), void
  , Apply, (<*>)
  , Applicative, pure, liftA1
  , 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 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

  newtype 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 unsafeCompareImpl
    "function unsafeCompareImpl(lt) {\
    \  return function(eq) {\
    \    return function(gt) {\
    \      return function(x) {\
    \        return function(y) {\
    \          return x < y ? lt : x > y ? gt : eq;\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering

  unsafeCompare :: forall a. a -> a -> Ordering
  unsafeCompare = unsafeCompareImpl LT EQ GT

  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 data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *

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

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

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

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

  foreign import mkFn4
    "function mkFn4(fn) {\
    \  return function(a, b, c, d) {\
    \    return fn(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(fn) {\
    \  return function(a, b, c, d, e) {\
    \    return fn(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 mkFn6
    "function mkFn6(fn) {\
    \  return function(a, b, c, d, e, f) {\
    \    return fn(a)(b)(c)(d)(e)(f);\
    \  };\
    \}" :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g

  foreign import mkFn7
    "function mkFn7(fn) {\
    \  return function(a, b, c, d, e, f, g) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g);\
    \  };\
    \}" :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h

  foreign import mkFn8
    "function mkFn8(fn) {\
    \  return function(a, b, c, d, e, f, g, h) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g)(h);\
    \  };\
    \}" :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i

  foreign import mkFn9
    "function mkFn9(fn) {\
    \  return function(a, b, c, d, e, f, g, h, i) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);\
    \  };\
    \}" :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j

  foreign import mkFn10
    "function mkFn10(fn) {\
    \  return function(a, b, c, d, e, f, g, h, i, j) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);\
    \  };\
    \}" :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k

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

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

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

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

  foreign import runFn4
    "function runFn4(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return fn(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(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return fn(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

  foreign import runFn6
    "function runFn6(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return fn(a, b, c, d, e, f);\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g

  foreign import runFn7
    "function runFn7(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return fn(a, b, c, d, e, f, g);\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h

  foreign import runFn8
    "function runFn8(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return function(h) {\
    \                  return fn(a, b, c, d, e, f, g, h);\
    \                };\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i

  foreign import runFn9
    "function runFn9(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return function(h) {\
    \                  return function(i) {\
    \                    return fn(a, b, c, d, e, f, g, h, i);\
    \                  };\
    \                };\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j

  foreign import runFn10
    "function runFn10(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return function(h) {\
    \                  return function(i) {\
    \                    return function(j) {\
    \                      return fn(a, b, c, d, e, f, g, h, i, j);\
    \                    };\
    \                  };\
    \                };\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k

module Data.Eq where

  newtype 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 -> Number -> 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
  , 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 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

  newtype 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 unsafeCompareImpl
    "function unsafeCompareImpl(lt) {\
    \  return function (eq) {\
    \    return function (gt) {\
    \      return function (x) {\
    \        return function (y) {\
    \          return x < y ? lt : x > y ? gt : eq;\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering

  unsafeCompare :: forall a. a -> a -> Ordering
  unsafeCompare = unsafeCompareImpl LT EQ GT

  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 data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
  foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *

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

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

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

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

  foreign import mkFn4
    "function mkFn4(fn) {\
    \  return function(a, b, c, d) {\
    \    return fn(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(fn) {\
    \  return function(a, b, c, d, e) {\
    \    return fn(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 mkFn6
    "function mkFn6(fn) {\
    \  return function(a, b, c, d, e, f) {\
    \    return fn(a)(b)(c)(d)(e)(f);\
    \  };\
    \}" :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g

  foreign import mkFn7
    "function mkFn7(fn) {\
    \  return function(a, b, c, d, e, f, g) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g);\
    \  };\
    \}" :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h

  foreign import mkFn8
    "function mkFn8(fn) {\
    \  return function(a, b, c, d, e, f, g, h) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g)(h);\
    \  };\
    \}" :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i

  foreign import mkFn9
    "function mkFn9(fn) {\
    \  return function(a, b, c, d, e, f, g, h, i) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);\
    \  };\
    \}" :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j

  foreign import mkFn10
    "function mkFn10(fn) {\
    \  return function(a, b, c, d, e, f, g, h, i, j) {\
    \    return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);\
    \  };\
    \}" :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k

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

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

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

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

  foreign import runFn4
    "function runFn4(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return fn(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(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return fn(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

  foreign import runFn6
    "function runFn6(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return fn(a, b, c, d, e, f);\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g

  foreign import runFn7
    "function runFn7(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return fn(a, b, c, d, e, f, g);\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h

  foreign import runFn8
    "function runFn8(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return function(h) {\
    \                  return fn(a, b, c, d, e, f, g, h);\
    \                };\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i

  foreign import runFn9
    "function runFn9(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return function(h) {\
    \                  return function(i) {\
    \                    return fn(a, b, c, d, e, f, g, h, i);\
    \                  };\
    \                };\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j

  foreign import runFn10
    "function runFn10(fn) {\
    \  return function(a) {\
    \    return function(b) {\
    \      return function(c) {\
    \        return function(d) {\
    \          return function(e) {\
    \            return function(f) {\
    \              return function(g) {\
    \                return function(h) {\
    \                  return function(i) {\
    \                    return function(j) {\
    \                      return fn(a, b, c, d, e, f, g, h, i, j);\
    \                    };\
    \                  };\
    \                };\
    \              };\
    \            };\
    \          };\
    \        };\
    \      };\
    \    };\
    \  };\
    \}" :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k

module Data.Eq where

  newtype 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 -> Number -> 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]


Make NodeResponseWriter a newtype

Make NodeResponseWriter a newtype

module Hyper.Node.Server
       ( RequestBody
       , HttpResponse
       , NodeResponseWriter
       , writeString
       , write
       , readBodyAsString
       , defaultOptions
       , runServer
       )where

import Node.HTTP
import Data.HTTP.Method as Method
import Data.Int as Int
import Data.StrMap as StrMap
import Node.Stream as Stream
import Control.Applicative (pure)
import Control.Bind (bind)
import Control.IxMonad (ibind, ipure, (:*>), (:>>=))
import Control.Monad (class Monad, void, (>>=))
import Control.Monad.Aff (launchAff, Aff)
import Control.Monad.Aff.AVar (putVar, takeVar, modifyVar, makeVar', AVAR, makeVar)
import Control.Monad.Aff.Class (class MonadAff)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (class MonadEff, liftEff)
import Control.Monad.Eff.Exception (EXCEPTION, catchException, Error)
import Data.Either (Either)
import Data.Function (($), (<<<))
import Data.Functor ((<$>))
import Data.HTTP.Method (CustomMethod, Method)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype, unwrap)
import Data.Semigroup ((<>))
import Data.StrMap (StrMap)
import Data.Tuple (Tuple(..))
import Data.Unit (Unit, unit)
import Hyper.Conn (Conn)
import Hyper.Middleware (Middleware, evalMiddleware, lift')
import Hyper.Middleware.Class (getConn, modifyConn, putConn)
import Hyper.Port (Port(..))
import Hyper.Response (class Response, class ResponseWriter, ResponseEnded, StatusLineOpen)
import Hyper.Status (Status(..))
import Node.Buffer (BUFFER, Buffer)
import Node.Encoding (Encoding(..))
import Node.Stream (Writable)

newtype RequestBody = RequestBody Request

derive instance newtypeRequestBody :: Newtype RequestBody _

-- A limited version of Writable () e, with which you can only write, not end,
-- the Stream.
newtype NodeResponseWriter e
  = NodeResponseWriter (Writable () e -> Eff e Unit)

writeString :: forall e. Encoding -> String -> NodeResponseWriter e
writeString enc str = NodeResponseWriter (\w -> void (Stream.writeString w enc str (pure unit)))

write :: forall e. Buffer -> NodeResponseWriter (buffer :: BUFFER | e)
write buffer = NodeResponseWriter (\w -> void (Stream.write w buffer (pure unit)))

instance stringNodeResponseWriter :: (MonadAff e m) => Response (NodeResponseWriter e) m String where
  toResponse = ipure <<< writeString UTF8

instance stringAndEncodingNodeResponseWriter :: (MonadAff e m) => Response (NodeResponseWriter e) m (Tuple String Encoding) where
  toResponse (Tuple body encoding) =
    ipure (writeString encoding body)

instance bufferNodeResponseWriter :: Monad m => Response (NodeResponseWriter e) m Buffer where
  toResponse buf =
    ipure (NodeResponseWriter (\stream -> void (Stream.write stream buf (pure unit))))

readBody :: forall e. RequestBody -> Aff (http :: HTTP, err :: EXCEPTION, avar :: AVAR | e) String
readBody body = do
  let stream = requestAsStream (unwrap body)
  completeBody <- makeVar
  chunks <- makeVar' ""
  liftEff do
    Stream.onDataString stream UTF8 \chunk -> void do
      launchAff (modifyVar (_ <> chunk) chunks)
    Stream.onEnd stream $ void (launchAff (takeVar chunks >>= putVar completeBody))
  takeVar completeBody

readBodyAsString ∷ ∀ e req res c.
                   Middleware
                   (Aff (http ∷ HTTP, err :: EXCEPTION, avar :: AVAR | e))
                   (Conn { body ∷ RequestBody
                         , contentLength :: Maybe Int
                         | req
                         } res c)
                   (Conn {body ∷ String, contentLength :: Maybe Int | req} res c)
                   Unit
readBodyAsString = do
  conn ← getConn
  s <- lift' (readBody conn.request.body)
  putConn (conn { request { body = s } })
  where bind = ibind

data HttpResponse state = HttpResponse Response

getWriter ∷ ∀ req res c m rw.
            Monad m ⇒
            Middleware
            m
            (Conn req { writer ∷ rw | res } c)
            (Conn req { writer ∷ rw | res } c)
            rw
getWriter = _.response.writer <$> getConn

setStatus ∷ ∀ req res c m e.
            MonadEff (http ∷ HTTP | e) m
          ⇒ Status
          → Response
          → Middleware m (Conn req res c) (Conn req res c) Unit
setStatus (Status { code, reasonPhrase }) r = liftEff do
  setStatusCode r code
  setStatusMessage r reasonPhrase

writeHeader' ∷ ∀ req res c m e.
               MonadEff (http ∷ HTTP | e) m
             ⇒ (Tuple String String)
             → Response
             → Middleware m (Conn req res c) (Conn req res c) Unit
writeHeader' (Tuple name value) r =
  liftEff $ setHeader r name value

writeResponse ∷ ∀ req res c m e.
                MonadEff (http ∷ HTTP | e) m
             ⇒ Response
             → (Writable () (http :: HTTP | e) -> Eff (http :: HTTP | e) Unit)
             → Middleware m (Conn req res c) (Conn req res c) Unit
writeResponse r f =
  void (liftEff (f (responseAsStream r)))

endResponse ∷ ∀ req res c m e.
              MonadEff (http ∷ HTTP | e) m
            ⇒ Response
            → Middleware m (Conn req res c) (Conn req res c) Unit
endResponse r =
  liftEff (Stream.end (responseAsStream r) (pure unit))

instance responseWriterHttpResponse :: MonadAff (http ∷ HTTP | e) m
                                    => ResponseWriter HttpResponse m (NodeResponseWriter (http :: HTTP | e)) where
  writeStatus status =
    getWriter :>>=
    case _ of
      HttpResponse r → do
        setStatus status r
        :*> modifyConn (_ { response { writer = HttpResponse r }})

  writeHeader header =
    getWriter :>>=
    case _ of
      HttpResponse r →
        writeHeader' header r
        :*> modifyConn (_ { response { writer = HttpResponse r }})

  closeHeaders =
    getWriter :>>=
    case _ of
      HttpResponse r →
        modifyConn (_ { response { writer = HttpResponse r }})

  send (NodeResponseWriter f) =
    getWriter :>>=
    case _ of
      HttpResponse r → do
        writeResponse r f
        :*> modifyConn (_ { response { writer = HttpResponse r }})

  end =
    getWriter :>>=
    case _ of
      HttpResponse r → do
        endResponse r
        :*> modifyConn (_ { response { writer = HttpResponse r }})

type ServerOptions = { hostname ∷ String
                     , port ∷ Port
                     }

defaultOptions ∷ ServerOptions
defaultOptions = { hostname: "0.0.0.0"
                 , port: Port 3000
                 }

runServer :: forall e req res c c'.
             ServerOptions
             -> (Port -> Eff (http ∷ HTTP | e) Unit)
             -> (Error -> Eff (http ∷ HTTP | e) Unit)
             -> c
             -> Middleware
                (Aff (http :: HTTP | e))
                (Conn { url :: String
                      , body :: RequestBody
                      , contentLength :: Maybe Int
                      , headers :: StrMap String
                      , method :: Either Method CustomMethod
                      }
                      { writer :: HttpResponse StatusLineOpen }
                      c)
                (Conn req { writer :: HttpResponse ResponseEnded | res } c')
                Unit
             -> Eff (http :: HTTP | e) Unit
runServer options onListening onRequestError components middleware = do
  server <- createServer onRequest
  let listenOptions = { port: unwrap options.port
                      , hostname: "0.0.0.0"
                      , backlog: Nothing
                      }
  listen server listenOptions (onListening options.port)
  where
    parseContentLength headers = StrMap.lookup "content-length" headers
    onRequest ∷ Request → Response → Eff (http :: HTTP | e) Unit
    onRequest request response =
      let headers = requestHeaders request
          conn = { request: { url: requestURL request
                            , body: RequestBody request
                            , headers: headers
                            , method: Method.fromString (requestMethod request)
                            , contentLength: parseContentLength headers >>= Int.fromString
                            }
                 , response: { writer: HttpResponse response }
                 , components: components
                 }
      in catchException onRequestError (void (launchAff (evalMiddleware middleware conn)))

module Hyper.Node.Server
       ( RequestBody
       , HttpResponse
       , NodeResponseWriter
       , writeString
       , write
       , readBodyAsString
       , defaultOptions
       , runServer
       )where

import Node.HTTP
import Data.HTTP.Method as Method
import Data.Int as Int
import Data.StrMap as StrMap
import Node.Stream as Stream
import Control.Applicative (pure)
import Control.Bind (bind)
import Control.IxMonad (ibind, ipure, (:*>), (:>>=))
import Control.Monad (class Monad, void, (>>=))
import Control.Monad.Aff (launchAff, Aff)
import Control.Monad.Aff.AVar (putVar, takeVar, modifyVar, makeVar', AVAR, makeVar)
import Control.Monad.Aff.Class (class MonadAff)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (class MonadEff, liftEff)
import Control.Monad.Eff.Exception (EXCEPTION, catchException, Error)
import Data.Either (Either)
import Data.Function (($), (<<<))
import Data.Functor ((<$>))
import Data.HTTP.Method (CustomMethod, Method)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype, unwrap)
import Data.Semigroup ((<>))
import Data.StrMap (StrMap)
import Data.Tuple (Tuple(..))
import Data.Unit (Unit, unit)
import Hyper.Conn (Conn)
import Hyper.Middleware (Middleware, evalMiddleware, lift')
import Hyper.Middleware.Class (getConn, modifyConn, putConn)
import Hyper.Port (Port(..))
import Hyper.Response (class Response, class ResponseWriter, ResponseEnded, StatusLineOpen)
import Hyper.Status (Status(..))
import Node.Buffer (BUFFER, Buffer)
import Node.Encoding (Encoding(..))
import Node.Stream (Writable)

newtype RequestBody = RequestBody Request

derive instance newtypeRequestBody :: Newtype RequestBody _

-- A limited version of Writable () e, with which you can only write, not end,
-- the Stream.
data NodeResponseWriter e
  = NodeResponseWriter (Writable () e -> Eff e Unit)

writeString :: forall e. Encoding -> String -> NodeResponseWriter e
writeString enc str = NodeResponseWriter (\w -> void (Stream.writeString w enc str (pure unit)))

write :: forall e. Buffer -> NodeResponseWriter (buffer :: BUFFER | e)
write buffer = NodeResponseWriter (\w -> void (Stream.write w buffer (pure unit)))

instance stringNodeResponseWriter :: (MonadAff e m) => Response (NodeResponseWriter e) m String where
  toResponse = ipure <<< writeString UTF8

instance stringAndEncodingNodeResponseWriter :: (MonadAff e m) => Response (NodeResponseWriter e) m (Tuple String Encoding) where
  toResponse (Tuple body encoding) =
    ipure (writeString encoding body)

instance bufferNodeResponseWriter :: Monad m => Response (NodeResponseWriter e) m Buffer where
  toResponse buf =
    ipure (NodeResponseWriter (\stream -> void (Stream.write stream buf (pure unit))))

readBody :: forall e. RequestBody -> Aff (http :: HTTP, err :: EXCEPTION, avar :: AVAR | e) String
readBody body = do
  let stream = requestAsStream (unwrap body)
  completeBody <- makeVar
  chunks <- makeVar' ""
  liftEff do
    Stream.onDataString stream UTF8 \chunk -> void do
      launchAff (modifyVar (_ <> chunk) chunks)
    Stream.onEnd stream $ void (launchAff (takeVar chunks >>= putVar completeBody))
  takeVar completeBody

readBodyAsString ∷ ∀ e req res c.
                   Middleware
                   (Aff (http ∷ HTTP, err :: EXCEPTION, avar :: AVAR | e))
                   (Conn { body ∷ RequestBody
                         , contentLength :: Maybe Int
                         | req
                         } res c)
                   (Conn {body ∷ String, contentLength :: Maybe Int | req} res c)
                   Unit
readBodyAsString = do
  conn ← getConn
  s <- lift' (readBody conn.request.body)
  putConn (conn { request { body = s } })
  where bind = ibind

data HttpResponse state = HttpResponse Response

getWriter ∷ ∀ req res c m rw.
            Monad m ⇒
            Middleware
            m
            (Conn req { writer ∷ rw | res } c)
            (Conn req { writer ∷ rw | res } c)
            rw
getWriter = _.response.writer <$> getConn

setStatus ∷ ∀ req res c m e.
            MonadEff (http ∷ HTTP | e) m
          ⇒ Status
          → Response
          → Middleware m (Conn req res c) (Conn req res c) Unit
setStatus (Status { code, reasonPhrase }) r = liftEff do
  setStatusCode r code
  setStatusMessage r reasonPhrase

writeHeader' ∷ ∀ req res c m e.
               MonadEff (http ∷ HTTP | e) m
             ⇒ (Tuple String String)
             → Response
             → Middleware m (Conn req res c) (Conn req res c) Unit
writeHeader' (Tuple name value) r =
  liftEff $ setHeader r name value

writeResponse ∷ ∀ req res c m e.
                MonadEff (http ∷ HTTP | e) m
             ⇒ Response
             → (Writable () (http :: HTTP | e) -> Eff (http :: HTTP | e) Unit)
             → Middleware m (Conn req res c) (Conn req res c) Unit
writeResponse r f =
  void (liftEff (f (responseAsStream r)))

endResponse ∷ ∀ req res c m e.
              MonadEff (http ∷ HTTP | e) m
            ⇒ Response
            → Middleware m (Conn req res c) (Conn req res c) Unit
endResponse r =
  liftEff (Stream.end (responseAsStream r) (pure unit))

instance responseWriterHttpResponse :: MonadAff (http ∷ HTTP | e) m
                                    => ResponseWriter HttpResponse m (NodeResponseWriter (http :: HTTP | e)) where
  writeStatus status =
    getWriter :>>=
    case _ of
      HttpResponse r → do
        setStatus status r
        :*> modifyConn (_ { response { writer = HttpResponse r }})

  writeHeader header =
    getWriter :>>=
    case _ of
      HttpResponse r →
        writeHeader' header r
        :*> modifyConn (_ { response { writer = HttpResponse r }})

  closeHeaders =
    getWriter :>>=
    case _ of
      HttpResponse r →
        modifyConn (_ { response { writer = HttpResponse r }})

  send (NodeResponseWriter f) =
    getWriter :>>=
    case _ of
      HttpResponse r → do
        writeResponse r f
        :*> modifyConn (_ { response { writer = HttpResponse r }})

  end =
    getWriter :>>=
    case _ of
      HttpResponse r → do
        endResponse r
        :*> modifyConn (_ { response { writer = HttpResponse r }})

type ServerOptions = { hostname ∷ String
                     , port ∷ Port
                     }

defaultOptions ∷ ServerOptions
defaultOptions = { hostname: "0.0.0.0"
                 , port: Port 3000
                 }

runServer :: forall e req res c c'.
             ServerOptions
             -> (Port -> Eff (http ∷ HTTP | e) Unit)
             -> (Error -> Eff (http ∷ HTTP | e) Unit)
             -> c
             -> Middleware
                (Aff (http :: HTTP | e))
                (Conn { url :: String
                      , body :: RequestBody
                      , contentLength :: Maybe Int
                      , headers :: StrMap String
                      , method :: Either Method CustomMethod
                      }
                      { writer :: HttpResponse StatusLineOpen }
                      c)
                (Conn req { writer :: HttpResponse ResponseEnded | res } c')
                Unit
             -> Eff (http :: HTTP | e) Unit
runServer options onListening onRequestError components middleware = do
  server <- createServer onRequest
  let listenOptions = { port: unwrap options.port
                      , hostname: "0.0.0.0"
                      , backlog: Nothing
                      }
  listen server listenOptions (onListening options.port)
  where
    parseContentLength headers = StrMap.lookup "content-length" headers
    onRequest ∷ Request → Response → Eff (http :: HTTP | e) Unit
    onRequest request response =
      let headers = requestHeaders request
          conn = { request: { url: requestURL request
                            , body: RequestBody request
                            , headers: headers
                            , method: Method.fromString (requestMethod request)
                            , contentLength: parseContentLength headers >>= Int.fromString
                            }
                 , response: { writer: HttpResponse response }
                 , components: components
                 }
      in catchException onRequestError (void (launchAff (evalMiddleware middleware conn)))


Fixed the tests so they pass after 29bd5b1.

module Test.Main where

import Data.Array as A
import Data.Either (Either(..))
import Data.Lens (over)
import Data.Maybe (Maybe(Nothing, Just), fromJust)
import Effect (Effect)
import Partial.Unsafe (unsafePartial)
import Prelude (Unit, discard, identity, otherwise, show, unit, ($), (&&), (<), (<=), (<>), (==), (||))
import Simple.JSON (readJSON)
import Test.QuickCheck (Result(Success, Failed))
import Test.Spec (describe, it)
import Test.Spec.Assertions (shouldEqual)
import Test.Spec.QuickCheck (quickCheck)
import Test.Spec.Reporter (consoleReporter)
import Test.Spec.Runner (run)
import Types.Agenda (empty, getCurrentAI, jumpToFirstActive)
import Types.Speaker as S
import Types.SpeakerQueue (SpeakerQueueState(..))
import Types.SpeakerQueue as SQ

isSuccessful :: Result -> Boolean
isSuccessful Success = true
isSuccessful _       = false

eitherToResult :: Either String Unit -> Result
eitherToResult
  = case _ of
      Left e  -> Failed e
      Right _ -> Success

resultAsEither :: Result -> (Either String Unit -> Either String Unit) -> Result
resultAsEither Success    f = eitherToResult $ f $ Right unit
resultAsEither (Failed e) f = eitherToResult $ f $ Left  e

speakersAreSortedCorrectly :: Array S.Speaker -> Result
speakersAreSortedCorrectly [] = Success
speakersAreSortedCorrectly ss
  = case A.head $ A.dropWhile isSuccessful $ A.zipWith checkPair ss' $ unsafePartial $ fromJust $ A.tail ss' of
      Nothing -> Success  -- No errors in the array.
      Just e  -> e        -- The first error in the array.
  where
    ss' = A.sort ss

    checkState :: S.SpeakerState -> S.SpeakerState -> Boolean
    checkState S.Active _        = true
    checkState _        S.Active = false
    checkState _        _        = true

    checkPair :: S.Speaker -> S.Speaker -> Result
    checkPair (S.Speaker s1) (S.Speaker s2)
      | checkState s1.state s2.state                       = Success
      | s1.timesSpoken <  s2.timesSpoken                   = Success
      | s1.timesSpoken == s2.timesSpoken && s1.id <= s2.id = Success
      | otherwise                                          = Failed ("Speakers are not correctly sorted for: \n\t" <> show (S.Speaker s1) <> "\n\t" <> show (S.Speaker s2))

theSpeakersLensRespectsInvariants :: SQ.SpeakerQueue -> Result
theSpeakersLensRespectsInvariants sq@(SQ.SpeakerQueue sqr)
  = let sq'@(SQ.SpeakerQueue sqr') = over SQ._Speakers identity sq
     in case A.head sqr.speakers of
          Just s@(S.Speaker sr) ->
            let ss' = A.filter (\(S.Speaker s1) -> s1.state == S.Deleted || s1.state == S.Done) sqr'.speakers
             in if A.null ss'
                  then Success
                  else Failed ("The final array contains speakers that are either Deleted or Done: " <> show ss')

          Nothing -> Success

main :: Effect Unit
main = run [consoleReporter] do
  describe "getCurrentAI" do
    it "doesn't crash if the Agenda is empty" $ do
      shouldEqual
        (getCurrentAI empty)
        (Left "ERROR: There is no current agenda item.")
  describe "jumpToFirstActive" do
    it "does nothing if the Agenda is empty" $ do
      shouldEqual
        (jumpToFirstActive empty)
        empty
  describe "Speakers" do
    they "are sorted correctly" $ quickCheck speakersAreSortedCorrectly
  describe "SpeakerQueue" do
    it "has a _Speaking lens that will not let people sneak past the speaking speaker" $ do
      let sq = SQ.SpeakerQueue { id :1, state: Active, speakers: [ firstSpeaker ], speakerAdded: Nothing}
          firstSpeaker  = S.Speaker { id: 1, attendeeId: 1, state: S.Active, timesSpoken: 2 }
          secondSpeaker = S.Speaker { id: 2, attendeeId: 2, state: S.Init, timesSpoken: 1 }
      shouldEqual
        ((over SQ._Speakers $ A.insert secondSpeaker) sq)
        (SQ.SpeakerQueue { id :1, state: Active, speakers: [ firstSpeaker, secondSpeaker ], speakerAdded: Nothing })

    it "has a _Speakers lens that respects the invariants" $ quickCheck theSpeakersLensRespectsInvariants
    it "has a ReadForeign that behaves well on no speakers." $ do
      shouldEqual
        (readJSON  """{"id":1,"state":"init","speakers":[]}""")
        (Right $ SQ.SpeakerQueue {id: 1, state: Init, speakers: [], speakerAdded: Nothing})

  where
    they = it

module Test.Main where

import Data.Array as A
import Data.Either (Either(..))
import Data.Lens (over)
import Data.Maybe (Maybe(Nothing, Just), fromJust)
import Effect (Effect)
import Partial.Unsafe (unsafePartial)
import Prelude (Unit, discard, identity, otherwise, show, unit, ($), (&&), (<), (<=), (<>), (==), (||))
import Simple.JSON (readJSON)
import Test.QuickCheck (Result(Success, Failed))
import Test.Spec (describe, it)
import Test.Spec.Assertions (shouldEqual)
import Test.Spec.QuickCheck (quickCheck)
import Test.Spec.Reporter (consoleReporter)
import Test.Spec.Runner (run)
import Types.Agenda (empty, getCurrentAI, jumpToFirstActive)
import Types.Speaker as S
import Types.SpeakerQueue (SpeakerQueueState(..))
import Types.SpeakerQueue as SQ

isSuccessful :: Result -> Boolean
isSuccessful Success = true
isSuccessful _       = false

eitherToResult :: Either String Unit -> Result
eitherToResult
  = case _ of
      Left e  -> Failed e
      Right _ -> Success

resultAsEither :: Result -> (Either String Unit -> Either String Unit) -> Result
resultAsEither Success    f = eitherToResult $ f $ Right unit
resultAsEither (Failed e) f = eitherToResult $ f $ Left  e

speakersAreSortedCorrectly :: Array S.Speaker -> Result
speakersAreSortedCorrectly [] = Success
speakersAreSortedCorrectly ss
  = case A.head $ A.dropWhile isSuccessful $ A.zipWith checkPair ss' $ unsafePartial $ fromJust $ A.tail ss' of
      Nothing -> Success  -- No errors in the array.
      Just e  -> e        -- The first error in the array.
  where
    ss' = A.sort ss

    checkState :: S.SpeakerState -> S.SpeakerState -> Boolean
    checkState S.Active _        = true
    checkState _        S.Active = false
    checkState _        _        = true

    checkPair :: S.Speaker -> S.Speaker -> Result
    checkPair (S.Speaker s1) (S.Speaker s2)
      | checkState s1.state s2.state                       = Success
      | s1.timesSpoken <  s2.timesSpoken                   = Success
      | s1.timesSpoken == s2.timesSpoken && s1.id <= s2.id = Success
      | otherwise                                          = Failed ("Speakers are not correctly sorted for: \n\t" <> show (S.Speaker s1) <> "\n\t" <> show (S.Speaker s2))

theSpeakersLensRespectsInvariants :: SQ.SpeakerQueue -> Result
theSpeakersLensRespectsInvariants sq@(SQ.SpeakerQueue sqr)
  = let sq'@(SQ.SpeakerQueue sqr') = over SQ._Speakers identity sq
     in case A.head sqr.speakers of
          Just s@(S.Speaker sr) ->
            let ss' = A.filter (\(S.Speaker s1) -> s1.state == S.Deleted || s1.state == S.Done) sqr'.speakers
             in if A.null ss'
                  then Success
                  else Failed ("The final array contains speakers that are either Deleted or Done: " <> show ss')

          Nothing -> Success

main :: Effect Unit
main = run [consoleReporter] do
  describe "getCurrentAI" do
    it "doesn't crash if the Agenda is empty" $ do
      shouldEqual
        (getCurrentAI empty)
        (Left "ERROR: There is no current agenda item.")
  describe "jumpToFirstActive" do
    it "does nothing if the Agenda is empty" $ do
      shouldEqual
        (jumpToFirstActive empty)
        empty
  describe "Speakers" do
    they "are sorted correctly" $ quickCheck speakersAreSortedCorrectly
  describe "SpeakerQueue" do
    it "has a _Speaking lens that will not let people sneak past the speaking speaker" $ do
      let sq = SQ.SpeakerQueue { id :1, state: Active, speakers: [ firstSpeaker ]}
          firstSpeaker  = S.Speaker { id: 1, attendeeId: 1, state: S.Active, timesSpoken: 2 }
          secondSpeaker = S.Speaker { id: 2, attendeeId: 2, state: S.Init, timesSpoken: 1 }
      shouldEqual
        ((over SQ._Speakers $ A.insert secondSpeaker) sq)
        (SQ.SpeakerQueue { id :1, state: Active, speakers: [ firstSpeaker, secondSpeaker ]})

    it "has a _Speakers lens that respects the invariants" $ quickCheck theSpeakersLensRespectsInvariants
    it "has a ReadForeign that behaves well on no speakers." $ do
      shouldEqual
        (readJSON  """{"id":1,"state":"init","speakers":[]}""")
        (Right $ SQ.SpeakerQueue {id: 1, state: Init, speakers: []})

  where
    they = it


Add query button for SlamDown output

Add query button for SlamDown output

module View.Notebook.Cell (cell) where

import Control.Functor (($>))
import Controller.Notebook.Cell
import Controller.Notebook.Cell.Viz (insertViz)
import Data.Array (length, null, catMaybes)
import Data.Date (Date(), toEpochMilliseconds)
import Data.Function (on)
import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Time (Milliseconds(..), Seconds(..), toSeconds)
import Input.Notebook (Input(..))
import Model.Notebook
import Model.Notebook.Cell
import Model.Notebook.Port (Port(..))
import Model.Resource (resourceName)
import Number.Format (toFixed)
import Optic.Core ((^.), (%~), (..), is)
import View.Common
import View.Notebook.Cell.Ace (aceEditor)
import View.Notebook.Cell.Explore (exploreEditor, exploreOutput)
import View.Notebook.Cell.Markdown (markdownOutput)
import View.Notebook.Cell.Query (queryOutput)
import View.Notebook.Cell.Search (searchOutput, searchEditor)
import View.Notebook.Cell.Viz (vizChoices, vizOutput)
import View.Notebook.Common

import qualified Halogen.HTML as H
import qualified Halogen.HTML.Attributes as A
import qualified Halogen.HTML.Events as E
import qualified Halogen.HTML.Events.Forms as E
import qualified Halogen.HTML.Events.Handler as E
import qualified Halogen.HTML.Events.Monad as E
import qualified Halogen.Themes.Bootstrap3 as B
import qualified Model.Notebook.Cell.Query as Qu
import qualified View.Css as VC

cell :: forall e. State -> Cell -> [HTML e]
cell notebook cell =
  let outputContent = output notebook cell
  in [ H.div [ A.classes $ [B.containerFluid, VC.notebookCell, B.clearfix] ++ if cell ^. _hiddenEditor then [VC.collapsed] else [] ]
             $ catMaybes [ Just $ header cell
                         , if cell ^. _hiddenEditor then Nothing else Just $ editor cell
                         , if cell ^. _hiddenEditor then Nothing else Just $ statusBar notebook (isJust outputContent) cell
                         , outputContent
                         ]
     ]

header :: forall e. Cell -> HTML e
header cell =
  let info = cellInfo cell
  in H.div [ A.classes [VC.cellHeader, B.clearfix] ]
           [ H.div [ A.class_ VC.cellIcon ]
                   [ glyph info.glyph ]
           , H.div [ A.class_ VC.cellName ]
                   [ H.text info.name ]
           , controls cell
           ]

controls :: forall e. Cell -> HTML e
controls cell =
  H.div [ A.classes [B.pullRight, VC.cellControls] ]
        [ H.button [ A.title if cell ^. _hiddenEditor
                             then "Show cell options"
                             else "Hide cell options"
                   , E.onClick $ E.input_ $ UpdateCell (cell ^. _cellId) (_hiddenEditor %~ not) ]
                   [ glyph if cell ^. _hiddenEditor
                           then B.glyphiconEyeOpen
                           else B.glyphiconEyeClose
                   ]
        , H.button [ A.title "Delete cell"
                   , E.onClick $ E.input_ $ TrashCell $ cell ^. _cellId ]
                   [ glyph B.glyphiconTrash ]
        ]

output :: forall e. State -> Cell -> Maybe (HTML e)
output notebook cell =
  let out = renderOutput cell
  in if null out
     then Nothing
     else Just $ H.div [ A.classes [B.row, VC.cellOutput] ]
                       [ H.div [ A.class_ VC.cellOutputLabel ]
                               $ cellOutputBar notebook cell
                       , H.div [ A.class_ VC.cellOutputResult ]
                               out
                       ]

cellOutputBar :: forall e. State -> Cell -> [HTML e]
cellOutputBar notebook cell =
  case cell ^. _output of
    PortResource res ->
      [ H.text $ resourceName res ++ " := "
      , H.ul [ A.classes [VC.nextCellList] ]
             [ li "Query this output" (E.input_ $ InsertCell cell $ newQueryContent res) B.glyphiconHdd
             , li "Search this output" (E.input_ $ InsertCell cell $ newSearchContent res) B.glyphiconSearch
             , li "Visualize this output" (\_ -> pure $ insertViz notebook cell) B.glyphiconPicture
             ]
      ]

    VarMap _ ->
      [ H.ul [ A.classes [VC.nextCellList] ]
             [ li "Query using fields" (E.input_ $ InsertCell cell $ Query Qu.initialQueryRec) B.glyphiconHdd
             ]
      ]

    _ -> []
  where
  li :: String -> _ -> A.ClassName -> HTML e
  li title handler c =
    H.li_ [ H.button [A.title title, E.onClick handler] [glyph c] ]

statusBar :: forall e. State -> Boolean -> Cell -> HTML e
statusBar notebook hasOutput cell =
  let buttonClass = if isRunning cell then VC.stopButton else VC.playButton
      buttonGlyph = if isRunning cell then B.glyphiconStop else B.glyphiconPlay
      messages = message cell
      toggleMessageButton =
        if null messages
        then Nothing
        else Just $ H.button [ A.title if cell ^._expandedStatus
                                       then "Hide messages"
                                       else "Show messages"
                             , E.onClick (\_ -> E.preventDefault $> pure (UpdateCell (cell ^._cellId) (_expandedStatus %~ not))) ]
                             [ glyph if cell ^._expandedStatus
                                     then B.glyphiconEyeClose
                                     else B.glyphiconEyeOpen ]
      linkButton =
        if not hasOutput
        then Nothing
        else Just $ H.button [ A.title "Share cell output"
                             , E.onClick (\_ -> pure $ handleShareClick notebook cell)
                             ]
                             [ glyph B.glyphiconShare ]
  in row' (fadeWhen (cell ^. _hiddenEditor))
     [ H.div [ A.classes [VC.cellEvalLine, B.clearfix] ]
             $ [ H.button [ A.classes [B.btn, B.btnPrimary, buttonClass]
                          , E.onClick \_ -> pure $ handleRunClick cell
                          ]
                          [ glyph buttonGlyph ]
               , H.div [ A.classes [ VC.statusText ] ]
                       [ H.text $ statusText notebook.tickDate (cell ^. _runState) ]
               , H.div [ A.classes [ B.pullRight, VC.cellControls ] ]
                       $ catMaybes [ toggleMessageButton
                                   , linkButton
                                   ]
               ] ++ messages
     ]

message :: forall e. Cell -> [HTML e]
message cell =
  let collapsed = if cell ^._expandedStatus then [] else [VC.collapsed]
  in if null (cell ^._failures)
     then if (cell ^._message) /= ""
          then [ H.div [ A.classes $ [VC.cellMessages] ++ collapsed ]
                       $ if cell ^._expandedStatus
                         then [ H.div_ []
                              , H.div_ [ H.text $ cell ^._message ]
                              ]
                         else []
               ]
          else [ ]
     else [ H.div [ A.classes $ [VC.cellFailures] ++ collapsed ]
                              $ failureText cell
          ]

details :: forall e. Cell -> [HTML e]
details cell = commonMessage "" [H.div_ [H.text (cell^._message)]] cell

failureText :: forall e. Cell -> [HTML e]
failureText cell =
  commonMessage
  (show (length fs) <> " error(s) during evaluation. ")
  ((\f -> H.div_ [H.text f]) <$> fs)
  cell
  where fs = cell ^._failures

commonMessage :: forall e. String -> [HTML e] -> Cell -> [HTML e]
commonMessage intro children cell =
  [ H.div_ [ H.text intro ]
  ] <>
  if (cell ^._expandedStatus)
  then children
  else [ ]

statusText :: Maybe Date -> RunState -> String
statusText _ RunInitial = ""
statusText d (RunningSince d') = maybe "" (\s -> "Running for " <> s <> "s") $ d >>= flip secondsText d'
statusText _ (RunFinished (Milliseconds ms)) = "Finished: took " <> show ms <> "ms."

secondsText :: Date -> Date -> Maybe String
secondsText a b = toFixed 0 <<< Math.max 0 <<< unSeconds $ on (-) (toSeconds <<< toEpochMilliseconds) a b
  where unSeconds (Seconds n) = n

cellInfo :: Cell -> { name :: String, glyph :: A.ClassName }
cellInfo cell = case cell ^. _content of
  Explore _ -> { name: "Explore", glyph: B.glyphiconEyeOpen }
  Markdown _ -> { name: "Markdown", glyph: B.glyphiconEdit }
  Search _ -> { name: "Search", glyph: B.glyphiconSearch }
  Visualize _ -> { name: "Visualize", glyph: B.glyphiconPicture }
  Query _ -> { name: "Query", glyph: B.glyphiconHdd }

editor :: forall e. Cell -> HTML e
editor state = case state ^. _content of
  Explore rec -> exploreEditor state
  Search _ ->searchEditor state
  Visualize _ -> vizChoices state
  _ -> aceEditor state

renderOutput :: forall e. Cell -> [HTML e]
renderOutput cell =
  if not (null $ cell ^. _failures)
  then []
  else case cell ^. _content of
    Explore _ -> exploreOutput cell
    Markdown mr -> markdownOutput mr cell
    Search _ -> searchOutput cell
    Visualize _ -> vizOutput cell
    Query _ -> queryOutput cell

module View.Notebook.Cell (cell) where

import Control.Functor (($>))
import Controller.Notebook.Cell
import Controller.Notebook.Cell.Viz (insertViz)
import Data.Array (length, null, catMaybes)
import Data.Date (Date(), toEpochMilliseconds)
import Data.Function (on)
import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Time (Milliseconds(..), Seconds(..), toSeconds)
import Input.Notebook (Input(..))
import Model.Notebook
import Model.Notebook.Cell
import Model.Notebook.Port (Port(..))
import Model.Resource (resourceName)
import Number.Format (toFixed)
import Optic.Core ((^.), (%~), (..), is)
import View.Common
import View.Notebook.Cell.Ace (aceEditor)
import View.Notebook.Cell.Explore (exploreEditor, exploreOutput)
import View.Notebook.Cell.Markdown (markdownOutput)
import View.Notebook.Cell.Query (queryOutput)
import View.Notebook.Cell.Search (searchOutput, searchEditor)
import View.Notebook.Cell.Viz (vizChoices, vizOutput)
import View.Notebook.Common

import qualified Halogen.HTML as H
import qualified Halogen.HTML.Attributes as A
import qualified Halogen.HTML.Events as E
import qualified Halogen.HTML.Events.Forms as E
import qualified Halogen.HTML.Events.Handler as E
import qualified Halogen.HTML.Events.Monad as E
import qualified Halogen.Themes.Bootstrap3 as B
import qualified View.Css as VC

cell :: forall e. State -> Cell -> [HTML e]
cell notebook cell =
  let outputContent = output notebook cell
  in [ H.div [ A.classes $ [B.containerFluid, VC.notebookCell, B.clearfix] ++ if cell ^. _hiddenEditor then [VC.collapsed] else [] ]
             $ catMaybes [ Just $ header cell
                         , if cell ^. _hiddenEditor then Nothing else Just $ editor cell
                         , if cell ^. _hiddenEditor then Nothing else Just $ statusBar notebook (isJust outputContent) cell
                         , outputContent
                         ]
     ]

header :: forall e. Cell -> HTML e
header cell =
  let info = cellInfo cell
  in H.div [ A.classes [VC.cellHeader, B.clearfix] ]
           [ H.div [ A.class_ VC.cellIcon ]
                   [ glyph info.glyph ]
           , H.div [ A.class_ VC.cellName ]
                   [ H.text info.name ]
           , controls cell
           ]

controls :: forall e. Cell -> HTML e
controls cell =
  H.div [ A.classes [B.pullRight, VC.cellControls] ]
        [ H.button [ A.title if cell ^. _hiddenEditor
                             then "Show cell options"
                             else "Hide cell options"
                   , E.onClick $ E.input_ $ UpdateCell (cell ^. _cellId) (_hiddenEditor %~ not) ]
                   [ glyph if cell ^. _hiddenEditor
                           then B.glyphiconEyeOpen
                           else B.glyphiconEyeClose
                   ]
        , H.button [ A.title "Delete cell"
                   , E.onClick $ E.input_ $ TrashCell $ cell ^. _cellId ]
                   [ glyph B.glyphiconTrash ]
        ]

output :: forall e. State -> Cell -> Maybe (HTML e)
output notebook cell =
  let out = renderOutput cell
  in if null out
     then Nothing
     else Just $ H.div [ A.classes [B.row, VC.cellOutput] ]
                       [ H.div [ A.class_ VC.cellOutputLabel ]
                               $ cellOutputBar notebook cell
                       , H.div [ A.class_ VC.cellOutputResult ]
                               out
                       ]

cellOutputBar :: forall e. State -> Cell -> [HTML e]
cellOutputBar notebook cell =
  case cell ^. _output of
    PortResource res ->
      [ H.text $ resourceName res ++ " := "
      , H.ul [ A.classes [VC.nextCellList] ]
             [ li "Query this output" (E.input_ $ InsertCell cell $ newQueryContent res) B.glyphiconHdd
             , li "Search this output" (E.input_ $ InsertCell cell $ newSearchContent res) B.glyphiconSearch
             , li "Visualize this output" (\_ -> pure $ insertViz notebook cell) B.glyphiconPicture
             ]
      ]

    _ -> []
  where
  li :: String -> _ -> A.ClassName -> HTML e
  li title handler c =
    H.li_ [ H.button [A.title title, E.onClick handler] [glyph c] ]

statusBar :: forall e. State -> Boolean -> Cell -> HTML e
statusBar notebook hasOutput cell =
  let buttonClass = if isRunning cell then VC.stopButton else VC.playButton
      buttonGlyph = if isRunning cell then B.glyphiconStop else B.glyphiconPlay
      messages = message cell
      toggleMessageButton =
        if null messages
        then Nothing
        else Just $ H.button [ A.title if cell ^._expandedStatus
                                       then "Hide messages"
                                       else "Show messages"
                             , E.onClick (\_ -> E.preventDefault $> pure (UpdateCell (cell ^._cellId) (_expandedStatus %~ not))) ]
                             [ glyph if cell ^._expandedStatus
                                     then B.glyphiconEyeClose
                                     else B.glyphiconEyeOpen ]
      linkButton =
        if not hasOutput
        then Nothing
        else Just $ H.button [ A.title "Share cell output"
                             , E.onClick (\_ -> pure $ handleShareClick notebook cell)
                             ]
                             [ glyph B.glyphiconShare ]
  in row' (fadeWhen (cell ^. _hiddenEditor))
     [ H.div [ A.classes [VC.cellEvalLine, B.clearfix] ]
             $ [ H.button [ A.classes [B.btn, B.btnPrimary, buttonClass]
                          , E.onClick \_ -> pure $ handleRunClick cell
                          ]
                          [ glyph buttonGlyph ]
               , H.div [ A.classes [ VC.statusText ] ]
                       [ H.text $ statusText notebook.tickDate (cell ^. _runState) ]
               , H.div [ A.classes [ B.pullRight, VC.cellControls ] ]
                       $ catMaybes [ toggleMessageButton
                                   , linkButton
                                   ]
               ] ++ messages
     ]

message :: forall e. Cell -> [HTML e]
message cell =
  let collapsed = if cell ^._expandedStatus then [] else [VC.collapsed]
  in if null (cell ^._failures)
     then if (cell ^._message) /= ""
          then [ H.div [ A.classes $ [VC.cellMessages] ++ collapsed ]
                       $ if cell ^._expandedStatus
                         then [ H.div_ []
                              , H.div_ [ H.text $ cell ^._message ]
                              ]
                         else []
               ]
          else [ ]
     else [ H.div [ A.classes $ [VC.cellFailures] ++ collapsed ]
                              $ failureText cell
          ]

details :: forall e. Cell -> [HTML e]
details cell = commonMessage "" [H.div_ [H.text (cell^._message)]] cell

failureText :: forall e. Cell -> [HTML e]
failureText cell =
  commonMessage
  (show (length fs) <> " error(s) during evaluation. ")
  ((\f -> H.div_ [H.text f]) <$> fs)
  cell
  where fs = cell ^._failures

commonMessage :: forall e. String -> [HTML e] -> Cell -> [HTML e]
commonMessage intro children cell =
  [ H.div_ [ H.text intro ]
  ] <>
  if (cell ^._expandedStatus)
  then children
  else [ ]

statusText :: Maybe Date -> RunState -> String
statusText _ RunInitial = ""
statusText d (RunningSince d') = maybe "" (\s -> "Running for " <> s <> "s") $ d >>= flip secondsText d'
statusText _ (RunFinished (Milliseconds ms)) = "Finished: took " <> show ms <> "ms."

secondsText :: Date -> Date -> Maybe String
secondsText a b = toFixed 0 <<< Math.max 0 <<< unSeconds $ on (-) (toSeconds <<< toEpochMilliseconds) a b
  where unSeconds (Seconds n) = n

cellInfo :: Cell -> { name :: String, glyph :: A.ClassName }
cellInfo cell = case cell ^. _content of
  Explore _ -> { name: "Explore", glyph: B.glyphiconEyeOpen }
  Markdown _ -> { name: "Markdown", glyph: B.glyphiconEdit }
  Search _ -> { name: "Search", glyph: B.glyphiconSearch }
  Visualize _ -> { name: "Visualize", glyph: B.glyphiconPicture }
  Query _ -> { name: "Query", glyph: B.glyphiconHdd }

editor :: forall e. Cell -> HTML e
editor state = case state ^. _content of
  Explore rec -> exploreEditor state
  Search _ ->searchEditor state
  Visualize _ -> vizChoices state
  _ -> aceEditor state

renderOutput :: forall e. Cell -> [HTML e]
renderOutput cell =
  if not (null $ cell ^. _failures)
  then []
  else case cell ^. _content of
    Explore _ -> exploreOutput cell
    Markdown mr -> markdownOutput mr cell
    Search _ -> searchOutput cell
    Visualize _ -> vizOutput cell
    Query _ -> queryOutput cell