No need for StateT and Identity

No need for StateT and Identity

-- | This module defines the random generator monad used by the `Test.QuickCheck`
-- | module, as well as helper functions for constructing random generators.
module Test.QuickCheck.Gen
  ( Gen
  , unGen
  , GenState
  , Size
  , repeatable
  , stateful
  , variant
  , suchThat
  , sized
  , resize
  , choose
  , chooseInt
  , oneOf
  , frequency
  , arrayOf
  , arrayOf1
  , listOf
  , vectorOf
  , elements
  , runGen
  , evalGen
  , perturbGen
  , uniform
  , sample
  , randomSample
  , randomSample'
  ) where

import Prelude

import Control.Alt (class Alt)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Random (RANDOM)
import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
import Control.Monad.State (State, runState, evalState)
import Control.Monad.State.Class (state, modify)

import Data.Array ((!!), length)
import Data.Foldable (fold)
import Data.Int (toNumber)
import Data.List (List(..), toUnfoldable)
import Data.Maybe (fromMaybe)
import Data.Monoid.Additive (Additive(..))
import Data.Newtype (unwrap)
import Data.Tuple (Tuple(..), fst, snd)

import Math as M

import Test.QuickCheck.LCG (Seed, lcgPerturb, lcgN, lcgNext, runSeed, randomSeed)

-- | Tests are parameterized by the `Size` of the randomly-generated data,
-- | the meaning of which depends on the particular generator used.
type Size = Int

-- | The state of the random generator monad
type GenState = { newSeed :: Seed, size :: Size }

-- | The random generator monad
-- |
-- | `Gen` is a state monad which encodes a linear congruential generator.
newtype Gen a = Gen (State GenState a)

derive newtype instance functorGen :: Functor Gen
derive newtype instance applyGen :: Apply Gen
derive newtype instance applicativeGen :: Applicative Gen
derive newtype instance bindGen :: Bind Gen
derive newtype instance monadGen :: Monad Gen
derive newtype instance altGen :: Alt Gen
derive newtype instance monadRecGen :: MonadRec Gen

-- | Exposes the underlying State implementation.
unGen :: forall a. Gen a -> State GenState a
unGen (Gen st) = st

-- | Create a random generator for a function type.
repeatable :: forall a b. (a -> Gen b) -> Gen (a -> b)
repeatable f = Gen $ state \s -> Tuple (\a -> fst (runGen (f a) s)) (s { newSeed = lcgNext s.newSeed })

-- | Create a random generator which uses the generator state explicitly.
stateful :: forall a. (GenState -> Gen a) -> Gen a
stateful f = Gen $ state \s -> runGen (f s) s

-- | Modify a random generator by setting a new random seed.
variant :: forall a. Seed -> Gen a -> Gen a
variant n g = Gen $ state \s -> runGen g s { newSeed = n }

-- | Ensure that a generator only produces values that match a predicate. If
-- | the predicate always returns false the generator will loop forever.
suchThat :: forall a. Gen a -> (a -> Boolean) -> Gen a
suchThat gen pred = tailRecM go unit
  where
  go :: Unit -> Gen (Step Unit a)
  go _ = do
    a <- gen
    pure if pred a then Done a else Loop unit

-- | Create a random generator which depends on the size parameter.
sized :: forall a. (Size -> Gen a) -> Gen a
sized f = stateful (\s -> f s.size)

-- | Modify a random generator by setting a new size parameter.
resize :: forall a. Size -> Gen a -> Gen a
resize sz g = Gen $ state \s -> runGen g s { size = sz }

-- | Create a random generator which samples a range of `Number`s i
-- | with uniform probability.
choose :: Number -> Number -> Gen Number
choose a b = (*) (max - min) >>> (+) min <$> uniform where
  min = M.min a b
  max = M.max a b

-- | Create a random generator which chooses uniformly distributed
-- | integers from the closed interval `[a, b]`.
chooseInt :: Int -> Int -> Gen Int
chooseInt a b = clamp <$> lcgStep
  where
  clamp :: Int -> Int
  clamp x = case x `mod` (b - a + one) of
              r | r >= 0 -> a + r
                | otherwise -> b + r + one

-- | Create a random generator which selects and executes a random generator from
-- | a non-empty collection of random generators with uniform probability.
oneOf :: forall a. Gen a -> Array (Gen a) -> Gen a
oneOf x xs = do
  n <- chooseInt zero (length xs)
  if n < one then x else fromMaybe x (xs !! (n - one))

-- | Create a random generator which selects and executes a random generator from
-- | a non-empty, weighted collection of random generators.
frequency :: forall a. Tuple Number (Gen a) -> List (Tuple Number (Gen a)) -> Gen a
frequency x xs = let
    xxs   = Cons x xs
    total = unwrap $ fold (map (Additive <<< fst) xxs :: List (Additive Number))
    pick n d Nil = d
    pick n d (Cons (Tuple k x') xs') = if n <= k then x' else pick (n - k) d xs'
  in do
    n <- choose zero total
    pick n (snd x) xxs

-- | Create a random generator which generates an array of random values.
arrayOf :: forall a. Gen a -> Gen (Array a)
arrayOf g = sized $ \n ->
  do k <- chooseInt zero n
     vectorOf k g

-- | Create a random generator which generates a non-empty array of random values.
arrayOf1 :: forall a. Gen a -> Gen (Tuple a (Array a))
arrayOf1 g = sized $ \n ->
  do k <- chooseInt zero n
     x <- g
     xs <- vectorOf (k - one) g
     pure $ Tuple x xs

replicateMRec :: forall m a. MonadRec m => Int -> m a -> m (List a)
replicateMRec k _ | k <= 0 = pure Nil
replicateMRec k gen = tailRecM go (Tuple Nil k)
  where
  go :: (Tuple (List a) Int) -> m (Step (Tuple (List a) Int) (List a))
  go (Tuple acc 0) = pure $ Done acc
  go (Tuple acc n) = gen <#> \x -> Loop (Tuple (Cons x acc) (n - 1))

-- | Create a random generator which generates a list of random values of the specified size.
listOf :: forall a. Int -> Gen a -> Gen (List a)
listOf = replicateMRec

-- | Create a random generator which generates a vector of random values of a specified size.
vectorOf :: forall a. Int -> Gen a -> Gen (Array a)
vectorOf k g = toUnfoldable <$> listOf k g

-- | Create a random generator which selects a value from a non-empty collection with
-- | uniform probability.
elements :: forall a. a -> Array a -> Gen a
elements x xs = do
  n <- chooseInt zero (length xs)
  pure if n == zero then x else fromMaybe x (xs !! (n - one))

-- | Run a random generator
runGen :: forall a. Gen a -> GenState -> Tuple a GenState
runGen = runState <<< unGen

-- | Run a random generator, keeping only the randomly-generated result
evalGen :: forall a. Gen a -> GenState -> a
evalGen = evalState <<< unGen

-- | Sample a random generator
sample :: forall a. Seed -> Size -> Gen a -> Array a
sample seed sz g = evalGen (vectorOf sz g) { newSeed: seed, size: sz }

-- | Sample a random generator, using a randomly generated seed
randomSample' :: forall r a. Size -> Gen a -> Eff (random :: RANDOM | r) (Array a)
randomSample' n g = do
  seed <- randomSeed
  pure $ sample seed n g

-- | Get a random sample of 10 values
randomSample :: forall r a. Gen a -> Eff (random :: RANDOM | r) (Array a)
randomSample = randomSample' 10

-- | A random generator which simply outputs the current seed
lcgStep :: Gen Int
lcgStep = Gen $ state f where
  f s = Tuple (runSeed s.newSeed) (s { newSeed = lcgNext s.newSeed })

-- | A random generator which approximates a uniform random variable on `[0, 1]`
uniform :: Gen Number
uniform = (\n -> toNumber n / toNumber lcgN) <$> lcgStep

foreign import float32ToInt32 :: Number -> Int

-- | Perturb a random generator by modifying the current seed
perturbGen :: forall a. Number -> Gen a -> Gen a
perturbGen n gen = Gen do
  modify \s -> s { newSeed = lcgPerturb (toNumber (float32ToInt32 n)) s.newSeed }
  unGen gen

-- | This module defines the random generator monad used by the `Test.QuickCheck`
-- | module, as well as helper functions for constructing random generators.
module Test.QuickCheck.Gen
  ( Gen
  , unGen
  , GenState
  , Size
  , repeatable
  , stateful
  , variant
  , suchThat
  , sized
  , resize
  , choose
  , chooseInt
  , oneOf
  , frequency
  , arrayOf
  , arrayOf1
  , listOf
  , vectorOf
  , elements
  , runGen
  , evalGen
  , perturbGen
  , uniform
  , sample
  , randomSample
  , randomSample'
  ) where

import Prelude

import Control.Alt (class Alt)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Random (RANDOM)
import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
import Control.Monad.State (State, runState, evalState)
import Control.Monad.State.Class (state, modify)
import Control.Monad.State.Trans (StateT)

import Data.Array ((!!), length)
import Data.Foldable (fold)
import Data.Identity (Identity)
import Data.Int (toNumber)
import Data.List (List(..), toUnfoldable)
import Data.Maybe (fromMaybe)
import Data.Monoid.Additive (Additive(..))
import Data.Newtype (unwrap)
import Data.Tuple (Tuple(..), fst, snd)

import Math as M

import Test.QuickCheck.LCG (Seed, lcgPerturb, lcgN, lcgNext, runSeed, randomSeed)

-- | Tests are parameterized by the `Size` of the randomly-generated data,
-- | the meaning of which depends on the particular generator used.
type Size = Int

-- | The state of the random generator monad
type GenState = { newSeed :: Seed, size :: Size }

-- | The random generator monad
-- |
-- | `Gen` is a state monad which encodes a linear congruential generator.
newtype Gen a = Gen (StateT GenState Identity a)

derive newtype instance functorGen :: Functor Gen
derive newtype instance applyGen :: Apply Gen
derive newtype instance applicativeGen :: Applicative Gen
derive newtype instance bindGen :: Bind Gen
derive newtype instance monadGen :: Monad Gen
derive newtype instance altGen :: Alt Gen
derive newtype instance monadRecGen :: MonadRec Gen

-- | Exposes the underlying State implementation.
unGen :: forall a. Gen a -> State GenState a
unGen (Gen st) = st

-- | Create a random generator for a function type.
repeatable :: forall a b. (a -> Gen b) -> Gen (a -> b)
repeatable f = Gen $ state \s -> Tuple (\a -> fst (runGen (f a) s)) (s { newSeed = lcgNext s.newSeed })

-- | Create a random generator which uses the generator state explicitly.
stateful :: forall a. (GenState -> Gen a) -> Gen a
stateful f = Gen $ state \s -> runGen (f s) s

-- | Modify a random generator by setting a new random seed.
variant :: forall a. Seed -> Gen a -> Gen a
variant n g = Gen $ state \s -> runGen g s { newSeed = n }

-- | Ensure that a generator only produces values that match a predicate. If
-- | the predicate always returns false the generator will loop forever.
suchThat :: forall a. Gen a -> (a -> Boolean) -> Gen a
suchThat gen pred = tailRecM go unit
  where
  go :: Unit -> Gen (Step Unit a)
  go _ = do
    a <- gen
    pure if pred a then Done a else Loop unit

-- | Create a random generator which depends on the size parameter.
sized :: forall a. (Size -> Gen a) -> Gen a
sized f = stateful (\s -> f s.size)

-- | Modify a random generator by setting a new size parameter.
resize :: forall a. Size -> Gen a -> Gen a
resize sz g = Gen $ state \s -> runGen g s { size = sz }

-- | Create a random generator which samples a range of `Number`s i
-- | with uniform probability.
choose :: Number -> Number -> Gen Number
choose a b = (*) (max - min) >>> (+) min <$> uniform where
  min = M.min a b
  max = M.max a b

-- | Create a random generator which chooses uniformly distributed
-- | integers from the closed interval `[a, b]`.
chooseInt :: Int -> Int -> Gen Int
chooseInt a b = clamp <$> lcgStep
  where
  clamp :: Int -> Int
  clamp x = case x `mod` (b - a + one) of
              r | r >= 0 -> a + r
                | otherwise -> b + r + one

-- | Create a random generator which selects and executes a random generator from
-- | a non-empty collection of random generators with uniform probability.
oneOf :: forall a. Gen a -> Array (Gen a) -> Gen a
oneOf x xs = do
  n <- chooseInt zero (length xs)
  if n < one then x else fromMaybe x (xs !! (n - one))

-- | Create a random generator which selects and executes a random generator from
-- | a non-empty, weighted collection of random generators.
frequency :: forall a. Tuple Number (Gen a) -> List (Tuple Number (Gen a)) -> Gen a
frequency x xs = let
    xxs   = Cons x xs
    total = unwrap $ fold (map (Additive <<< fst) xxs :: List (Additive Number))
    pick n d Nil = d
    pick n d (Cons (Tuple k x') xs') = if n <= k then x' else pick (n - k) d xs'
  in do
    n <- choose zero total
    pick n (snd x) xxs

-- | Create a random generator which generates an array of random values.
arrayOf :: forall a. Gen a -> Gen (Array a)
arrayOf g = sized $ \n ->
  do k <- chooseInt zero n
     vectorOf k g

-- | Create a random generator which generates a non-empty array of random values.
arrayOf1 :: forall a. Gen a -> Gen (Tuple a (Array a))
arrayOf1 g = sized $ \n ->
  do k <- chooseInt zero n
     x <- g
     xs <- vectorOf (k - one) g
     pure $ Tuple x xs

replicateMRec :: forall m a. MonadRec m => Int -> m a -> m (List a)
replicateMRec k _ | k <= 0 = pure Nil
replicateMRec k gen = tailRecM go (Tuple Nil k)
  where
  go :: (Tuple (List a) Int) -> m (Step (Tuple (List a) Int) (List a))
  go (Tuple acc 0) = pure $ Done acc
  go (Tuple acc n) = gen <#> \x -> Loop (Tuple (Cons x acc) (n - 1))

-- | Create a random generator which generates a list of random values of the specified size.
listOf :: forall a. Int -> Gen a -> Gen (List a)
listOf = replicateMRec

-- | Create a random generator which generates a vector of random values of a specified size.
vectorOf :: forall a. Int -> Gen a -> Gen (Array a)
vectorOf k g = toUnfoldable <$> listOf k g

-- | Create a random generator which selects a value from a non-empty collection with
-- | uniform probability.
elements :: forall a. a -> Array a -> Gen a
elements x xs = do
  n <- chooseInt zero (length xs)
  pure if n == zero then x else fromMaybe x (xs !! (n - one))

-- | Run a random generator
runGen :: forall a. Gen a -> GenState -> Tuple a GenState
runGen = runState <<< unGen

-- | Run a random generator, keeping only the randomly-generated result
evalGen :: forall a. Gen a -> GenState -> a
evalGen = evalState <<< unGen

-- | Sample a random generator
sample :: forall a. Seed -> Size -> Gen a -> Array a
sample seed sz g = evalGen (vectorOf sz g) { newSeed: seed, size: sz }

-- | Sample a random generator, using a randomly generated seed
randomSample' :: forall r a. Size -> Gen a -> Eff (random :: RANDOM | r) (Array a)
randomSample' n g = do
  seed <- randomSeed
  pure $ sample seed n g

-- | Get a random sample of 10 values
randomSample :: forall r a. Gen a -> Eff (random :: RANDOM | r) (Array a)
randomSample = randomSample' 10

-- | A random generator which simply outputs the current seed
lcgStep :: Gen Int
lcgStep = Gen $ state f where
  f s = Tuple (runSeed s.newSeed) (s { newSeed = lcgNext s.newSeed })

-- | A random generator which approximates a uniform random variable on `[0, 1]`
uniform :: Gen Number
uniform = (\n -> toNumber n / toNumber lcgN) <$> lcgStep

foreign import float32ToInt32 :: Number -> Int

-- | Perturb a random generator by modifying the current seed
perturbGen :: forall a. Number -> Gen a -> Gen a
perturbGen n gen = Gen do
  modify \s -> s { newSeed = lcgPerturb (toNumber (float32ToInt32 n)) s.newSeed }
  unGen gen


Add caType to mkEmptyCAddressSummary

Add caType to mkEmptyCAddressSummary

-- | Helper functions to mock data.
-- |
-- | _Note_: All these functions are used for testing only.

module Explorer.Test.MockFactory where

import Prelude
import Data.Lens (set)
import Data.Maybe (Maybe(..))
import Data.Time.NominalDiffTime (NominalDiffTime, mkTime)
import Explorer.Util.Factory (mkCAddress, mkCHash, mkCTxId, mkCoin)
import Pos.Explorer.Web.ClientTypes (CAddressSummary(..), CAddressType(..), CBlockEntry(..), CHash, CTxEntry(..), CTxId)
import Pos.Explorer.Web.Lenses.ClientTypes (_CBlockEntry, _CTxEntry, cbeBlkHash, cbeEpoch, cbeSlot, cbeTimeIssued, cteId, cteTimeIssued)

-- | Creates a `CTxEntry` with "empty" data
mkEmptyCTxEntry :: CTxEntry
mkEmptyCTxEntry = CTxEntry
    { cteId: mkCTxId "--"
    , cteTimeIssued: mkTime 0.0
    , cteAmount: mkCoin 0
    }

-- | Update hash of a transcation
setIdOfTx :: CTxId -> CTxEntry -> CTxEntry
setIdOfTx txId tx =
    set (_CTxEntry <<< cteId) txId tx

-- | Update time of a transaction
setTimeOfTx :: NominalDiffTime -> CTxEntry -> CTxEntry
setTimeOfTx time tx =
    set (_CTxEntry <<< cteTimeIssued) time tx

mkEmptyCAddressSummary :: CAddressSummary
mkEmptyCAddressSummary = CAddressSummary
    { caAddress: mkCAddress "--"
    , caType: CUnknownAddress
    , caTxNum: 0
    , caBalance: mkCoin 0
    , caTxList: []
    }

mkCBlockEntry :: CBlockEntry
mkCBlockEntry = CBlockEntry
    { cbeEpoch: 0
    , cbeSlot: 0
    , cbeBlkHash: mkCHash "0"
    , cbeTimeIssued: Nothing
    , cbeTxNum: 0
    , cbeTotalSent: mkCoin 0
    , cbeSize: 0
    , cbeBlockLead: Nothing
    }

-- | Update time of a slot
setTimeOfBlock :: NominalDiffTime -> CBlockEntry -> CBlockEntry
setTimeOfBlock time block =
    set (_CBlockEntry <<< cbeTimeIssued) (Just time) block

-- | Update slot / epoch of a slot
setEpochSlotOfBlock :: Int -> Int -> CBlockEntry -> CBlockEntry
setEpochSlotOfBlock epoch slot block =
    set (_CBlockEntry <<< cbeEpoch) epoch $
    set (_CBlockEntry <<< cbeSlot) slot block

-- | Update hash of a slot
setHashOfBlock :: CHash -> CBlockEntry -> CBlockEntry
setHashOfBlock hash block =
    set (_CBlockEntry <<< cbeBlkHash) hash block

-- | Helper functions to mock data.
-- |
-- | _Note_: All these functions are used for testing only.

module Explorer.Test.MockFactory where

import Prelude
import Data.Lens (set)
import Data.Maybe (Maybe(..))
import Data.Time.NominalDiffTime (NominalDiffTime, mkTime)
import Explorer.Util.Factory (mkCAddress, mkCHash, mkCTxId, mkCoin)
import Pos.Explorer.Web.ClientTypes (CAddressSummary(..), CBlockEntry(..), CHash, CTxEntry(..), CTxId)
import Pos.Explorer.Web.Lenses.ClientTypes (_CBlockEntry, _CTxEntry, cbeBlkHash, cbeEpoch, cbeSlot, cbeTimeIssued, cteId, cteTimeIssued)

-- | Creates a `CTxEntry` with "empty" data
mkEmptyCTxEntry :: CTxEntry
mkEmptyCTxEntry = CTxEntry
    { cteId: mkCTxId "--"
    , cteTimeIssued: mkTime 0.0
    , cteAmount: mkCoin 0
    }

-- | Update hash of a transcation
setIdOfTx :: CTxId -> CTxEntry -> CTxEntry
setIdOfTx txId tx =
    set (_CTxEntry <<< cteId) txId tx

-- | Update time of a transaction
setTimeOfTx :: NominalDiffTime -> CTxEntry -> CTxEntry
setTimeOfTx time tx =
    set (_CTxEntry <<< cteTimeIssued) time tx

mkEmptyCAddressSummary :: CAddressSummary
mkEmptyCAddressSummary = CAddressSummary
    { caAddress: mkCAddress "--"
    , caTxNum: 0
    , caBalance: mkCoin 0
    , caTxList: []
    }

mkCBlockEntry :: CBlockEntry
mkCBlockEntry = CBlockEntry
    { cbeEpoch: 0
    , cbeSlot: 0
    , cbeBlkHash: mkCHash "0"
    , cbeTimeIssued: Nothing
    , cbeTxNum: 0
    , cbeTotalSent: mkCoin 0
    , cbeSize: 0
    , cbeBlockLead: Nothing
    }

-- | Update time of a slot
setTimeOfBlock :: NominalDiffTime -> CBlockEntry -> CBlockEntry
setTimeOfBlock time block =
    set (_CBlockEntry <<< cbeTimeIssued) (Just time) block

-- | Update slot / epoch of a slot
setEpochSlotOfBlock :: Int -> Int -> CBlockEntry -> CBlockEntry
setEpochSlotOfBlock epoch slot block =
    set (_CBlockEntry <<< cbeEpoch) epoch $
    set (_CBlockEntry <<< cbeSlot) slot block

-- | Update hash of a slot
setHashOfBlock :: CHash -> CBlockEntry -> CBlockEntry
setHashOfBlock hash block =
    set (_CBlockEntry <<< cbeBlkHash) hash block


Add Semigroupoid

Add Semigroupoid

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

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

  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

  class Show a where
    show :: a -> String

  instance showString :: Show String where
    show s = s

  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

  infixl 4 <$>

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

  infixl 4 <*>

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

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

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

  infixl 3 <|>

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

  infixl 1 >>=

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

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

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

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

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

  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

  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 eqString :: Eq String where
    (==) = refEq
    (/=) = refIneq

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

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

  instance eqArray :: (Eq a) => Eq [a] where
    (==) [] [] = true
    (==) (x:xs) (y:ys) = x == y && xs == ys
    (==) _ _ = false
    (/=) 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 numCompare
    "function numCompare(n1) {\
    \  return function(n2) {\
    \    return n1 < n2 ? module.LT : n1 > n2 ? module.GT : module.EQ;\
    \  };\
    \}" :: Number -> Number -> Ordering

  instance ordNumber :: Ord Number where
    compare = numCompare

  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

  infixl 8 !!

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

  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 semigroupString :: Semigroup String where
    (<>) = concatString

  infixr 5 ++

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

module Data.Eq where

  data Ref a = Ref a

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

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

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

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

  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 {}) -> Eff e {}

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

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) {}

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

module Control.Monad.ST where

  import Control.Monad.Eff

  foreign import data ST :: * -> !

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  infixr 9 >>>
  infixr 9 <<<

  class Category a where
    id :: forall t. a t t
    (<<<) :: forall b c d. a c d -> a b c -> a b d

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

  instance categoryArr :: Category (->) where
    id x = x
    (<<<) f g x = f (g 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

  class Show a where
    show :: a -> String

  instance showString :: Show String where
    show s = s

  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

  infixl 4 <$>

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

  infixl 4 <*>

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

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

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

  infixl 3 <|>

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

  infixl 1 >>=

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

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

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

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

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

  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

  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 eqString :: Eq String where
    (==) = refEq
    (/=) = refIneq

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

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

  instance eqArray :: (Eq a) => Eq [a] where
    (==) [] [] = true
    (==) (x:xs) (y:ys) = x == y && xs == ys
    (==) _ _ = false
    (/=) 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 numCompare
    "function numCompare(n1) {\
    \  return function(n2) {\
    \    return n1 < n2 ? module.LT : n1 > n2 ? module.GT : module.EQ;\
    \  };\
    \}" :: Number -> Number -> Ordering

  instance ordNumber :: Ord Number where
    compare = numCompare

  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

  infixl 8 !!

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

  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 semigroupString :: Semigroup String where
    (<>) = concatString

  infixr 5 ++

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

module Data.Eq where

  data Ref a = Ref a

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

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

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

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

  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 {}) -> Eff e {}

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

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) {}

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

module Control.Monad.ST where

  import Control.Monad.Eff

  foreign import data ST :: * -> !

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

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

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

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

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

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

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

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

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

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

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


Add Show instance for Protocol

Add Show instance for Protocol

module Node.Express.Types where

import Prelude
import Data.Foreign
import Data.Foreign.Class
import Data.Either
import Data.Foreign.EasyFFI
import Data.String.Regex
import Data.Default
import Control.Monad.Eff
import Control.Monad.Eff.Unsafe
import Control.Monad.Eff.Class

foreign import data Express :: !

--| General monad, indicates that we're dealing with
--| express.js related functions.
--| Applications should use HandlerM and AppM primarily
--| and ExpressM in rare cases.
type ExpressM a = forall e. Eff (express :: Express | e) a

foreign import data Application :: *
foreign import data Event :: *
foreign import data Response :: *
foreign import data Request :: *

data Protocol = Http | Https

instance showProtocol :: Show Protocol where
    show Http  = "http"
    show Https = "https"

instance isForeignProtocol :: IsForeign Protocol where
    read value = case readString value of
        Right "http"  -> Right Http
        Right "https" -> Right Https
        _ -> Left $ JSONError "Unknown protocol"

data Method = ALL | GET | POST | PUT | DELETE | OPTIONS | HEAD | TRACE | CustomMethod String

instance showMethod :: Show Method where
    show ALL     = "all"
    show GET     = "get"
    show POST    = "post"
    show PUT     = "put"
    show DELETE  = "delete"
    show OPTIONS = "options"
    show HEAD    = "head"
    show TRACE   = "trace"
    show (CustomMethod method) = method

instance isForeignMethod :: IsForeign Method where
    read value = case readString value of
        Right "GET"     -> Right GET
        Right "POST"    -> Right POST
        Right "PUT"     -> Right PUT
        Right "DELETE"  -> Right DELETE
        Right "OPTIONS" -> Right OPTIONS
        Right "HEAD"    -> Right HEAD
        Right "TRACE"   -> Right TRACE
        Right method    -> Right $ CustomMethod method
        _ -> Left $ JSONError "Unknown HTTP method"

type Port = Int
type Path = String

class RoutePattern a
instance routePath  :: RoutePattern String
instance routeRegex :: RoutePattern Regex

class RequestParam a
instance requestParamString :: RequestParam String
instance requestParamNumber :: RequestParam Number

--| Cookie options
--| - maxAge -- time in msecs
--| - signed -- use secret to sign if true
--| - path   -- cookie path
newtype CookieOptions = CookieOptions { maxAge :: Int, signed :: Boolean, path :: String }

instance defaultCookieOptions :: Default CookieOptions where
    def = CookieOptions { maxAge: oneYear, signed: false, path: "/" }
      where oneYear = 365 * 24 * 60 * 60 * 1000

module Node.Express.Types where

import Prelude
import Data.Foreign
import Data.Foreign.Class
import Data.Either
import Data.Foreign.EasyFFI
import Data.String.Regex
import Data.Default
import Control.Monad.Eff
import Control.Monad.Eff.Unsafe
import Control.Monad.Eff.Class

foreign import data Express :: !

--| General monad, indicates that we're dealing with
--| express.js related functions.
--| Applications should use HandlerM and AppM primarily
--| and ExpressM in rare cases.
type ExpressM a = forall e. Eff (express :: Express | e) a

foreign import data Application :: *
foreign import data Event :: *
foreign import data Response :: *
foreign import data Request :: *

data Protocol = Http | Https

instance isForeignProtocol :: IsForeign Protocol where
    read value = case readString value of
        Right "http"  -> Right Http
        Right "https" -> Right Https
        _ -> Left $ JSONError "Unknown protocol"

data Method = ALL | GET | POST | PUT | DELETE | OPTIONS | HEAD | TRACE | CustomMethod String

instance showMethod :: Show Method where
    show ALL     = "all"
    show GET     = "get"
    show POST    = "post"
    show PUT     = "put"
    show DELETE  = "delete"
    show OPTIONS = "options"
    show HEAD    = "head"
    show TRACE   = "trace"
    show (CustomMethod method) = method

instance isForeignMethod :: IsForeign Method where
    read value = case readString value of
        Right "GET"     -> Right GET
        Right "POST"    -> Right POST
        Right "PUT"     -> Right PUT
        Right "DELETE"  -> Right DELETE
        Right "OPTIONS" -> Right OPTIONS
        Right "HEAD"    -> Right HEAD
        Right "TRACE"   -> Right TRACE
        Right method    -> Right $ CustomMethod method
        _ -> Left $ JSONError "Unknown HTTP method"

type Port = Int
type Path = String

class RoutePattern a
instance routePath  :: RoutePattern String
instance routeRegex :: RoutePattern Regex

class RequestParam a
instance requestParamString :: RequestParam String
instance requestParamNumber :: RequestParam Number

--| Cookie options
--| - maxAge -- time in msecs
--| - signed -- use secret to sign if true
--| - path   -- cookie path
newtype CookieOptions = CookieOptions { maxAge :: Int, signed :: Boolean, path :: String }

instance defaultCookieOptions :: Default CookieOptions where
    def = CookieOptions { maxAge: oneYear, signed: false, path: "/" }
      where oneYear = 365 * 24 * 60 * 60 * 1000


tidy and export functions

tidy and export functions

module GoogleCloud.Datastore
  ( Consistency(..)
  , Credentials(..)
  , CursorToken(..)
  , EndCursor(..)
  , FilterOperator(..)
  , GetOptions(..)
  , Id(..)
  , InfoCallbackData(..)
  , KeyPathConfig(..)
  , Kind(..)
  , MaxApiCalls(..)
  , Name(..)
  , Namespace(..)
  , OrderingType(..)
  , ProjectId(..)
  , SaveMethod(..)
  , class HasDatastore
  , _datastore
  , DATASTORE
  , Datastore
  , Key
  , Query
  , configuredDatastore
  , createQuery
  , end
  , filter
  , get
  , groupBy
  , hasAncestor
  , incompleteKey
  , insert
  , keyWithConfig
  , keyWithId
  , limit
  , mkDatastore
  , offset
  , order
  , parameterizeQuery
  , queryRun
  , queryRunUntilComplete
  , save
  , select
  , start
  , update
  , upsert
  ) where

import Prelude                     (Unit, bind, (<<<), ($),
                                    class Show, show, pure,
                                    (>>=), (<$>), unit, (<*>))

import Control.Monad.Aff           (Aff)
import Control.Monad.Eff           (Eff)
import Control.Monad.Eff.Class     (liftEff)
import Control.Monad.Eff.Exception (error)
import Control.Monad.Error.Class   (throwError)
import Control.Monad.Rec.Class     (Step(..), tailRecM)
import Control.Monad.State.Trans   (StateT)
import Control.Monad.Trans.Class   (lift)
import Control.Promise             (Promise, toAff)
import Data.Argonaut.Core          (Json, fromArray, fromNumber, fromString,
                                   fromObject, fromBoolean)
import Data.Argonaut.Decode        (class DecodeJson, decodeJson)
import Data.Argonaut.Encode        (class EncodeJson, encodeJson)
import Data.Argonaut.Prisms        (_Array, _Object, _String)
import Data.Array                  ((!!))
import Data.Array                  as A
import Data.Either                 (Either(..))
import Data.Foldable               (class Foldable, foldMap)
import Data.Function.Eff           (EffFn2, EffFn3, runEffFn3, runEffFn2)
import Data.Function.Uncurried     (Fn2, runFn2, Fn3, runFn3, Fn4, runFn4,
                                    Fn1, runFn1)
import Data.Int                    (toNumber)
import Data.Lens                   ((^.), use, Getter, view, preview, (^?))
import Data.Lens.Index             (ix)
import Data.Maybe                  (Maybe(..), maybe)
import Data.Monoid.Endo            (Endo(..))
import Data.Newtype                (class Newtype, unwrap)
import Data.NonEmpty               (NonEmpty)
import Data.Semigroup              ((<>))
import Data.StrMap                 (fromFoldable)
import Data.Traversable            (traverse)
import Data.Tuple                  (Tuple(..))
import Unsafe.Coerce               (unsafeCoerce)

newtype ProjectId   = ProjectId String
newtype Credentials = Credentials String
newtype Kind        = Kind String
newtype Id          = Id Int
newtype Name        = Name String
newtype Namespace   = Namespace String
newtype CursorToken = CursorToken String
newtype MaxApiCalls = MaxApiCalls Int
newtype EndCursor   = EndCursor String

derive instance newtypeEndCursor :: Newtype EndCursor _

data OrderingType
  = Descending
  | Ascending

data KeyPathConfig
  = IdPath Kind Id
  | NamePath Kind Name

data Consistency
  = Strong
  | Eventual

data SaveMethod
  = Insert
  | Update
  | Upsert

instance showSaveMethod :: Show SaveMethod where
  show Insert = "insert"
  show Update = "update"
  show Upsert = "upsert"

data InfoCallbackData
  = MoreResultsAfterLimit EndCursor
  | MoreResultsAfterCursor EndCursor
  | NoMoreResults

instance showInfoCallbackData :: Show InfoCallbackData where
  show (MoreResultsAfterLimit (EndCursor ec)) = "More results after limit, cursor: " <> ec
  show (MoreResultsAfterCursor (EndCursor ec)) = "More results after cursor, cursor: " <> ec
  show NoMoreResults = "Query complete, no more results"

instance showConsistency :: Show Consistency where
  show Strong = "strong"
  show Eventual = "eventual"

data GetOptions
  = GetOptions (Maybe Consistency) (Maybe MaxApiCalls)

data FilterOperator
  = Gt
  | Lt
  | GtEq
  | LtEq
  | Eq

instance showFilterOperator :: Show FilterOperator where
  show op = case op of
    Gt   -> ">"
    Lt   -> "<"
    GtEq -> ">="
    LtEq -> "<="
    Eq   -> "="

-- | Evidence of a datastore object from a value of type s, used as the state.
class HasDatastore s where
  _datastore :: Getter s s Datastore Datastore

-- | The type of a Datastore object
foreign import data Datastore :: *

-- | The type of a Key object
foreign import data Key :: *

-- | The type of a Query object
foreign import data Query :: *

-- | The effect associated with using the Datastore module
foreign import data DATASTORE :: !

foreign import gcloudDatastore
  :: forall eff. Eff (datastore :: DATASTORE | eff) Datastore

foreign import configuredDatastoreImpl
  :: forall eff
   . EffFn2 (datastore :: DATASTORE | eff)
      ProjectId
      Credentials
      Datastore

foreign import keyImpl
  :: Fn2
      Datastore
      Json
      Key

foreign import getImplNoOptions
  :: Fn2
      Datastore
      (Array Key)
      (Promise Json)

foreign import getImplWithOptions
  :: Fn3
      Datastore
      (Array Key)
      Json
      (Promise Json)

foreign import saveImpl
  :: Fn2
      Datastore
      Json
      (Promise Json)

foreign import createQueryImplNoNamespace
  :: forall eff
   . EffFn2 (datastore :: DATASTORE | eff)
      Datastore
      String
      Query

foreign import createQueryImplWithNamespace
  :: forall eff
   . EffFn3 (datastore :: DATASTORE | eff)
      Datastore
      String
      String
      Query

foreign import endImpl
  :: Fn2
      String
      Query
      Query

foreign import startImpl
  :: Fn2
      String
      Query
      Query

foreign import hasAncestorImpl
  :: Fn2
      Key
      Query
      Query

foreign import limitImpl
  :: Fn2
      Int
      Query
      Query

foreign import offsetImpl
  :: Fn2
      Int
      Query
      Query

foreign import filterImpl
  :: Fn4
      String
      String
      Json
      Query
      Query

foreign import groupByImpl
  :: Fn2
      (Array String)
      Query
      Query

foreign import selectImpl
  :: Fn2
      (Array String)
      Query
      Query

foreign import orderImpl
  :: Fn3
      String
      Json
      Query
      Query

foreign import queryRunOptionsImpl
  :: Fn2
      Query
      Json
      (Promise Json)

foreign import queryRunNoOptionsImpl
  :: Fn1
      Query
      (Promise Json)

-- | Create an auto-parameterized instance of the Datastore object when running in the GCloud
mkDatastore
  :: forall eff
   . Eff (datastore :: DATASTORE | eff) Datastore
mkDatastore =
  gcloudDatastore

-- | Create a customized instance of the Datastore object with credentials
configuredDatastore
  :: forall eff
   . ProjectId
  -> Credentials
  -> Eff (datastore :: DATASTORE | eff) Datastore
configuredDatastore p c =
  runEffFn2 configuredDatastoreImpl p c

-- | Create an incomplete key given only a Kind
incompleteKey
  :: forall s eff
   . HasDatastore s
  => Kind
  -> StateT s (Aff (datastore :: DATASTORE | eff)) Key
incompleteKey (Kind k) = do
   ds <- use _datastore
   lift (pure (runFn2 keyImpl ds key))
  where key = fromString k

-- | Create a key with an id path
keyWithId
  :: forall s eff
   . HasDatastore s
  => Kind
  -> Id
  -> StateT s (Aff (datastore :: DATASTORE | eff)) Key
keyWithId (Kind k) (Id i) = do
    ds <- use _datastore
    lift (pure (runFn2 keyImpl ds key))
  where key = fromArray [ fromString k, fromNumber $ toNumber i ]

-- | Create a key with an named path
keyWithName
  :: forall s eff
   . HasDatastore s
  => Kind
  -> Name
  -> StateT s (Eff (datastore :: DATASTORE | eff)) Key
keyWithName (Kind k) (Name n) = do
    ds <- use _datastore
    lift (pure (runFn2 keyImpl ds key))
  where key = fromArray [ fromString k, fromString n ]

-- | Create a key with a namespace and a key path configuration
keyWithConfig
  :: forall s eff
   . HasDatastore s
  => Namespace
  -> KeyPathConfig
  -> StateT s (Eff (datastore :: DATASTORE | eff)) Key
keyWithConfig (Namespace ns) (IdPath (Kind k) (Id i))     = do
    ds <- use _datastore
    lift (pure (runFn2 keyImpl ds key))
  where key  = fromObject (fromFoldable vals)
        vals = [ Tuple "namespace" (fromString ns)
               , Tuple "path" (fromArray [fromString k, fromNumber $ toNumber i]) ]
keyWithConfig (Namespace ns) (NamePath (Kind k) (Name n)) = do
    ds <- use _datastore
    lift (pure (runFn2 keyImpl ds key))
  where key  = fromObject (fromFoldable vals)
        vals = [ Tuple "namespace" (fromString ns)
               , Tuple "path" (fromArray [fromString k, fromString n]) ]

instance encodeOptionsJson :: EncodeJson GetOptions where
  encodeJson (GetOptions (Just Strong) (Just (MaxApiCalls i)))   =
    fromObject (fromFoldable [
                 Tuple "consistency" (fromString "strong")
               , Tuple "maxApiCalls" (fromNumber $ toNumber i) ])
  encodeJson (GetOptions (Just Eventual) (Just (MaxApiCalls i))) =
    fromObject (fromFoldable [
                 Tuple "consistency" (fromString "eventual")
               , Tuple "maxApiCalls" (fromNumber $ toNumber i) ])
  encodeJson (GetOptions Nothing (Just (MaxApiCalls i)))         =
    fromObject (fromFoldable [ Tuple "maxApiCalls" (fromNumber $ toNumber i) ])
  encodeJson (GetOptions (Just Strong) Nothing)                  =
    fromObject (fromFoldable [ Tuple "consistency" (fromString "strong") ])
  encodeJson (GetOptions (Just Eventual) Nothing)                =
    fromObject (fromFoldable [ Tuple "consistency" (fromString "eventual") ])
  encodeJson (GetOptions Nothing Nothing)                        =
    fromObject (fromFoldable [])

-- | Get the keys, with optional configuration parameters
get
  :: forall s eff a f
   . (DecodeJson a, HasDatastore s, Foldable f)
  => NonEmpty f Key
  -> Maybe GetOptions
  -> StateT s (Aff (datastore :: DATASTORE | eff)) (Array a)
get ks Nothing = do
  ds  <- use _datastore
  res <- lift (toAff (runFn2 getImplNoOptions ds (A.fromFoldable ks)))
  lift (parseEntity res)
get ks (Just os) = do
  ds  <- use _datastore
  res <- lift (toAff (runFn3 getImplWithOptions ds (A.fromFoldable ks) (encodeJson os)))
  lift (parseEntity res)

parseEntity
  :: forall a eff
   . DecodeJson a
  => Json
  -> Aff eff (Array a)
parseEntity json =
  case traverse decodeJson (json^._Array >>= view _Array) of
    Right x -> pure x
    Left e  -> throwError (error e)

-- | Save the data for the key
save
  :: forall s eff a
   . (EncodeJson a, HasDatastore s)
  => Key
  -> SaveMethod
  -> a
  -> StateT s (Aff (datastore :: DATASTORE | eff)) Unit
save key sm entityData = do
    ds <- use _datastore
    lift (toAff (runFn2 saveImpl ds obj))
    pure unit
  where obj = (fromObject (fromFoldable [
                            Tuple "key" (unsafeCoerce key)
                          , Tuple "data" (encodeJson entityData)
                          , Tuple "method" (fromString (show sm)) ]))

-- | Insert the data for the key
insert
  :: forall s eff a
   . (EncodeJson a, HasDatastore s)
  => Key
  -> a
  -> StateT s (Aff (datastore :: DATASTORE | eff)) Unit
insert key entityData =
  save key Insert entityData

-- | Update the data for the key
update
  :: forall s eff a
   . (EncodeJson a, HasDatastore s)
  => Key
  -> a
  -> StateT s (Aff (datastore :: DATASTORE | eff)) Unit
update key entityData =
  save key Update entityData

-- | Upsert the data for the key
upsert
  :: forall s eff a
   . (EncodeJson a, HasDatastore s)
  => Key
  -> a
  -> StateT s (Aff (datastore :: DATASTORE | eff)) Unit
upsert key entityData =
  save key Upsert entityData

-- | Create a Query object
createQuery
  :: forall s eff f
   . (HasDatastore s, Foldable f)
  => Maybe Namespace
  -> Kind
  -> f (Query -> Query)
  -> StateT s (Aff (datastore :: DATASTORE | eff)) Query
createQuery Nothing               (Kind k) params = do
  ds <- use _datastore
  lift $ parameterizeQuery params <$> liftEff (runEffFn2 createQueryImplNoNamespace ds k)
createQuery (Just (Namespace ns)) (Kind k) params = do
  ds <- use _datastore
  lift $ parameterizeQuery params <$> liftEff (runEffFn3 createQueryImplWithNamespace ds ns k)

-- | Parameterize the query by folding over the given endomorphisms
parameterizeQuery
  :: forall f
   . Foldable f
  => f (Query -> Query)
  -> Query
  -> Query
parameterizeQuery xs q =
  (unwrap (foldMap Endo xs)) q

-- | Set an ending cursor to a query
end
  :: CursorToken
  -> Query
  -> Query
end (CursorToken ct) q =
  runFn2 endImpl ct q

-- | Set a starting cursor to a query
start
  :: CursorToken
  -> Query
  -> Query
start (CursorToken ct) q =
  runFn2 startImpl ct q

-- | Filter a query by ancestors
hasAncestor
  :: Key
  -> Query
  -> Query
hasAncestor k q =
  runFn2 hasAncestorImpl k q

-- | Limit the number of returned entities
limit
  :: Int
  -> Query
  -> Query
limit count q =
  runFn2 limitImpl count q

-- | Offset count for the query entities
offset
  :: Int
  -> Query
  -> Query
offset os q =
  runFn2 offsetImpl os q

-- | Add a filter to the query
filter
  :: forall a
   . EncodeJson a
  => String
  -> FilterOperator
  -> a
  -> Query
  -> Query
filter prop op val q =
  runFn4 filterImpl prop (show op) (encodeJson val) q

-- | Select only the given properties
select
  :: forall f
   . Foldable f
  => NonEmpty f String
  -> Query
  -> Query
select props q =
  runFn2 selectImpl (A.fromFoldable props) q

-- | Group by properties in a query
groupBy
  :: forall f
   . Foldable f
  => NonEmpty f String
  -> Query
  -> Query
groupBy props q =
  runFn2 groupByImpl (A.fromFoldable props) q

-- | Order only the given property with ascending or descending
order
  :: forall f
   . Foldable f
  => String
  -> OrderingType
  -> Query
  -> Query
order prop Descending q =
  runFn3 orderImpl
         prop
         (fromObject (fromFoldable [
                       Tuple "descending" (fromBoolean true)]))
         q
order prop Ascending q =
  runFn3 orderImpl
         prop
         (fromObject (fromFoldable [
                       Tuple "descending" (fromBoolean false)]))
         q

-- | Run a query through the Promise API, returning the result
-- | entities along with the query cursor information
queryRun
  :: forall eff a
   . DecodeJson a
  => Query
  -> Maybe Consistency
  -> Aff (datastore :: DATASTORE | eff) (Tuple (Array a) InfoCallbackData)
queryRun q Nothing = do
  res <- toAff (runFn1 queryRunNoOptionsImpl q)
  Tuple <$> parseEntity res <*> parseInfoCallback res
queryRun q (Just c) = do
    res <- toAff (runFn2 queryRunOptionsImpl q obj)
    Tuple <$> parseEntity res <*> parseInfoCallback res
  where obj = fromObject (fromFoldable [ Tuple "consistency" (fromString (show c)) ])

-- | Run a query through the Promise API, returning the completed result by appending paginated results
queryRunUntilComplete
  :: forall eff a
   . DecodeJson a
  => Query
  -> Maybe Consistency
  -> Aff (datastore :: DATASTORE | eff) (Array a)
queryRunUntilComplete q c = tailRecM go { mc: c, q: q, icb: Nothing, res: [] }
  where go params = case params.icb of
          Nothing                          -> do
            Tuple ar2 icb <- queryRun params.q params.mc
            pure (Loop ( params { icb = pure icb, res = params.res <> ar2 } ))
          Just (MoreResultsAfterLimit ec)  -> do
            Tuple ar2 icb <- queryRun (start (CursorToken $ unwrap ec) params.q) params.mc
            case ar2 of
              [] -> pure (Done params.res)
              _  -> pure (Loop ( params { icb = pure icb, res = params.res <> ar2 } ))
          Just (MoreResultsAfterCursor ec) -> do
            Tuple ar2 icb <- queryRun (start (CursorToken $ unwrap ec) params.q) params.mc
            case ar2 of
              [] -> pure (Done params.res)
              _  -> pure (Loop ( params { icb = pure icb, res = params.res <> ar2 } ))
          Just NoMoreResults               ->
            pure (Done params.res)

parseInfoCallback
  :: forall eff
   . Json
  -> Aff eff InfoCallbackData
parseInfoCallback json =
     maybe (throwError (error "Unable to parse query info callback")) pure icb
  where icb = do
          cbObj <- (json^._Array) !! 1 >>= preview _Object
          mr <- cbObj ^? ix "moreResults" <<< _String
          case mr of
            "MORE_RESULTS_AFTER_LIMIT"  ->
              MoreResultsAfterLimit <<< EndCursor <$>
                cbObj ^? ix "endCursor" <<< _String
            "MORE_RESULTS_AFTER_CURSOR" ->
              MoreResultsAfterCursor <<< EndCursor <$>
                cbObj ^? ix "endCursor" <<< _String
            _                           ->
              pure NoMoreResults

module GoogleCloud.Datastore where

import Prelude                     (Unit, bind, (<<<), ($),
                                    class Show, show, pure,
                                    (>>=), (<$>), unit, (<*>))

import Control.Monad.Aff           (Aff)
import Control.Monad.Eff           (Eff)
import Control.Monad.Eff.Class     (liftEff)
import Control.Monad.Eff.Exception (error)
import Control.Monad.Error.Class   (throwError)
import Control.Monad.Rec.Class     (Step(..), tailRecM)
import Control.Monad.State.Trans   (StateT)
import Control.Monad.Trans.Class   (lift)
import Control.Promise             (Promise, toAff)
import Data.Argonaut.Core          (Json, fromArray, fromNumber, fromString,
                                   fromObject, fromBoolean)
import Data.Argonaut.Decode        (class DecodeJson, decodeJson)
import Data.Argonaut.Encode        (class EncodeJson, encodeJson)
import Data.Argonaut.Prisms        (_Array, _Object, _String)
import Data.Array                  ((!!))
import Data.Array                  as A
import Data.Either                 (Either(..))
import Data.Foldable               (class Foldable, foldMap)
import Data.Function.Eff           (EffFn2, EffFn3, runEffFn3, runEffFn2)
import Data.Function.Uncurried     (Fn2, runFn2, Fn3, runFn3, Fn4, runFn4, Fn1, runFn1)
import Data.Int                    (toNumber)
import Data.Lens                   ((^.), use, Getter, view, preview, (^?))
import Data.Lens.Index             (ix)
import Data.Maybe                  (Maybe(..), maybe)
import Data.Monoid.Endo            (Endo(..))
import Data.Newtype                (class Newtype, unwrap)
import Data.NonEmpty               (NonEmpty)
import Data.Semigroup              ((<>))
import Data.StrMap                 (fromFoldable)
import Data.Traversable            (traverse)
import Data.Tuple                  (Tuple(..))
import Unsafe.Coerce               (unsafeCoerce)

newtype ProjectId   = ProjectId String
newtype Credentials = Credentials String
newtype Kind        = Kind String
newtype Id          = Id Int
newtype Name        = Name String
newtype Namespace   = Namespace String
newtype CursorToken = CursorToken String
newtype MaxApiCalls = MaxApiCalls Int
newtype EndCursor = EndCursor String

derive instance newtypeEndCursor :: Newtype EndCursor _

data OrderingType
  = Descending
  | Ascending

data KeyPathConfig
  = IdPath Kind Id
  | NamePath Kind Name

data Consistency
  = Strong
  | Eventual

data InfoCallbackData
  = MoreResultsAfterLimit EndCursor
  | MoreResultsAfterCursor EndCursor
  | NoMoreResults

instance showInfoCallbackData :: Show InfoCallbackData where
  show (MoreResultsAfterLimit (EndCursor ec)) = "More results after limit, cursor: " <> ec
  show (MoreResultsAfterCursor (EndCursor ec)) = "More results after cursor, cursor: " <> ec
  show NoMoreResults = "Query complete, no more results"

instance showConsistency :: Show Consistency where
  show Strong = "strong"
  show Eventual = "eventual"

data GetOptions
  = GetOptions (Maybe Consistency) (Maybe MaxApiCalls)

-- | The type of a Datastore object
foreign import data Datastore :: *

-- | The type of a Key object
foreign import data Key :: *

-- | The type of a Query object
foreign import data Query :: *

-- | The effect associated with using the Datastore module
foreign import data DATASTORE :: !

-- | Evidence of a datastore object from a value of type s, used as the state.
class HasDatastore s where
  _datastore :: Getter s s Datastore Datastore

-- | Create an instance of the Datastore object
foreign import gcloudDatastore
  :: forall eff. Eff (datastore :: DATASTORE | eff) Datastore

-- | Create an auto-parameterized instance of the Datastore object when running in the GCloud
mkDatastore
  :: forall eff
   . Eff (datastore :: DATASTORE | eff) Datastore
mkDatastore =
  gcloudDatastore

foreign import configuredDatastoreImpl
  :: forall eff
   . EffFn2 (datastore :: DATASTORE | eff)
      ProjectId
      Credentials
      Datastore

-- | Create a customized instance of the Datastore object with credentials
configuredDatastore
  :: forall eff
   . ProjectId
  -> Credentials
  -> Eff (datastore :: DATASTORE | eff) Datastore
configuredDatastore p c =
  runEffFn2 configuredDatastoreImpl p c

foreign import keyImpl
  :: Fn2
      Datastore
      Json
      Key

-- | Create an incomplete key given only a Kind
incompleteKey
  :: forall s eff
   . HasDatastore s
  => Kind
  -> StateT s (Aff (datastore :: DATASTORE | eff)) Key
incompleteKey (Kind k) = do
   ds <- use _datastore
   lift (pure (runFn2 keyImpl ds key))
  where key = fromString k

-- | Create a key with an id path
keyWithId
  :: forall s eff
   . HasDatastore s
  => Kind
  -> Id
  -> StateT s (Aff (datastore :: DATASTORE | eff)) Key
keyWithId (Kind k) (Id i) = do
    ds <- use _datastore
    lift (pure (runFn2 keyImpl ds key))
  where key = fromArray [ fromString k, fromNumber $ toNumber i ]

-- | Create a key with an named path
keyWithName
  :: forall s eff
   . HasDatastore s
  => Kind
  -> Name
  -> StateT s (Eff (datastore :: DATASTORE | eff)) Key
keyWithName (Kind k) (Name n) = do
    ds <- use _datastore
    lift (pure (runFn2 keyImpl ds key))
  where key = fromArray [ fromString k, fromString n ]

-- | Create a key with a namespace and a key path configuration
keyWithConfig
  :: forall s eff
   . HasDatastore s
  => Namespace
  -> KeyPathConfig
  -> StateT s (Eff (datastore :: DATASTORE | eff)) Key
keyWithConfig (Namespace ns) (IdPath (Kind k) (Id i))     = do
    ds <- use _datastore
    lift (pure (runFn2 keyImpl ds key))
  where key  = fromObject (fromFoldable vals)
        vals = [ Tuple "namespace" (fromString ns)
               , Tuple "path" (fromArray [fromString k, fromNumber $ toNumber i]) ]
keyWithConfig (Namespace ns) (NamePath (Kind k) (Name n)) = do
    ds <- use _datastore
    lift (pure (runFn2 keyImpl ds key))
  where key  = fromObject (fromFoldable vals)
        vals = [ Tuple "namespace" (fromString ns)
               , Tuple "path" (fromArray [fromString k, fromString n]) ]

instance encodeOptionsJson :: EncodeJson GetOptions where
  encodeJson (GetOptions (Just Strong) (Just (MaxApiCalls i)))   =
    fromObject (fromFoldable [
                 Tuple "consistency" (fromString "strong")
               , Tuple "maxApiCalls" (fromNumber $ toNumber i) ])
  encodeJson (GetOptions (Just Eventual) (Just (MaxApiCalls i))) =
    fromObject (fromFoldable [
                 Tuple "consistency" (fromString "eventual")
               , Tuple "maxApiCalls" (fromNumber $ toNumber i) ])
  encodeJson (GetOptions Nothing (Just (MaxApiCalls i)))         =
    fromObject (fromFoldable [ Tuple "maxApiCalls" (fromNumber $ toNumber i) ])
  encodeJson (GetOptions (Just Strong) Nothing)                  =
    fromObject (fromFoldable [ Tuple "consistency" (fromString "strong") ])
  encodeJson (GetOptions (Just Eventual) Nothing)                =
    fromObject (fromFoldable [ Tuple "consistency" (fromString "eventual") ])
  encodeJson (GetOptions Nothing Nothing)                        =
    fromObject (fromFoldable [])

foreign import getImplNoOptions
  :: Fn2
      Datastore
      (Array Key)
      (Promise Json)

foreign import getImplWithOptions
  :: Fn3
      Datastore
      (Array Key)
      Json
      (Promise Json)

-- | Get the keys, with optional configuration parameters
get
  :: forall s eff a f
   . (DecodeJson a, HasDatastore s, Foldable f)
  => NonEmpty f Key
  -> Maybe GetOptions
  -> StateT s (Aff (datastore :: DATASTORE | eff)) (Array a)
get ks Nothing = do
  ds  <- use _datastore
  res <- lift (toAff (runFn2 getImplNoOptions ds (A.fromFoldable ks)))
  lift (parseEntity res)
get ks (Just os) = do
  ds  <- use _datastore
  res <- lift (toAff (runFn3 getImplWithOptions ds (A.fromFoldable ks) (encodeJson os)))
  lift (parseEntity res)

parseEntity
  :: forall a eff
   . DecodeJson a
  => Json
  -> Aff eff (Array a)
parseEntity json =
  case traverse decodeJson (json^._Array >>= view _Array) of
    Right x -> pure x
    Left e  -> throwError (error e)

data SaveMethod
  = Insert
  | Update
  | Upsert

instance showSaveMethod :: Show SaveMethod where
  show Insert = "insert"
  show Update = "update"
  show Upsert = "upsert"

foreign import saveImpl
  :: Fn2
      Datastore
      Json
      (Promise Json)

-- | Save the data for the key
save
  :: forall s eff a
   . (EncodeJson a, HasDatastore s)
  => Key
  -> SaveMethod
  -> a
  -> StateT s (Aff (datastore :: DATASTORE | eff)) Unit
save key sm entityData = do
    ds <- use _datastore
    lift (toAff (runFn2 saveImpl ds obj))
    pure unit
  where obj = (fromObject (fromFoldable [
                            Tuple "key" (unsafeCoerce key)
                          , Tuple "data" (encodeJson entityData)
                          , Tuple "method" (fromString (show sm)) ]))

-- | Insert the data for the key
insert
  :: forall s eff a
   . (EncodeJson a, HasDatastore s)
  => Key
  -> a
  -> StateT s (Aff (datastore :: DATASTORE | eff)) Unit
insert key entityData =
  save key Insert entityData

-- | Update the data for the key
update
  :: forall s eff a
   . (EncodeJson a, HasDatastore s)
  => Key
  -> a
  -> StateT s (Aff (datastore :: DATASTORE | eff)) Unit
update key entityData =
  save key Update entityData

-- | Upsert the data for the key
upsert
  :: forall s eff a
   . (EncodeJson a, HasDatastore s)
  => Key
  -> a
  -> StateT s (Aff (datastore :: DATASTORE | eff)) Unit
upsert key entityData =
  save key Upsert entityData

foreign import createQueryImplNoNamespace
  :: forall eff
   . EffFn2 (datastore :: DATASTORE | eff)
      Datastore
      String
      Query

foreign import createQueryImplWithNamespace
  :: forall eff
   . EffFn3 (datastore :: DATASTORE | eff)
      Datastore
      String
      String
      Query

-- | Create a Query object
createQuery
  :: forall s eff f
   . (HasDatastore s, Foldable f)
  => Maybe Namespace
  -> Kind
  -> f (Query -> Query)
  -> StateT s (Aff (datastore :: DATASTORE | eff)) Query
createQuery Nothing               (Kind k) params = do
  ds <- use _datastore
  lift $ parameterizeQuery params <$> liftEff (runEffFn2 createQueryImplNoNamespace ds k)
createQuery (Just (Namespace ns)) (Kind k) params = do
  ds <- use _datastore
  lift $ parameterizeQuery params <$> liftEff (runEffFn3 createQueryImplWithNamespace ds ns k)

parameterizeQuery
  :: forall f
   . Foldable f
  => f (Query -> Query)
  -> Query
  -> Query
parameterizeQuery xs q =
  (unwrap (foldMap Endo xs)) q

foreign import endImpl
  :: Fn2
      String
      Query
      Query

-- | Set an ending cursor to a query
end
  :: CursorToken
  -> Query
  -> Query
end (CursorToken ct) q =
  runFn2 endImpl ct q

foreign import startImpl
  :: Fn2
      String
      Query
      Query

-- | Set a starting cursor to a query
start
  :: CursorToken
  -> Query
  -> Query
start (CursorToken ct) q =
  runFn2 startImpl ct q

foreign import hasAncestorImpl
  :: Fn2
      Key
      Query
      Query

-- | Filter a query by ancestors
hasAncestor
  :: Key
  -> Query
  -> Query
hasAncestor k q =
  runFn2 hasAncestorImpl k q

foreign import limitImpl
  :: Fn2
      Int
      Query
      Query

-- | Limit the number of returned entities
limit
  :: Int
  -> Query
  -> Query
limit count q =
  runFn2 limitImpl count q

foreign import offsetImpl
  :: Fn2
      Int
      Query
      Query

-- | Offset count for the query entities
offset
  :: Int
  -> Query
  -> Query
offset os q =
  runFn2 offsetImpl os q

data FilterOperator
  = Gt
  | Lt
  | GtEq
  | LtEq
  | Eq

instance showFilterOperator :: Show FilterOperator where
  show op = case op of
    Gt   -> ">"
    Lt   -> "<"
    GtEq -> ">="
    LtEq -> "<="
    Eq   -> "="

foreign import filterImpl
  :: Fn4
      String
      String
      Json
      Query
      Query

-- | Add a filter to the query
filter
  :: forall a
   . EncodeJson a
  => String
  -> FilterOperator
  -> a
  -> Query
  -> Query
filter prop op val q =
  runFn4 filterImpl prop (show op) (encodeJson val) q

foreign import groupByImpl
  :: Fn2
      (Array String)
      Query
      Query

-- | Group by properties in a query
groupBy
  :: forall f
   . Foldable f
  => NonEmpty f String
  -> Query
  -> Query
groupBy props q =
  runFn2 groupByImpl (A.fromFoldable props) q

foreign import selectImpl
  :: Fn2
      (Array String)
      Query
      Query

-- | Select only the given properties
select
  :: forall f
   . Foldable f
  => NonEmpty f String
  -> Query
  -> Query
select props q =
  runFn2 selectImpl (A.fromFoldable props) q

foreign import orderImpl
  :: Fn3
      String
      Json
      Query
      Query

-- | Order only the given property with ascending or descending
order
  :: forall f
   . Foldable f
  => String
  -> OrderingType
  -> Query
  -> Query
order prop Descending q =
  runFn3 orderImpl
         prop
         (fromObject (fromFoldable [
                       Tuple "descending" (fromBoolean true)]))
         q
order prop Ascending q =
  runFn3 orderImpl
         prop
         (fromObject (fromFoldable [
                       Tuple "descending" (fromBoolean false)]))
         q

foreign import queryRunOptionsImpl
  :: Fn2
      Query
      Json
      (Promise Json)

foreign import queryRunNoOptionsImpl
  :: Fn1
      Query
      (Promise Json)

-- | Run a query through the Promise API, returning the result
-- | entities along with the query cursor information
queryRun
  :: forall eff a
   . DecodeJson a
  => Query
  -> Maybe Consistency
  -> Aff (datastore :: DATASTORE | eff) (Tuple (Array a) InfoCallbackData)
queryRun q Nothing = do
  res <- toAff (runFn1 queryRunNoOptionsImpl q)
  Tuple <$> parseEntity res <*> parseInfoCallback res
queryRun q (Just c) = do
    res <- toAff (runFn2 queryRunOptionsImpl q obj)
    Tuple <$> parseEntity res <*> parseInfoCallback res
  where obj = fromObject (fromFoldable [ Tuple "consistency" (fromString (show c)) ])

-- | Run a query through the Promise API, returning the completed result by appending paginated results
queryRunUntilComplete
  :: forall eff a
   . DecodeJson a
  => Query
  -> Maybe Consistency
  -> Aff (datastore :: DATASTORE | eff) (Array a)
queryRunUntilComplete q c = tailRecM go { mc: c, q: q, icb: Nothing, res: [] }
  where go params = case params.icb of
          Nothing                          -> do
            Tuple ar2 icb <- queryRun params.q params.mc
            pure (Loop ( params { icb = pure icb, res = params.res <> ar2 } ))
          Just (MoreResultsAfterLimit ec)  -> do
            Tuple ar2 icb <- queryRun (start (CursorToken $ unwrap ec) params.q) params.mc
            case ar2 of
              [] -> pure (Done params.res)
              _  -> pure (Loop ( params { icb = pure icb, res = params.res <> ar2 } ))
          Just (MoreResultsAfterCursor ec) -> do
            Tuple ar2 icb <- queryRun (start (CursorToken $ unwrap ec) params.q) params.mc
            case ar2 of
              [] -> pure (Done params.res)
              _  -> pure (Loop ( params { icb = pure icb, res = params.res <> ar2 } ))
          Just NoMoreResults               ->
            pure (Done params.res)

parseInfoCallback
  :: forall eff
   . Json
  -> Aff eff InfoCallbackData
parseInfoCallback json =
     maybe (throwError (error "Unable to parse query info callback")) pure icb
  where icb = do
          cbObj <- (json^._Array) !! 1 >>= preview _Object
          mr <- cbObj ^? ix "moreResults" <<< _String
          case mr of
            "MORE_RESULTS_AFTER_LIMIT"  ->
              MoreResultsAfterLimit <<< EndCursor <$>
                cbObj ^? ix "endCursor" <<< _String
            "MORE_RESULTS_AFTER_CURSOR" ->
              MoreResultsAfterCursor <<< EndCursor <$>
                cbObj ^? ix "endCursor" <<< _String
            _                           ->
              pure NoMoreResults


added: assertEqual', assertFalse', assertTrue'

module Test.Assert
  ( assert
  , assert'
  , assertEqual
  , assertEqual'
  , assertFalse
  , assertFalse'
  , assertThrows
  , assertThrows'
  , assertTrue
  , assertTrue'
  ) where

import Prelude

import Effect (Effect)
import Effect.Console (error)

-- | Throws a runtime exception with message "Assertion failed" when the boolean
-- | value is false.
assert :: Boolean -> Effect Unit
assert = assert' "Assertion failed"

-- | Throws a runtime exception with the specified message when the boolean
-- | value is false.
foreign import assert'
  :: String
  -> Boolean
  -> Effect Unit

-- | Throws a runtime exception with message "Assertion failed: An error should
-- | have been thrown", unless the argument throws an exception when evaluated.
-- |
-- | This function is specifically for testing unsafe pure code; for example,
-- | to make sure that an exception is thrown if a precondition is not
-- | satisfied. Functions which use `Effect a` can be
-- | tested with `catchException` instead.
assertThrows :: forall a. (Unit -> a) -> Effect Unit
assertThrows =
  assertThrows' "Assertion failed: An error should have been thrown"

-- | Throws a runtime exception with the specified message, unless the argument
-- | throws an exception when evaluated.
-- |
-- | This function is specifically for testing unsafe pure code; for example,
-- | to make sure that an exception is thrown if a precondition is not
-- | satisfied. Functions which use `Effect a` can be
-- | tested with `catchException` instead.
assertThrows'
  :: forall a
   . String
  -> (Unit -> a)
  -> Effect Unit
assertThrows' msg fn = assert' msg =<< checkThrows fn

foreign import checkThrows
  :: forall a
   . (Unit -> a)
  -> Effect Boolean

-- | Compares the `expected` and `actual` values for equality and
-- | throws a runtime exception when the values are not equal.
-- |
-- | The message indicates the expected value and the actual value.
assertEqual
  :: forall a
   . Eq a
  => Show a
  => { actual :: a, expected :: a }
  -> Effect Unit
assertEqual = assertEqual' ""

-- | Compares the `expected` and `actual` values for equality and throws a
-- | runtime exception with the specified message when the values are not equal.
-- |
-- | The message also indicates the expected value and the actual value.
assertEqual'
  :: forall a
   . Eq a
  => Show a
  => String
  -> { actual :: a, expected :: a }
  -> Effect Unit
assertEqual' userMessage {actual, expected} = do
  unless result $ error message
  assert' message result
  where
  message = (if userMessage == "" then "" else userMessage <> "\n")
             <> "Expected: " <> show expected
             <> "\nActual:   " <> show actual
  result = actual == expected

-- | Throws a runtime exception when the value is `false`.
-- |
-- | The message indicates the expected value (`true`)
-- | and the actual value (`false`).
assertTrue
  :: Boolean
  -> Effect Unit
assertTrue actual = assertEqual { actual, expected: true }

-- | Throws a runtime exception with the specified message when the value is
-- | `false`.
-- |
-- | The message also indicates the expected value (`true`)
-- | and the actual value (`false`).
assertTrue'
  :: String
  -> Boolean
  -> Effect Unit
assertTrue' message actual = assertEqual' message { actual, expected: true }

-- | Throws a runtime exception when the value is `true`.
-- |
-- | The message indicates the expected value (`false`)
-- | and the actual value (`true`).
assertFalse
  :: Boolean
  -> Effect Unit
assertFalse actual = assertEqual { actual, expected: false }

-- | Throws a runtime exception with the specified message when the value is
-- | `true`.
-- |
-- | The message also indicates the expected value (`false`)
-- | and the actual value (`true`).
assertFalse'
  :: String
  -> Boolean
  -> Effect Unit
assertFalse' message actual = assertEqual' message { actual, expected: false }

module Test.Assert
  ( assert
  , assert'
  , assertEqual
  , assertFalse
  , assertThrows
  , assertThrows'
  , assertTrue
  ) where

import Prelude

import Effect (Effect)
import Effect.Console (error)

-- | Throws a runtime exception with message "Assertion failed" when the boolean
-- | value is false.
assert :: Boolean -> Effect Unit
assert = assert' "Assertion failed"

-- | Throws a runtime exception with the specified message when the boolean
-- | value is false.
foreign import assert'
  :: String
  -> Boolean
  -> Effect Unit

-- | Throws a runtime exception with message "Assertion failed: An error should
-- | have been thrown", unless the argument throws an exception when evaluated.
-- |
-- | This function is specifically for testing unsafe pure code; for example,
-- | to make sure that an exception is thrown if a precondition is not
-- | satisfied. Functions which use `Effect a` can be
-- | tested with `catchException` instead.
assertThrows :: forall a. (Unit -> a) -> Effect Unit
assertThrows =
  assertThrows' "Assertion failed: An error should have been thrown"

-- | Throws a runtime exception with the specified message, unless the argument
-- | throws an exception when evaluated.
-- |
-- | This function is specifically for testing unsafe pure code; for example,
-- | to make sure that an exception is thrown if a precondition is not
-- | satisfied. Functions which use `Effect a` can be
-- | tested with `catchException` instead.
assertThrows'
  :: forall a
   . String
  -> (Unit -> a)
  -> Effect Unit
assertThrows' msg fn = assert' msg =<< checkThrows fn

foreign import checkThrows
  :: forall a
   . (Unit -> a)
  -> Effect Boolean

-- | Compares the `expected` and `actual` values for equality and
-- | throws a runtime exception when the values are not equal.
-- |
-- | The message indicates the expected value and the actual value.
assertEqual
  :: forall a
   . Eq a
  => Show a
  => { actual :: a, expected :: a }
  -> Effect Unit
assertEqual {actual, expected} = do
  unless result $ error message
  assert' message result
  where
  message = "Expected: " <> show expected <> "\nActual:   " <> show actual
  result = actual == expected

-- | Throws a runtime exception when the value is `false`.
-- |
-- | The message indicates the expected value (`true`)
-- | and the actual value (`false`).
assertTrue
  :: Boolean
  -> Effect Unit
assertTrue actual = assertEqual { actual, expected: true }

-- | Throws a runtime exception when the value is `true`.
-- |
-- | The message indicates the expected value (`false`)
-- | and the actual value (`true`).
assertFalse
  :: Boolean
  -> Effect Unit
assertFalse actual = assertEqual { actual, expected: false }