Fixed #17

Fixed #17

module Test.StrongCheck.Gen
  ( GenT(..)
  , Gen(..)
  , GenState(..)
  , GenOut(..)
  , Size()
  , Seed()
  , allInArray
  , allInRange
  , applyGen
  , arrayOf
  , arrayOf1
  , charGen
  , choose
  , chooseInt
  , chunked
  , collectAll
  , dropGen
  , elements
  , extend
  , foldGen
  , foldGen'
  , frequency
  , infinite
  , interleave
  , nChooseK
  , oneOf
  , perms
  , perturbGen
  , repeatable
  , resize
  , runGen
  , sample
  , sample'
  , showSample
  , showSample'
  , shuffle
  , shuffle'
  , shuffleArray
  , sized
  , stateful
  , suchThat
  , suchThatMaybe
  , takeGen
  , toLazyList
  , transGen
  , uniform
  , unGen
  , unGenOut
  , unGenState
  , updateSeedState
  , variant
  , vectorOf
  , wrapEffect
  ) where

import Prelude

import Control.Alt (Alt, (<|>))
import Control.Alternative (Alternative)
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Console (print, CONSOLE())
import Control.Monad.Trampoline (runTrampoline, Trampoline())
import Control.MonadPlus (MonadPlus)
import Control.Plus (Plus)
import Data.Char (fromCharCode)
import Data.Foldable (fold)
import Data.Int (fromNumber, toNumber)
import Data.Int.Bits (shl)
import Data.Lazy (Lazy(), defer)
import Data.Maybe (fromMaybe, maybe, Maybe(..))
import Data.Maybe.Unsafe (fromJust)
import Data.Monoid (mempty, Monoid)
import Data.Monoid.Additive (Additive(..), runAdditive)
import Data.Profunctor (arr, lmap)
import Data.Profunctor.Strong ((&&&))
import Data.Tuple (Tuple(..), snd, fst)

import qualified Control.Monad.List.Trans as ListT
import qualified Data.Array as A
import qualified Data.Array.Unsafe as AU
import qualified Data.List as L
import qualified Data.Machine.Mealy as Mealy

import qualified Math as M

type Size = Int
type Seed  = Number

data GenState = GenState { seed :: Seed, size :: Size }

unGenState :: GenState -> { seed :: Seed, size :: Size }
unGenState (GenState s) = s

stateM :: ({ seed :: Seed, size :: Size } -> { seed :: Seed, size :: Size }) -> GenState -> GenState
stateM f = GenState <<< f <<< unGenState

data GenOut a = GenOut { state :: GenState, value :: a }

unGenOut :: forall a. GenOut a -> { state :: GenState, value :: a }
unGenOut (GenOut v) = v

data GenT f a = GenT (Mealy.MealyT f GenState (GenOut a))

type Gen a = GenT Trampoline a

unGen :: forall f a. GenT f a -> Mealy.MealyT f GenState (GenOut a)
unGen (GenT m) = m

lcgM :: Seed
lcgM = 1103515245.0

lcgC :: Seed
lcgC = 12345.0

lcgN :: Seed
lcgN = toNumber $ 1 `shl` 30

lcgNext :: Seed -> Seed
lcgNext n = (lcgM * n + lcgC) M.% lcgN

lcgStep :: forall f. (Monad f) => GenT f Seed
lcgStep = GenT $ arr $ \s -> GenOut { state: updateSeedState s, value: (unGenState s).seed }

uniform :: forall f. (Monad f) => GenT f Seed
uniform = (\n -> n / toNumber (1 `shl` 30)) <$> lcgStep

stepGen :: forall f a. (Monad f) => GenState -> GenT f a -> f (Maybe (GenOut (Tuple a (GenT f a))))
stepGen st (GenT m) =   h <$> Mealy.stepMealy st m
                        where h Mealy.Halt        = Nothing
                              h (Mealy.Emit a m)  = Just $ flip Tuple (GenT m) <$> a

evalGen :: forall f a. (Monad f) => GenT f a -> GenState -> f (Maybe a)
evalGen g st = h <$> stepGen st g
                where h Nothing                               = Nothing
                      h (Just (GenOut { value = Tuple a _ })) = Just a

pureGen :: forall f a. (Monad f) => (GenState -> GenOut a) -> GenT f a
pureGen f = GenT $ arr f

repeatable' :: forall f a b. (Monad f) => (a -> GenT f b) -> GenT f (a -> f b)
repeatable' f = GenT $
  Mealy.pureMealy $ \s -> Mealy.Emit (GenOut { state: s, value: \a -> fromJust <$> evalGen (f a) s }) Mealy.halt

-- | Creates a function generator that will always generate the same output
-- | for the same input.
repeatable :: forall a b. (a -> Gen b) -> Gen (a -> b)
repeatable f = g <$> repeatable' f
               where g f' = \a -> runTrampoline $ f' a

-- | Creates a generator that depends on access to the generator state.
stateful :: forall f a. (Monad f) => (GenState -> GenT f a) -> GenT f a
stateful f = GenT $ do s <- Mealy.take 1 id
                       unGen (f s)

-- | Fixes a generator on a certain variant, given by the specified seed.
variant :: forall f a. (Monad f) => Seed -> GenT f a -> GenT f a
variant n g = GenT $ lmap (stateM (\s -> s { seed = n })) (unGen g)

-- | Creates a generator that depends on the size parameter.
sized :: forall f a. (Monad f) => (Size -> GenT f a) -> GenT f a
sized f = stateful $ \s -> f (unGenState s).size

-- | Resizes the generator so the size parameter passed into the generator
-- | will be equal to the specified size.
resize :: forall f a. (Monad f) => Size -> GenT f a -> GenT f a
resize sz g = GenT $ lmap (stateM (\s -> s { size = sz })) (unGen g)

-- | A generator for characters.
charGen :: forall f. (Monad f) => GenT f Char
charGen = fromCharCode <$> chooseInt 0.0 65535.0

-- | Creates a generator that generates real numbers between the specified
-- | inclusive range.
choose :: forall f. (Monad f) => Number -> Number -> GenT f Number
choose a b = (*) (max - min) >>> (+) min <$> uniform
  where min = M.min a b
        max = M.max a b

-- | Creates a generator that generates integers between the specified
-- | inclusive range.
chooseInt :: forall f. (Monad f) => Number -> Number -> GenT f Int
chooseInt a b =
  let min = M.ceil  (M.min a b)
      max = M.floor (M.max a b)
      numRes = ((+) (min - 0.5) <<< (*) (max - min + 1.0)) <$> uniform
      rounded = M.round <$> numRes
      intRes = fromNumber <$> rounded
  in fromMaybe 0 <$> intRes

-- | Creates a generator that chooses another generator from the specified list
-- | at random, and then generates a value with that generator.
oneOf :: forall f a. (Monad f) => GenT f a -> Array (GenT f a) -> GenT f a
oneOf x xs = do n <- chooseInt 0.0 (toNumber (A.length xs))
                if n == 0 then x else fromMaybe x (xs A.!! (n - 1))

-- | Generates elements by the specified frequencies (which will be normalized).
frequency :: forall f a. (Monad f) => Tuple Number (GenT f a) -> L.List (Tuple Number (GenT f a)) -> GenT f a
frequency x xs =
  let xxs :: L.List (Tuple Number (GenT f a))
      xxs   = L.Cons x xs

      total :: Number
      total = runAdditive $ fold ((Additive <<< fst) <$> xxs)

      pick :: Number -> GenT f a -> L.List (Tuple Number (GenT f a)) -> GenT f a
      pick _ d L.Nil = d
      pick n d (L.Cons (Tuple k x) xs) =
        if n <= k
        then x
        else pick (n - k) d xs

  in do n <- chooseInt 1.0 total
        pick (toNumber n) (snd x) xxs

-- | Creates a generator of elements ranging from 0 to the maximum size.
arrayOf :: forall f a. (Monad f) => GenT f a -> GenT f (Array a)
arrayOf g = sized $ \n ->
  do k <- chooseInt 0.0 (toNumber n)
     vectorOf k g

-- | Creates a generator of elements ranging from 1 to the maximum size.
arrayOf1 :: forall f a. (Monad f) => GenT f a -> GenT f (Tuple a (Array a))
arrayOf1 g = sized $ \n ->
  do k  <- chooseInt 0.0 (toNumber n)
     x  <- g
     xs <- vectorOf (k - 1) g
     return $ Tuple x xs

-- | Creates a generator that generates arrays of some specified size.
vectorOf :: forall f a. (Monad f) => Int -> GenT f a -> GenT f (Array a)
vectorOf n g = transGen f [] (extend n g)
  where f b a = let b' = b <> [a]
                in  if A.length b' >= n then Tuple [] (Just b') else Tuple b' Nothing

-- | Creates a generator that chooses an element from among a set of elements.
elements :: forall f a. (Monad f) => a -> L.List a -> GenT f a
elements x xs = do
  n <- chooseInt 0.0 (toNumber (L.length xs))
  pure if n == 0 then x else fromMaybe x (xs L.!! (n - 1))

foreign import float32ToInt32 :: Number -> Int

perturbGen :: forall f a. (Monad f) => Number -> GenT f a -> GenT f a
perturbGen n (GenT m) = GenT $ lmap (stateM (\s -> s { seed = perturbNum n s.seed })) m

perturbNum :: Number -> Seed -> Seed
perturbNum n = (+) $ lcgNext (toNumber (float32ToInt32 n))

updateSeedState :: GenState -> GenState
updateSeedState (GenState s) = GenState { seed: lcgNext s.seed, size: s.size }

updateSeedGen :: forall f a. (Monad f) => GenT f a -> GenT f a
updateSeedGen (GenT m) = GenT $ lmap updateSeedState m

liftMealy :: forall f a. (Monad f) => (Mealy.MealyT f GenState (GenOut a) -> Mealy.MealyT f GenState (GenOut a)) -> (GenT f a -> GenT f a)
liftMealy f = \g -> GenT $ f (unGen g)

-- | Takes the first number of values from the generator. Will turn an infinite
-- | generator into a finite generator.
takeGen :: forall f a. (Monad f) => Int -> GenT f a -> GenT f a
takeGen n = liftMealy $ Mealy.take n

-- | Drops a certain number of values from the generator. May produce
-- | an empty generator if called on a finite generator.
dropGen :: forall f a. (Monad f) => Int -> GenT f a -> GenT f a
dropGen n = liftMealy $ Mealy.drop n

-- | Extends a generator to produce *at least* the specified number of values.
-- | Will not turn a finite generator into an infinite one.
extend :: forall f a. (Monad f) => Int -> GenT f a -> GenT f a
extend n (GenT m) = (GenT $ loop 0 m) <> (GenT m)
  where m0 = m
        loop i m = Mealy.mealy \st ->
          let f Mealy.Halt       = if i >= n then pure Mealy.Halt else Mealy.stepMealy st (loop i m0)
              f (Mealy.Emit s m) = pure $ Mealy.Emit s (loop (i + 1) m)

          in  Mealy.stepMealy st m >>= f

-- | Fairly interleaves two generators.
interleave :: forall f a. (Monad f) => GenT f a -> GenT f a -> GenT f a
interleave (GenT g1) (GenT g2) = GenT $ Mealy.interleave g1 g2

-- | Ensures that a given generator can produce an infinite number of values,
-- | assuming it can produce at least one.
infinite :: forall f a. (Monad f) => GenT f a -> GenT f a
infinite = liftMealy $ Mealy.loop

-- | Folds over a generator to produce a value. Either the generator or the
-- | user-defined function may halt the fold. Returns not just the value
-- | created through folding, but also the successor generator.
foldGen' :: forall f a b. (Monad f) => (b -> a -> Maybe b) -> b -> GenState -> GenT f a -> f (Tuple b (GenT f a))
foldGen' f b s (GenT m) = loop s m b where
  loop st m b = Mealy.stepMealy st m >>= g
    where g Mealy.Halt                                        = pure $ Tuple b (GenT Mealy.halt)
          g (Mealy.Emit (GenOut { value = a, state = st }) m) = let b' = f b a in maybe (pure $ Tuple b (GenT m)) (loop st m) b'

-- | Folds over a generator to produce a value. Either the generator or the
-- | user-defined function may halt the fold.
foldGen :: forall f a b. (Monad f) => (b -> a -> Maybe b) -> b -> GenState -> GenT f a -> f b
foldGen f b s g = fst <$> foldGen' f b s g

-- | Transforms one gen into another, passing along user-supplied state.
-- | Either the generator being transformed or the transforming function may
-- | halt the transformation.
transGen :: forall f a b c. (Monad f) => (b -> a -> Tuple b (Maybe c)) -> b -> GenT f a -> GenT f c
transGen f b (GenT m) = GenT $ loop m b where
  loop m b = Mealy.mealy $ \st -> Mealy.stepMealy st m >>= g
    where g Mealy.Halt                                        = pure Mealy.Halt
          g (Mealy.Emit (GenOut { value = a, state = st }) m) = case f b a of
                                                                  Tuple b Nothing  -> Mealy.stepMealy st (loop m b)
                                                                  Tuple b (Just c) ->
                                                                    let c' = GenOut { value: c, state: st }
                                                                    in  pure $ Mealy.Emit c' (loop m b)

-- | A deterministic generator that produces all possible permutations of
-- | the specified array.
perms :: forall f a. (Monad f) => Array a -> GenT f (Array a)
perms arr =
  if A.length arr == 0
  then pure [ ]
  else do
    let hd = AU.head arr
        tl = AU.tail arr
    xs <- perms tl
    let f n = let prefix = A.take n xs
                  suffix = A.drop n xs
              in prefix <> [hd] <> suffix
    allInArray $ f <$> A.range 0 (A.length xs)

-- | A deterministic generator that produces all possible combinations of
-- | choosing exactly k elements from the specified array.
nChooseK :: forall f a. (Monad f) => Int -> Array a -> GenT f (Array a)
nChooseK k arr =
  if k == 0 then pure []
  else if A.length arr == 0
       then mempty
       else
         let tl = A.drop 1 arr
             hd = A.singleton $ AU.unsafeIndex arr 0
         in ((hd <>) <$> (nChooseK (k - 1) tl)) <> nChooseK k tl

-- | Same as `nChooseK` but for `List`
nChooseKL :: forall f a. (Monad f) => Int -> L.List a -> GenT f (L.List a)
nChooseKL 0 _ = pure L.Nil
nChooseKL _ L.Nil = mempty
nChooseKL k (L.Cons x xs) = (((L.singleton x) <>) <$> (nChooseKL (k - 1) xs)) <> nChooseKL k xs

-- | Filters a generator to produce only values satisfying the specified
-- | predicate.
suchThat :: forall f a. (Monad f) => GenT f a -> (a -> Boolean) -> GenT f a
suchThat g p = g `suchThatMaybe` p >>= maybe (sized next) return
  where
  next n = resize (n + 1) (g `suchThat` p)

-- | Tries to filter a generator such that it only produces values satisfying the
-- | specified predicate.
suchThatMaybe :: forall f a. (Monad f) => GenT f a -> (a -> Boolean) -> GenT f (Maybe a)
suchThatMaybe g p = sized $ try 0
  where
  try _ 0 = return Nothing
  try k n = do
    x <- resize (2 * k + n) g
    if p x then return (Just x) else try (k + 1) (n - 1)

-- | A deterministic generator that produces integers from the specified
-- | inclusive range, in sequence.
allInRange :: forall f a. (Monad f) => Int -> Int -> GenT f Int
allInRange min max = GenT $ go min where
  go cur = Mealy.pureMealy $ \s ->
    if cur > max
    then Mealy.Halt
    else Mealy.Emit (GenOut {state:s, value:cur}) (go (cur + 1))

-- | A deterministic generator that produces values from the specified array,
-- | in sequence.
allInArray :: forall f a. (Monad f) => Array a -> GenT f a
allInArray a = GenT $ go 0 where
  go i = Mealy.pureMealy $ \s ->
    maybe Mealy.Halt (\a -> Mealy.Emit (GenOut { state: s, value: a }) (go (i + 1))) (a A.!! i)

-- | Drains a finite generator of all values. Or blows up if you called it on
-- | an infinite generator.
collectAll :: forall f a. (Monad f) => GenState -> GenT f a -> f (Array a)
collectAll = foldGen f []
  where f v a = Just $ v <> [a]

-- | Applies a state to a generator to possibly produce the next state,
-- | a value, and the next generator.
applyGen :: forall f a. (Monad f) => GenState -> GenT f a -> f (Maybe (GenOut (Tuple a (GenT f a))))
applyGen s (GenT m) = f <$> Mealy.stepMealy s m where
  f Mealy.Halt = Nothing
  f (Mealy.Emit (GenOut { state = s, value = a }) m) = Just $ GenOut { state: s, value: Tuple a (GenT m)}

-- | Samples a generator, producing the specified number of values.
sample' :: forall f a. (Monad f) => Int -> GenState -> GenT f a -> f (Array a)
sample' n st g = fst <$> runGen n st g

-- | Samples a generator, producing the specified number of values. Uses
-- | default settings for the initial generator state.
sample :: forall f a. (Monad f) => Int -> GenT f a -> f (Array a)
sample n = sample' n (GenState { size: 10, seed: 4545645874.0 })

-- | Shows a sample of values generated from the specified generator.
showSample' :: forall r a. (Show a) => Int -> Gen a -> Eff (console :: CONSOLE | r) Unit
showSample' n g = print $ runTrampoline $ sample n g

-- | Shows a sample of values generated from the specified generator.
showSample :: forall r a. (Show a) => Gen a -> Eff (console :: CONSOLE | r) Unit
showSample = showSample' 10

-- | Runs a generator to produce a specified number of values, returning both
-- | an array containing the values and the successor Gen that can be used to
-- | continue the generation process at a later time.
runGen :: forall f a. (Monad f) => Int -> GenState -> GenT f a -> f (Tuple (Array a) (GenT f a))
runGen n st g = foldGen' f [] st (extend n g)
  where f v a = if A.length v < n
                then Just $ v <> [a]
                else Nothing

-- | Creates a generator that produces chunks of values in the specified size.
-- | Will extend the generator if necessary to produce a chunk of the specified
-- | size, but will not turn a finite generator into an infinite generator.
chunked :: forall f a. (Monad f) => Int -> GenT f a -> GenT f (Array a)
chunked n g = transGen f [] (extend n g) where
  f xs a = let xs' = a A.: xs
           in  if A.length xs' >= n then Tuple [] (Just xs') else Tuple xs' Nothing

-- | Wraps an effect in a generator that ignores the input state.
wrapEffect :: forall f a. (Monad f) => f a -> GenT f a
wrapEffect fa = GenT $ g <$> (id &&& (Mealy.wrapEffect fa)) where
  g (Tuple l r) = GenOut { state: l, value: r }

-- | Creates a generator that mixes up the order of the specified generator.
-- | This is achieved by chunking the generator with the specified size
-- | and then shuffling each chunk before continuing to the next.
shuffle' :: forall f a. (Monad f) => Int -> GenT f a -> GenT f a
shuffle' n g =
  do  chunks   <- chunked n g
      shuffled <- shuffleArray chunks
      allInArray shuffled

-- | Same as shuffle' but with default for the chunk size.
shuffle :: forall f a. (Monad f) => GenT f a -> GenT f a
shuffle = shuffle' 100

-- | Creates a generator that produces shuffled versions of the provided array.
shuffleArray :: forall f a. (Monad f) => Array a -> GenT f (Array a)
shuffleArray = shuffle0 [] where
  shuffle0 acc []  = pure $ acc
  shuffle0 acc xs  = do i <- chooseInt 0.0 (toNumber (A.length xs - 1))
                        let acc' = acc <> (maybe [] A.singleton (xs A.!! i))
                            xs' = fromMaybe xs $ A.deleteAt i xs
                        shuffle0 acc' xs'

-- | Converts the generator into a function that, given the initial state,
-- | returns a lazy list.
toLazyList :: forall a. Gen a -> GenState -> ListT.ListT Lazy a
toLazyList (GenT m) s = ListT.wrapLazy $ defer \_ -> loop m s where
  loop m s  = case runTrampoline (Mealy.stepMealy s m) of
                Mealy.Halt                                      -> ListT.nil
                Mealy.Emit (GenOut { value = a, state = s }) m  -> ListT.prepend' a (defer \_ -> loop m s)

instance semigroupGenState :: Semigroup GenState where
  append (GenState a) (GenState b) = GenState { seed: perturbNum a.seed b.seed, size: b.size }

instance monoidGenState :: Monoid GenState where
  mempty = GenState { seed: 0.0, size: 10 }

instance semigroupGenOut :: (Semigroup a) => Semigroup (GenOut a) where
  append (GenOut a) (GenOut b) = GenOut { state: a.state <> b.state, value: a.value <> b.value }

instance monoidGenOut :: (Monoid a) => Monoid (GenOut a) where
  mempty = GenOut { state: mempty, value: mempty }

instance functorGenOut :: Functor GenOut where
  map f (GenOut m) = GenOut { state: m.state, value: f m.value }

instance applyGenOut :: Apply GenOut where
  apply (GenOut f) (GenOut x) = GenOut { state: x.state, value: f.value x.value }

-- GenT instances
instance functorGenT :: (Monad f) => Functor (GenT f) where
  map f (GenT m) = GenT $ (<$>) f <$> m

instance applyGenT :: (Monad f) => Apply (GenT f) where
  apply f x = GenT $ do f <- unGen f
                        x <- unGen $ updateSeedGen x
                        return $ f <*> x

instance applicativeGenT :: (Monad f) => Applicative (GenT f) where
  pure t = GenT $ arr (\s -> GenOut { state: updateSeedState s, value: t })

instance semigroupGenT :: (Monad f) => Semigroup (GenT f a) where
  append (GenT a) (GenT b) = GenT (a <> b)

instance monoidGenT :: (Monad f) => Monoid (GenT f a) where
  mempty = GenT mempty

instance bindGenT :: (Monad f) => Bind (GenT f) where
  bind (GenT m) f = GenT $ do
    a <- m
    unGen $ updateSeedGen (f (unGenOut a).value)

instance monadGenT :: (Monad f) => Monad (GenT f)

instance altGenT :: (Monad f) => Alt (GenT f) where
  alt (GenT x) (GenT y) = GenT $ x <|> y

instance plusGenT :: (Monad f) => Plus (GenT f) where
  empty = mempty

instance alternativeGenT :: (Monad f) => Alternative (GenT f)

instance monadPlusGenT :: (Monad f) => MonadPlus (GenT f)

module Test.StrongCheck.Gen
  ( GenT(..)
  , Gen(..)
  , GenState(..)
  , GenOut(..)
  , Size()
  , Seed()
  , allInArray
  , allInRange
  , applyGen
  , arrayOf
  , arrayOf1
  , charGen
  , choose
  , chooseInt
  , chunked
  , collectAll
  , dropGen
  , elements
  , extend
  , foldGen
  , foldGen'
  , frequency
  , infinite
  , interleave
  , nChooseK
  , oneOf
  , perms
  , perturbGen
  , repeatable
  , resize
  , runGen
  , sample
  , sample'
  , showSample
  , showSample'
  , shuffle
  , shuffle'
  , shuffleArray
  , sized
  , stateful
  , suchThat
  , suchThatMaybe
  , takeGen
  , toLazyList
  , transGen
  , uniform
  , unGen
  , unGenOut
  , unGenState
  , updateSeedState
  , variant
  , vectorOf
  , wrapEffect
  ) where

import Prelude

import Control.Alt (Alt, (<|>))
import Control.Alternative (Alternative)
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Console (print, CONSOLE())
import Control.Monad.Trampoline (runTrampoline, Trampoline())
import Control.MonadPlus (MonadPlus)
import Control.Plus (Plus)
import Data.Char (fromCharCode)
import Data.Foldable (fold)
import Data.Int (fromNumber, toNumber)
import Data.Int.Bits (shl)
import Data.Lazy (Lazy(), defer)
import Data.Maybe (fromMaybe, maybe, Maybe(..))
import Data.Maybe.Unsafe (fromJust)
import Data.Monoid (mempty, Monoid)
import Data.Monoid.Additive (Additive(..), runAdditive)
import Data.Profunctor (arr, lmap)
import Data.Profunctor.Strong ((&&&))
import Data.Tuple (Tuple(..), snd, fst)

import qualified Control.Monad.List.Trans as ListT
import qualified Data.Array as A
import qualified Data.Array.Unsafe as AU
import qualified Data.List as L
import qualified Data.Machine.Mealy as Mealy

import qualified Math as M

type Size = Int
type Seed  = Number

data GenState = GenState { seed :: Seed, size :: Size }

unGenState :: GenState -> { seed :: Seed, size :: Size }
unGenState (GenState s) = s

stateM :: ({ seed :: Seed, size :: Size } -> { seed :: Seed, size :: Size }) -> GenState -> GenState
stateM f = GenState <<< f <<< unGenState

data GenOut a = GenOut { state :: GenState, value :: a }

unGenOut :: forall a. GenOut a -> { state :: GenState, value :: a }
unGenOut (GenOut v) = v

data GenT f a = GenT (Mealy.MealyT f GenState (GenOut a))

type Gen a = GenT Trampoline a

unGen :: forall f a. GenT f a -> Mealy.MealyT f GenState (GenOut a)
unGen (GenT m) = m

lcgM :: Seed
lcgM = 1103515245.0

lcgC :: Seed
lcgC = 12345.0

lcgN :: Seed
lcgN = toNumber $ 1 `shl` 30

lcgNext :: Seed -> Seed
lcgNext n = (lcgM * n + lcgC) M.% lcgN

lcgStep :: forall f. (Monad f) => GenT f Seed
lcgStep = GenT $ arr $ \s -> GenOut { state: updateSeedState s, value: (unGenState s).seed }

uniform :: forall f. (Monad f) => GenT f Seed
uniform = (\n -> n / toNumber (1 `shl` 30)) <$> lcgStep

stepGen :: forall f a. (Monad f) => GenState -> GenT f a -> f (Maybe (GenOut (Tuple a (GenT f a))))
stepGen st (GenT m) =   h <$> Mealy.stepMealy st m
                        where h Mealy.Halt        = Nothing
                              h (Mealy.Emit a m)  = Just $ flip Tuple (GenT m) <$> a

evalGen :: forall f a. (Monad f) => GenT f a -> GenState -> f (Maybe a)
evalGen g st = h <$> stepGen st g
                where h Nothing                               = Nothing
                      h (Just (GenOut { value = Tuple a _ })) = Just a

pureGen :: forall f a. (Monad f) => (GenState -> GenOut a) -> GenT f a
pureGen f = GenT $ arr f

repeatable' :: forall f a b. (Monad f) => (a -> GenT f b) -> GenT f (a -> f b)
repeatable' f = GenT $
  Mealy.pureMealy $ \s -> Mealy.Emit (GenOut { state: s, value: \a -> fromJust <$> evalGen (f a) s }) Mealy.halt

-- | Creates a function generator that will always generate the same output
-- | for the same input.
repeatable :: forall a b. (a -> Gen b) -> Gen (a -> b)
repeatable f = g <$> repeatable' f
               where g f' = \a -> runTrampoline $ f' a

-- | Creates a generator that depends on access to the generator state.
stateful :: forall f a. (Monad f) => (GenState -> GenT f a) -> GenT f a
stateful f = GenT $ do s <- Mealy.take 1 id
                       unGen (f s)

-- | Fixes a generator on a certain variant, given by the specified seed.
variant :: forall f a. (Monad f) => Seed -> GenT f a -> GenT f a
variant n g = GenT $ lmap (stateM (\s -> s { seed = n })) (unGen g)

-- | Creates a generator that depends on the size parameter.
sized :: forall f a. (Monad f) => (Size -> GenT f a) -> GenT f a
sized f = stateful $ \s -> f (unGenState s).size

-- | Resizes the generator so the size parameter passed into the generator
-- | will be equal to the specified size.
resize :: forall f a. (Monad f) => Size -> GenT f a -> GenT f a
resize sz g = GenT $ lmap (stateM (\s -> s { size = sz })) (unGen g)

-- | A generator for characters.
charGen :: forall f. (Monad f) => GenT f Char
charGen = fromCharCode <$> chooseInt 0.0 65535.0

-- | Creates a generator that generates real numbers between the specified
-- | inclusive range.
choose :: forall f. (Monad f) => Number -> Number -> GenT f Number
choose a b = (*) (max - min) >>> (+) min <$> uniform
  where min = M.min a b
        max = M.max a b

-- | Creates a generator that generates integers between the specified
-- | inclusive range.
chooseInt :: forall f. (Monad f) => Number -> Number -> GenT f Int
chooseInt a b =
  let min = M.ceil  (M.min a b)
      max = M.floor (M.max a b)
      numRes = ((+) (min - 0.5) <<< (*) (max - min + 1.0)) <$> uniform
      rounded = M.round <$> numRes
      intRes = fromNumber <$> rounded
  in fromMaybe 0 <$> intRes

-- | Creates a generator that chooses another generator from the specified list
-- | at random, and then generates a value with that generator.
oneOf :: forall f a. (Monad f) => GenT f a -> Array (GenT f a) -> GenT f a
oneOf x xs = do n <- chooseInt 0.0 (toNumber (A.length xs))
                if n == 0 then x else fromMaybe x (xs A.!! (n - 1))

-- | Generates elements by the specified frequencies (which will be normalized).
frequency :: forall f a. (Monad f) => Tuple Number (GenT f a) -> L.List (Tuple Number (GenT f a)) -> GenT f a
frequency x xs =
  let xxs :: L.List (Tuple Number (GenT f a))
      xxs   = L.Cons x xs

      total :: Number
      total = runAdditive $ fold ((Additive <<< fst) <$> xxs)

      pick :: Number -> GenT f a -> L.List (Tuple Number (GenT f a)) -> GenT f a
      pick _ d L.Nil = d
      pick n d (L.Cons (Tuple k x) xs) =
        if n <= k
        then x
        else pick (n - k) d xs

  in do n <- chooseInt 1.0 total
        pick (toNumber n) (snd x) xxs

-- | Creates a generator of elements ranging from 0 to the maximum size.
arrayOf :: forall f a. (Monad f) => GenT f a -> GenT f (Array a)
arrayOf g = sized $ \n ->
  do k <- chooseInt 0.0 (toNumber n)
     vectorOf k g

-- | Creates a generator of elements ranging from 1 to the maximum size.
arrayOf1 :: forall f a. (Monad f) => GenT f a -> GenT f (Tuple a (Array a))
arrayOf1 g = sized $ \n ->
  do k  <- chooseInt 0.0 (toNumber n)
     x  <- g
     xs <- vectorOf (k - 1) g
     return $ Tuple x xs

-- | Creates a generator that generates arrays of some specified size.
vectorOf :: forall f a. (Monad f) => Int -> GenT f a -> GenT f (Array a)
vectorOf n g = transGen f [] (extend n g)
  where f b a = let b' = b <> [a]
                in  if A.length b' >= n then Tuple [] (Just b') else Tuple b' Nothing

-- | Creates a generator that chooses an element from among a set of elements.
elements :: forall f a. (Monad f) => a -> L.List a -> GenT f a
elements x xs = do
  n <- chooseInt 0.0 (toNumber (L.length xs))
  pure if n == 0 then x else fromMaybe x (xs L.!! (n - 1))

foreign import float32ToInt32 :: Number -> Int

perturbGen :: forall f a. (Monad f) => Number -> GenT f a -> GenT f a
perturbGen n (GenT m) = GenT $ lmap (stateM (\s -> s { seed = perturbNum n s.seed })) m

perturbNum :: Number -> Seed -> Seed
perturbNum n = (+) $ lcgNext (toNumber (float32ToInt32 n))

updateSeedState :: GenState -> GenState
updateSeedState (GenState s) = GenState { seed: lcgNext s.seed, size: s.size }

updateSeedGen :: forall f a. (Monad f) => GenT f a -> GenT f a
updateSeedGen (GenT m) = GenT $ lmap updateSeedState m

liftMealy :: forall f a. (Monad f) => (Mealy.MealyT f GenState (GenOut a) -> Mealy.MealyT f GenState (GenOut a)) -> (GenT f a -> GenT f a)
liftMealy f = \g -> GenT $ f (unGen g)

-- | Takes the first number of values from the generator. Will turn an infinite
-- | generator into a finite generator.
takeGen :: forall f a. (Monad f) => Int -> GenT f a -> GenT f a
takeGen n = liftMealy $ Mealy.take n

-- | Drops a certain number of values from the generator. May produce
-- | an empty generator if called on a finite generator.
dropGen :: forall f a. (Monad f) => Int -> GenT f a -> GenT f a
dropGen n = liftMealy $ Mealy.drop n

-- | Extends a generator to produce *at least* the specified number of values.
-- | Will not turn a finite generator into an infinite one.
extend :: forall f a. (Monad f) => Int -> GenT f a -> GenT f a
extend n (GenT m) = (GenT $ loop 0 m) <> (GenT m)
  where m0 = m
        loop i m = Mealy.mealy \st ->
          let f Mealy.Halt       = if i >= n then pure Mealy.Halt else Mealy.stepMealy st (loop i m0)
              f (Mealy.Emit s m) = pure $ Mealy.Emit s (loop (i + 1) m)

          in  Mealy.stepMealy st m >>= f

-- | Fairly interleaves two generators.
interleave :: forall f a. (Monad f) => GenT f a -> GenT f a -> GenT f a
interleave (GenT g1) (GenT g2) = GenT $ Mealy.interleave g1 g2

-- | Ensures that a given generator can produce an infinite number of values,
-- | assuming it can produce at least one.
infinite :: forall f a. (Monad f) => GenT f a -> GenT f a
infinite = liftMealy $ Mealy.loop

-- | Folds over a generator to produce a value. Either the generator or the
-- | user-defined function may halt the fold. Returns not just the value
-- | created through folding, but also the successor generator.
foldGen' :: forall f a b. (Monad f) => (b -> a -> Maybe b) -> b -> GenState -> GenT f a -> f (Tuple b (GenT f a))
foldGen' f b s (GenT m) = loop s m b where
  loop st m b = Mealy.stepMealy st m >>= g
    where g Mealy.Halt                                        = pure $ Tuple b (GenT Mealy.halt)
          g (Mealy.Emit (GenOut { value = a, state = st }) m) = let b' = f b a in maybe (pure $ Tuple b (GenT m)) (loop st m) b'

-- | Folds over a generator to produce a value. Either the generator or the
-- | user-defined function may halt the fold.
foldGen :: forall f a b. (Monad f) => (b -> a -> Maybe b) -> b -> GenState -> GenT f a -> f b
foldGen f b s g = fst <$> foldGen' f b s g

-- | Transforms one gen into another, passing along user-supplied state.
-- | Either the generator being transformed or the transforming function may
-- | halt the transformation.
transGen :: forall f a b c. (Monad f) => (b -> a -> Tuple b (Maybe c)) -> b -> GenT f a -> GenT f c
transGen f b (GenT m) = GenT $ loop m b where
  loop m b = Mealy.mealy $ \st -> Mealy.stepMealy st m >>= g
    where g Mealy.Halt                                        = pure Mealy.Halt
          g (Mealy.Emit (GenOut { value = a, state = st }) m) = case f b a of
                                                                  Tuple b Nothing  -> Mealy.stepMealy st (loop m b)
                                                                  Tuple b (Just c) ->
                                                                    let c' = GenOut { value: c, state: st }
                                                                    in  pure $ Mealy.Emit c' (loop m b)

-- | A deterministic generator that produces all possible permutations of
-- | the specified array.
perms :: forall f a. (Monad f) => Array a -> GenT f (Array a)
perms arr =
  if A.length arr == 0
  then pure [ ]
  else do
    let hd = AU.head arr
        tl = AU.tail arr
    xs <- perms tl
    let f n = let prefix = A.take n xs
                  suffix = A.drop n xs
              in prefix <> [hd] <> suffix
    allInArray $ f <$> A.range 0 (A.length xs)

-- | A deterministic generator that produces all possible combinations of
-- | choosing exactly k elements from the specified array.
nChooseK :: forall f a. (Monad f) => Int -> Array a -> GenT f (Array a)
nChooseK k arr =
  if k == 0 then pure []
  else if A.length arr == 0
       then mempty
       else
         let tl = A.drop 1 arr
             hd = A.singleton $ AU.unsafeIndex arr 0
         in ((hd <>) <$> (nChooseK (k - 1) tl)) <> nChooseK k tl

-- | Same as `nChooseK` but for `List`
nChooseKL :: forall f a. (Monad f) => Int -> L.List a -> GenT f (L.List a)
nChooseKL 0 _ = pure L.Nil
nChooseKL _ L.Nil = mempty
nChooseKL k (L.Cons x xs) = (((L.singleton x) <>) <$> (nChooseKL (k - 1) xs)) <> nChooseKL k xs

-- | Filters a generator to produce only values satisfying the specified
-- | predicate.
suchThat :: forall f a. (Monad f) => GenT f a -> (a -> Boolean) -> GenT f a
suchThat g p = transGen f unit g where
  f _ a = Tuple unit $ if p a then Just a else Nothing

-- | Filters a generator to produce only values satisfying the specified
-- | predicate, but gives up and produces Nothing after the specified number
-- | of attempts.
suchThatMaybe :: forall f a. (Monad f) => Int -> GenT f a -> (a -> Boolean) -> GenT f (Maybe a)
suchThatMaybe n g p = transGen f 0 g where
  f i a = if p a
          then Tuple 0 (Just $ Just a)
          else if i >= n
               then Tuple 0 (Just Nothing)
               else Tuple (i + 1) Nothing

-- | A deterministic generator that produces integers from the specified
-- | inclusive range, in sequence.
allInRange :: forall f a. (Monad f) => Int -> Int -> GenT f Int
allInRange min max = GenT $ go min where
  go cur = Mealy.pureMealy $ \s ->
    if cur > max
    then Mealy.Halt
    else Mealy.Emit (GenOut {state:s, value:cur}) (go (cur + 1))

-- | A deterministic generator that produces values from the specified array,
-- | in sequence.
allInArray :: forall f a. (Monad f) => Array a -> GenT f a
allInArray a = GenT $ go 0 where
  go i = Mealy.pureMealy $ \s ->
    maybe Mealy.Halt (\a -> Mealy.Emit (GenOut { state: s, value: a }) (go (i + 1))) (a A.!! i)

-- | Drains a finite generator of all values. Or blows up if you called it on
-- | an infinite generator.
collectAll :: forall f a. (Monad f) => GenState -> GenT f a -> f (Array a)
collectAll = foldGen f []
  where f v a = Just $ v <> [a]

-- | Applies a state to a generator to possibly produce the next state,
-- | a value, and the next generator.
applyGen :: forall f a. (Monad f) => GenState -> GenT f a -> f (Maybe (GenOut (Tuple a (GenT f a))))
applyGen s (GenT m) = f <$> Mealy.stepMealy s m where
  f Mealy.Halt = Nothing
  f (Mealy.Emit (GenOut { state = s, value = a }) m) = Just $ GenOut { state: s, value: Tuple a (GenT m)}

-- | Samples a generator, producing the specified number of values.
sample' :: forall f a. (Monad f) => Int -> GenState -> GenT f a -> f (Array a)
sample' n st g = fst <$> runGen n st g

-- | Samples a generator, producing the specified number of values. Uses
-- | default settings for the initial generator state.
sample :: forall f a. (Monad f) => Int -> GenT f a -> f (Array a)
sample n = sample' n (GenState { size: 10, seed: 4545645874.0 })

-- | Shows a sample of values generated from the specified generator.
showSample' :: forall r a. (Show a) => Int -> Gen a -> Eff (console :: CONSOLE | r) Unit
showSample' n g = print $ runTrampoline $ sample n g

-- | Shows a sample of values generated from the specified generator.
showSample :: forall r a. (Show a) => Gen a -> Eff (console :: CONSOLE | r) Unit
showSample = showSample' 10

-- | Runs a generator to produce a specified number of values, returning both
-- | an array containing the values and the successor Gen that can be used to
-- | continue the generation process at a later time.
runGen :: forall f a. (Monad f) => Int -> GenState -> GenT f a -> f (Tuple (Array a) (GenT f a))
runGen n st g = foldGen' f [] st (extend n g)
  where f v a = if A.length v < n
                then Just $ v <> [a]
                else Nothing

-- | Creates a generator that produces chunks of values in the specified size.
-- | Will extend the generator if necessary to produce a chunk of the specified
-- | size, but will not turn a finite generator into an infinite generator.
chunked :: forall f a. (Monad f) => Int -> GenT f a -> GenT f (Array a)
chunked n g = transGen f [] (extend n g) where
  f xs a = let xs' = a A.: xs
           in  if A.length xs' >= n then Tuple [] (Just xs') else Tuple xs' Nothing

-- | Wraps an effect in a generator that ignores the input state.
wrapEffect :: forall f a. (Monad f) => f a -> GenT f a
wrapEffect fa = GenT $ g <$> (id &&& (Mealy.wrapEffect fa)) where
  g (Tuple l r) = GenOut { state: l, value: r }

-- | Creates a generator that mixes up the order of the specified generator.
-- | This is achieved by chunking the generator with the specified size
-- | and then shuffling each chunk before continuing to the next.
shuffle' :: forall f a. (Monad f) => Int -> GenT f a -> GenT f a
shuffle' n g =
  do  chunks   <- chunked n g
      shuffled <- shuffleArray chunks
      allInArray shuffled

-- | Same as shuffle' but with default for the chunk size.
shuffle :: forall f a. (Monad f) => GenT f a -> GenT f a
shuffle = shuffle' 100

-- | Creates a generator that produces shuffled versions of the provided array.
shuffleArray :: forall f a. (Monad f) => Array a -> GenT f (Array a)
shuffleArray = shuffle0 [] where
  shuffle0 acc []  = pure $ acc
  shuffle0 acc xs  = do i <- chooseInt 0.0 (toNumber (A.length xs - 1))
                        let acc' = acc <> (maybe [] A.singleton (xs A.!! i))
                            xs' = fromMaybe xs $ A.deleteAt i xs
                        shuffle0 acc' xs'

-- | Converts the generator into a function that, given the initial state,
-- | returns a lazy list.
toLazyList :: forall a. Gen a -> GenState -> ListT.ListT Lazy a
toLazyList (GenT m) s = ListT.wrapLazy $ defer \_ -> loop m s where
  loop m s  = case runTrampoline (Mealy.stepMealy s m) of
                Mealy.Halt                                      -> ListT.nil
                Mealy.Emit (GenOut { value = a, state = s }) m  -> ListT.prepend' a (defer \_ -> loop m s)

instance semigroupGenState :: Semigroup GenState where
  append (GenState a) (GenState b) = GenState { seed: perturbNum a.seed b.seed, size: b.size }

instance monoidGenState :: Monoid GenState where
  mempty = GenState { seed: 0.0, size: 10 }

instance semigroupGenOut :: (Semigroup a) => Semigroup (GenOut a) where
  append (GenOut a) (GenOut b) = GenOut { state: a.state <> b.state, value: a.value <> b.value }

instance monoidGenOut :: (Monoid a) => Monoid (GenOut a) where
  mempty = GenOut { state: mempty, value: mempty }

instance functorGenOut :: Functor GenOut where
  map f (GenOut m) = GenOut { state: m.state, value: f m.value }

instance applyGenOut :: Apply GenOut where
  apply (GenOut f) (GenOut x) = GenOut { state: x.state, value: f.value x.value }

-- GenT instances
instance functorGenT :: (Monad f) => Functor (GenT f) where
  map f (GenT m) = GenT $ (<$>) f <$> m

instance applyGenT :: (Monad f) => Apply (GenT f) where
  apply f x = GenT $ do f <- unGen f
                        x <- unGen $ updateSeedGen x
                        return $ f <*> x

instance applicativeGenT :: (Monad f) => Applicative (GenT f) where
  pure t = GenT $ arr (\s -> GenOut { state: updateSeedState s, value: t })

instance semigroupGenT :: (Monad f) => Semigroup (GenT f a) where
  append (GenT a) (GenT b) = GenT (a <> b)

instance monoidGenT :: (Monad f) => Monoid (GenT f a) where
  mempty = GenT mempty

instance bindGenT :: (Monad f) => Bind (GenT f) where
  bind (GenT m) f = GenT $ do
    a <- m
    unGen $ updateSeedGen (f (unGenOut a).value)

instance monadGenT :: (Monad f) => Monad (GenT f)

instance altGenT :: (Monad f) => Alt (GenT f) where
  alt (GenT x) (GenT y) = GenT $ x <|> y

instance plusGenT :: (Monad f) => Plus (GenT f) where
  empty = mempty

instance alternativeGenT :: (Monad f) => Alternative (GenT f)

instance monadPlusGenT :: (Monad f) => MonadPlus (GenT f)


Set() in Aff, error path

Set() in Aff, error path

module Test.Authorization where

import Prelude (Unit, bind, ($), map, show, pure)

import Control.Monad.Aff (forkAff,later', launchAff, attempt)
import Control.Monad.Aff.Par (Par(..), runPar)
import Control.Monad.Aff.AVar (AVAR(), makeVar, takeVar, putVar)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Exception (EXCEPTION(), message)
import Control.Alt ((<|>))
import Data.Either (either)
import Data.Maybe (Maybe(Just))
import Data.Foreign (toForeign)
import Web.Firebase.Types as FBT
import Web.Firebase (EventType(..),once, pushE, push)
import Test.Spec                  (describe, it, Spec())
import Test.Spec.Assertions       (shouldEqual)
import Test.Spec.Assertions.Aff (expectError)
import Web.Firebase.Monad.Aff as FAff

authorizationSpec :: forall eff. FBT.Firebase -> Spec (firebase :: FBT.FirebaseEff, err :: EXCEPTION, avar :: AVAR | eff ) Unit
authorizationSpec forbiddenRef = do
    describe "Understanding AVar and Par" do
      it "can write to a var" do
        respVar <- makeVar
        handle <- forkAff (later' 100 $ putVar respVar true)
        actual <- takeVar respVar
        actual `shouldEqual` true
      it "can race two vars manually" do
        respVar <- makeVar
        handle <- forkAff (later' 100 $ putVar respVar "fast")
        handleSlow <- forkAff (later' 200 $ putVar respVar "slow")
        actual <- takeVar respVar
        actual `shouldEqual` "fast"
      it "can race two vars with an alternative" do
        let fast = (later' 100 $ pure "fast")
            slow = (later' 200 $ pure "slow")
        actual <- runPar (Par fast <|> Par slow)
        actual `shouldEqual` "fast"
    describe "Authorization" do
      describe "Writing" do
        it "pushE() on forbidden location calls error callback" do
          respVar <- makeVar
          handle  <- liftEff $ pushE (toForeign {some: "object"}) (\err -> launchAff $ putVar respVar (map show err)) forbiddenRef
          actual <- takeVar respVar
          actual `shouldEqual` Just "PERMISSION_DENIED: Permission denied\n | firebase code: | \n PERMISSION_DENIED"
        it "push() on forbidden location calls error callback" do
          respVar <- makeVar
          handle  <- liftEff $ push (toForeign {some: "object"}) (Just (Just (\err -> launchAff $ putVar respVar (show err)))) forbiddenRef
          actual <- takeVar respVar
          actual `shouldEqual` "PERMISSION_DENIED: Permission denied\n | firebase code: | \n PERMISSION_DENIED"
        it "with Aff push on forbidden location throws an error" do
          let newValue = {success: "push Aff"}
          expectError $ FAff.push forbiddenRef (toForeign newValue)
      describe "once() on forbidden location" do
        it "with Eff calls an error callback" do
          respVar <- makeVar
          handle  <- liftEff $ once ChildAdded (\snap -> launchAff $ putVar respVar "unexpected sucess") (\_ -> launchAff $ putVar respVar "child forbidden") forbiddenRef
          actual <- takeVar respVar
          actual `shouldEqual` "child forbidden"
        it "with Aff throws an error" do
           e <- attempt $ FAff.onceValue forbiddenRef  -- catch error thrown and assert
           either (\err -> (message err) `shouldEqual` "permission_denied at /forbidden: Client doesn't have permission to access the desired data.\n | firebase code: | \n PERMISSION_DENIED") (\_ -> "expected an error to be thrown" `shouldEqual` "but was not") e
      describe "on() at forbidden location" do
        it "ChildAdded with Aff throws an error" do
          expectError $ FAff.on ChildAdded forbiddenRef
        it "ChildRemoved with Aff throws an error" do
          expectError $ FAff.on ChildRemoved forbiddenRef
        it "ChildChanged with Aff throws an error" do
          expectError $ FAff.on ChildChanged forbiddenRef
        it "ChildMoved with Aff throws an error" do
          expectError $ FAff.on ChildMoved forbiddenRef
      it "set() with Aff at forbidden location throws an error" do
        let newValue = {success: "set Aff"}
        e <- attempt $ FAff.set forbiddenRef (toForeign newValue)
        either (\err -> (message err) `shouldEqual` "PERMISSION_DENIED: Permission denied\n | firebase code: | \n PERMISSION_DENIED") (\_ -> "expected an error to be thrown" `shouldEqual` "but was not") e

{-   describe "Firebase API breaks its documentation" do
       it "once() throws an exeption when no error callback provided and an error occurs" do
          -- I prefer handling errors, but this is the firebase api...
          handle <- liftEff $ once ChildAdded (\_ -> pure unit) Nothing forbiddenRef
          "shoul get here" `shouldEqual` "should get here"
-}

module Test.Authorization where

import Prelude (Unit, bind, ($), map, show, pure)

import Control.Monad.Aff (forkAff,later', launchAff, attempt)
import Control.Monad.Aff.Par (Par(..), runPar)
import Control.Monad.Aff.AVar (AVAR(), makeVar, takeVar, putVar)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Exception (EXCEPTION(), message)
import Control.Alt ((<|>))
import Data.Either (either)
import Data.Maybe (Maybe(Just))
import Data.Foreign (toForeign)
import Web.Firebase.Types as FBT
import Web.Firebase (EventType(..),once, pushE, push)
import Test.Spec                  (describe, it, Spec())
import Test.Spec.Assertions       (shouldEqual)
import Test.Spec.Assertions.Aff (expectError)
import Web.Firebase.Monad.Aff as FAff

authorizationSpec :: forall eff. FBT.Firebase -> Spec (firebase :: FBT.FirebaseEff, err :: EXCEPTION, avar :: AVAR | eff ) Unit
authorizationSpec forbiddenRef = do
    describe "Understanding AVar and Par" do
      it "can write to a var" do
        respVar <- makeVar
        handle <- forkAff (later' 100 $ putVar respVar true)
        actual <- takeVar respVar
        actual `shouldEqual` true
      it "can race two vars manually" do
        respVar <- makeVar
        handle <- forkAff (later' 100 $ putVar respVar "fast")
        handleSlow <- forkAff (later' 200 $ putVar respVar "slow")
        actual <- takeVar respVar
        actual `shouldEqual` "fast"
      it "can race two vars with an alternative" do
        let fast = (later' 100 $ pure "fast")
            slow = (later' 200 $ pure "slow")
        actual <- runPar (Par fast <|> Par slow)
        actual `shouldEqual` "fast"
    describe "Authorization" do
      describe "Writing" do
        it "pushE() on forbidden location calls error callback" do
          respVar <- makeVar
          handle  <- liftEff $ pushE (toForeign {some: "object"}) (\err -> launchAff $ putVar respVar (map show err)) forbiddenRef
          actual <- takeVar respVar
          actual `shouldEqual` Just "PERMISSION_DENIED: Permission denied\n | firebase code: | \n PERMISSION_DENIED"
        it "push() on forbidden location calls error callback" do
          respVar <- makeVar
          handle  <- liftEff $ push (toForeign {some: "object"}) (Just (Just (\err -> launchAff $ putVar respVar (show err)))) forbiddenRef
          actual <- takeVar respVar
          actual `shouldEqual` "PERMISSION_DENIED: Permission denied\n | firebase code: | \n PERMISSION_DENIED"
        it "with Aff push on forbidden location throws an error" do
          let newValue = {success: "push Aff"}
          expectError $ FAff.push forbiddenRef (toForeign newValue)
      describe "once() on forbidden location" do
        it "with Eff calls an error callback" do
          respVar <- makeVar
          handle  <- liftEff $ once ChildAdded (\snap -> launchAff $ putVar respVar "unexpected sucess") (\_ -> launchAff $ putVar respVar "child forbidden") forbiddenRef
          actual <- takeVar respVar
          actual `shouldEqual` "child forbidden"
        it "with Aff throws an error" do
           e <- attempt $ FAff.onceValue forbiddenRef  -- catch error thrown and assert
           either (\err -> (message err) `shouldEqual` "permission_denied at /forbidden: Client doesn't have permission to access the desired data.\n | firebase code: | \n PERMISSION_DENIED") (\_ -> "expected an error to be thrown" `shouldEqual` "but was not") e
      describe "on() at forbidden location" do
        it "ChildAdded with Aff throws an error" do
          expectError $ FAff.on ChildAdded forbiddenRef
        it "ChildRemoved with Aff throws an error" do
          expectError $ FAff.on ChildRemoved forbiddenRef
        it "ChildChanged with Aff throws an error" do
          expectError $ FAff.on ChildChanged forbiddenRef
        it "ChildMoved with Aff throws an error" do
          expectError $ FAff.on ChildMoved forbiddenRef

{-   describe "Firebase API breaks its documentation" do
       it "once() throws an exeption when no error callback provided and an error occurs" do
          -- I prefer handling errors, but this is the firebase api...
          handle <- liftEff $ once ChildAdded (\_ -> pure unit) Nothing forbiddenRef
          "shoul get here" `shouldEqual` "should get here"
-}


Use triple quotes

Use triple quotes

module Control.Monad.JQuery where

import Data.Foreign
import Control.Monad.Eff

-- An effect type which indicates DOM manipulation
foreign import data DOM :: !

-- The jQuery wrapper type
foreign import data JQuery :: *

-- Type of jQuery event objects
foreign import data JQueryEvent :: *

-- $(document).ready(function() { ... })
foreign import ready
  """
  function ready(func) {
    return function () {
      jQuery(document).ready(func);
    };
  }
  """ :: forall eff a. Eff eff a -> Eff (dom :: DOM | eff) JQuery

-- Wrapper function for jQuery selection $('..')
foreign import select
  """
  function select(selector) {
    return function () {
      return jQuery(selector);
    };
  }
  """ :: forall eff. String -> Eff (dom :: DOM | eff) JQuery

-- .find(...)
foreign import find
  """
  function select(selector) {
    return function(ob) {
      return function () {
        return ob.find(selector);
      };
    };
  }
  """ :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .parent()
foreign import parent
  """
  function parent(ob) {
    return function () {
      return ob.parent();
    };
  }
  """ :: forall eff. JQuery -> Eff (dom :: DOM | eff) JQuery

-- .closest(...)
foreign import closest
  """
  function closest(selector) {
    return function(ob) {
      return function () {
        return ob.closest(selector);
      };
    };
  }
  """ :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- Wrapper function for jQuery creation e.g. $('<div>')
foreign import create
  """
  function create(html) {
    return function () {
      return jQuery(html);
    };
  }
  """ :: forall eff. String -> Eff (dom :: DOM | eff) JQuery

-- .attr({ ... })
foreign import setAttr
  """
  function setAttr(attr) {
    return function(val) {
      return function(ob) {
        return function () {
          return ob.attr(attr, val);
        };
      };
    };
  }
  """ :: forall eff a. String -> a -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .attr({ ... })
foreign import attr
  """
  function attr(attrs) {
    return function(ob) {
      return function () {
        return ob.attr(attrs);
      };
    };
  }
  """ :: forall eff attr. { | attr } -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .css({ ... })
foreign import css
  """
  function css(props) {
    return function(ob) {
      return function () {
        return ob.css(props);
      };
    };
  }
  """ :: forall eff css. { | css } -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .hasClass(...)
foreign import hasClass
  """
  function hasClass(cls) {
    return function(ob) {
      return function () {
        return ob.hasClass(cls);
      };
    };
  }
  """ :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) Boolean

-- .addClass(...)
foreign import addClass
  """
  function addClass(cls) {
    return function(ob) {
      return function () {
        return ob.addClass(cls);
      };
    };
  }
  """ :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .removeClass(...)
foreign import removeClass
  """
  function removeClass(cls) {
    return function(ob) {
      return function () {
        return ob.removeClass(cls);
      };
    };
  }
  """ :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .prop({ ... })
foreign import setProp
  """
  function setProp(p) {
    return function(val) {
      return function(ob) {
        return function () {
          return ob.prop(p, val);
        };
      };
    };
  }
  """ :: forall a eff. String -> a -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .prop({ ... })
foreign import getProp
  """
  function getProp(p) {
    return function(ob) {
      return function () {
        return ob.prop(p);
      };
    };
  }
  """ :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) Foreign

-- .append(...)
foreign import append
  """
  function append(ob1) {
    return function(ob) {
      return function () {
        return ob.append(ob1);
      };
    };
  }
  """ :: forall eff. JQuery -> JQuery -> Eff (dom :: DOM | eff) JQuery

foreign import appendAtIndex
  """
  function appendAtIndex(i) {
    return function(ob1) {
      return function(ob) {
        return function () {
          var children = ob.children();
          if (children.length > 0) {
            if (i <= 0) {
               ob.prepend(ob1);
            } else if (i >= children.length) {
               ob.append(ob1);
            } else {
               ob1.insertBefore(jQuery(children[i]));
            }
            return ob;
          } else {
            return ob.append(ob1);
          }
        };
      };
    };
  }
  """ :: forall eff. Number -> JQuery -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .remove()
foreign import remove
  """
  function remove(ob) {
    return function () {
      return ob.remove();
    };
  }
  """ :: forall eff. JQuery -> Eff (dom :: DOM | eff) JQuery

-- .empty()
foreign import clear
  """
  function clear(ob) {
    return function () {
      return ob.empty();
    };
  }
  """ :: forall eff. JQuery -> Eff (dom :: DOM | eff) JQuery

-- .before(...)
foreign import before
  """
  function before(ob) {
    return function(ob1) {
      return function () {
        return ob1.before(ob);
      };
    };
  }
  """ :: forall eff. JQuery -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .append(...)
foreign import appendText
  """
  function appendText(s) {
    return function(ob) {
      return function () {
        return ob.append(s);
      };
    };
  }
  """ :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- Get the document body
foreign import body
  """
  function body() {
    return jQuery(document.body);
  }
  """ :: forall eff. Eff (dom :: DOM | eff) JQuery

-- Get the text content of an element
foreign import getText
  """
  function getText(ob) {
    return function() {
      return ob.text();
    };
  }
  """ :: forall eff. JQuery -> Eff (dom :: DOM | eff) String

-- Set the text content of an element
foreign import setText
  """
  function setText(text) {
    return function(ob) {
      return function() {
        return ob.text(text);
      };
    };
  }
  """ :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- Get the value of a text field
foreign import getValue
  """
  function getValue(ob) {
    return function() {
      return ob.val();
    };
  }
  """ :: forall eff. JQuery -> Eff (dom :: DOM | eff) Foreign

-- Set the value of a text field
foreign import setValue
  """
  function setValue(val) {
    return function(ob) {
      return function() {
        return ob.val(val);
      };
    };
  }
  """ :: forall eff a. a -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- Register an event handler
foreign import on
  """
  function on(evt) {
    return function(act) {
      return function(ob) {
        return function() {
          return ob.on(evt, function(e) {
            act(e)(jQuery(this))();
          });
        };
      };
    };
  }
  """ :: forall eff a. String -> (JQueryEvent -> JQuery -> Eff eff a) -> JQuery ->
         Eff (dom :: DOM | eff) JQuery

-- Register an event handler
foreign import on'
  """
  function on$prime(evt) {
    return function(sel) {
      return function(act) {
        return function(ob) {
          return function() {
            return ob.on(evt, sel, function(e) {
              act(e)(jQuery(this))();
            });
          };
        };
      };
    };
  }
  """ :: forall eff a. String -> String -> (JQueryEvent -> JQuery -> Eff eff a) -> JQuery ->
         Eff (dom :: DOM | eff) JQuery

foreign import preventDefault
  """
  function preventDefault(e) {
    return function() {
      e.preventDefault();
    };
  }
  """ :: forall eff. JQueryEvent -> Eff (dom :: DOM | eff) Unit

foreign import stopPropagation
  """
  function stopPropagation(e) {
    return function() {
      e.stopPropagation();
    };
  }
  """ :: forall eff. JQueryEvent -> Eff (dom :: DOM | eff) Unit

foreign import stopImmediatePropagation
  """
  function stopImmediatePropagation(e) {
    return function() {
      e.stopImmediatePropagation();
    };
  }
  """ :: forall eff. JQueryEvent -> Eff (dom :: DOM | eff) Unit

module Control.Monad.JQuery where

import Data.Foreign
import Control.Monad.Eff

-- An effect type which indicates DOM manipulation
foreign import data DOM :: !

-- The jQuery wrapper type
foreign import data JQuery :: *

-- Type of jQuery event objects
foreign import data JQueryEvent :: *

-- $(document).ready(function() { ... })
foreign import ready
  "function ready(func) { \
  \  return function () { \
  \    jQuery(document).ready(func); \
  \  }; \
  \}" :: forall eff a. Eff eff a -> Eff (dom :: DOM | eff) JQuery

-- Wrapper function for jQuery selection $('..')
foreign import select
  "function select(selector) { \
  \  return function () { \
  \    return jQuery(selector); \
  \  }; \
  \}" :: forall eff. String -> Eff (dom :: DOM | eff) JQuery

-- .find(...)
foreign import find
  "function select(selector) { \
  \  return function(ob) { \
  \    return function () { \
  \      return ob.find(selector); \
  \    }; \
  \  }; \
  \}" :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .parent()
foreign import parent
  "function parent(ob) { \
  \  return function () { \
  \    return ob.parent(); \
  \  }; \
  \}" :: forall eff. JQuery -> Eff (dom :: DOM | eff) JQuery

-- .closest(...)
foreign import closest
  "function closest(selector) { \
  \  return function(ob) { \
  \    return function () { \
  \      return ob.closest(selector); \
  \    }; \
  \  }; \
  \}" :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- Wrapper function for jQuery creation e.g. $('<div>')
foreign import create
  "function create(html) { \
  \  return function () { \
  \    return jQuery(html); \
  \  }; \
  \}" :: forall eff. String -> Eff (dom :: DOM | eff) JQuery

-- .attr({ ... })
foreign import setAttr
  "function setAttr(attr) { \
  \  return function(val) { \
  \    return function(ob) { \
  \      return function () { \
  \        return ob.attr(attr, val);\
  \      }; \
  \    }; \
  \  }; \
  \}" :: forall eff a. String -> a -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .attr({ ... })
foreign import attr
  "function attr(attrs) { \
  \  return function(ob) { \
  \    return function () { \
  \      return ob.attr(attrs);\
  \    }; \
  \  }; \
  \}" :: forall eff attr. { | attr } -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .css({ ... })
foreign import css
  "function css(props) { \
  \  return function(ob) { \
  \    return function () { \
  \      return ob.css(props); \
  \    }; \
  \  }; \
  \}" :: forall eff css. { | css } -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .hasClass(...)
foreign import hasClass
  "function hasClass(cls) { \
  \  return function(ob) { \
  \    return function () { \
  \      return ob.hasClass(cls); \
  \    }; \
  \  }; \
  \}" :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) Boolean

-- .addClass(...)
foreign import addClass
  "function addClass(cls) { \
  \  return function(ob) { \
  \    return function () { \
  \      return ob.addClass(cls); \
  \    }; \
  \  }; \
  \}" :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .removeClass(...)
foreign import removeClass
  "function removeClass(cls) { \
  \  return function(ob) { \
  \    return function () { \
  \      return ob.removeClass(cls); \
  \    }; \
  \  }; \
  \}" :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .prop({ ... })
foreign import setProp
  "function setProp(p) { \
  \  return function(val) { \
  \    return function(ob) { \
  \      return function () { \
  \        return ob.prop(p, val);\
  \      }; \
  \    }; \
  \  }; \
  \}" :: forall a eff. String -> a -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .prop({ ... })
foreign import getProp
  "function getProp(p) { \
  \  return function(ob) { \
  \    return function () { \
  \      return ob.prop(p);\
  \    }; \
  \  }; \
  \}" :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) Foreign

-- .append(...)
foreign import append
  "function append(ob1) { \
  \  return function(ob) { \
  \    return function () { \
  \      return ob.append(ob1); \
  \    }; \
  \  }; \
  \}" :: forall eff. JQuery -> JQuery -> Eff (dom :: DOM | eff) JQuery

foreign import appendAtIndex
  "function appendAtIndex(i) { \
  \  return function(ob1) { \
  \    return function(ob) { \
  \      return function () { \
  \        var children = ob.children();\
  \        if (children.length > 0) {\
  \          if (i <= 0) {\
  \             ob.prepend(ob1);\
  \          } else if (i >= children.length) {\
  \             ob.append(ob1);\
  \          } else {\
  \             ob1.insertBefore(jQuery(children[i]));\
  \          }\
  \          return ob;\
  \        } else {\
  \          return ob.append(ob1); \
  \        }\
  \      }; \
  \    }; \
  \  }; \
  \}" :: forall eff. Number -> JQuery -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .remove()
foreign import remove
  "function remove(ob) { \
  \  return function () { \
  \    return ob.remove(); \
  \  }; \
  \}" :: forall eff. JQuery -> Eff (dom :: DOM | eff) JQuery

-- .empty()
foreign import clear
  "function clear(ob) { \
  \  return function () { \
  \    return ob.empty(); \
  \  }; \
  \}" :: forall eff. JQuery -> Eff (dom :: DOM | eff) JQuery

-- .before(...)
foreign import before
  "function before(ob) { \
  \  return function(ob1) { \
  \    return function () { \
  \      return ob1.before(ob); \
  \    }; \
  \  }; \
  \}" :: forall eff. JQuery -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- .append(...)
foreign import appendText
  "function appendText(s) { \
  \  return function(ob) { \
  \    return function () { \
  \      return ob.append(s); \
  \    }; \
  \  }; \
  \}" :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- Get the document body
foreign import body
  "function body() { \
  \  return jQuery(document.body); \
  \}" :: forall eff. Eff (dom :: DOM | eff) JQuery

-- Get the text content of an element
foreign import getText
  "function getText(ob) { \
  \  return function() { \
  \    return ob.text(); \
  \  }; \
  \}" :: forall eff. JQuery -> Eff (dom :: DOM | eff) String

-- Set the text content of an element
foreign import setText
  "function setText(text) { \
  \  return function(ob) { \
  \    return function() { \
  \      return ob.text(text); \
  \    };\
  \  };\
  \}" :: forall eff. String -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- Get the value of a text field
foreign import getValue
  "function getValue(ob) { \
  \  return function() { \
  \    return ob.val(); \
  \  }; \
  \}" :: forall eff. JQuery -> Eff (dom :: DOM | eff) Foreign

-- Set the value of a text field
foreign import setValue
  "function setValue(val) { \
  \  return function(ob) { \
  \    return function() { \
  \      return ob.val(val); \
  \    }; \
  \  }; \
  \}" :: forall eff a. a -> JQuery -> Eff (dom :: DOM | eff) JQuery

-- Register an event handler
foreign import on
  "function on(evt) { \
  \  return function(act) { \
  \    return function(ob) { \
  \      return function() { \
  \        return ob.on(evt, function(e) { \
  \          act(e)(jQuery(this))(); \
  \        }); \
  \      }; \
  \    }; \
  \  }; \
  \}" :: forall eff a. String -> (JQueryEvent -> JQuery -> Eff eff a) -> JQuery ->
         Eff (dom :: DOM | eff) JQuery

-- Register an event handler
foreign import on'
  "function on$prime(evt) { \
  \  return function(sel) { \
  \    return function(act) { \
  \      return function(ob) { \
  \        return function() { \
  \          return ob.on(evt, sel, function(e) { \
  \            act(e)(jQuery(this))(); \
  \          }); \
  \        }; \
  \      }; \
  \    }; \
  \  }; \
  \}" :: forall eff a. String -> String -> (JQueryEvent -> JQuery -> Eff eff a) -> JQuery ->
         Eff (dom :: DOM | eff) JQuery

foreign import preventDefault
  "function preventDefault(e) { \
  \  return function() { \
  \    e.preventDefault(); \
  \ } \
  \}" :: forall eff. JQueryEvent -> Eff (dom :: DOM | eff) Unit

foreign import stopPropagation
  "function stopPropagation(e) { \
  \  return function() { \
  \    e.stopPropagation(); \
  \ } \
  \}" :: forall eff. JQueryEvent -> Eff (dom :: DOM | eff) Unit

foreign import stopImmediatePropagation
  "function stopImmediatePropagation(e) { \
  \  return function() { \
  \    e.stopImmediatePropagation(); \
  \ } \
  \}" :: forall eff. JQueryEvent -> Eff (dom :: DOM | eff) Unit


Add loading convenience method

Add loading convenience method

Original commit b4ee7032b1ab48d739d73c4cbb0c012f7e6cc754

module CSharp
    ( renderer
    ) where

import Doc
import IR
import Prelude
import Types

import Data.Foldable (for_, intercalate)
import Data.List (List, (:))
import Data.List as L
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.String.Util (capitalize, camelCase)
import Data.Tuple as Tuple

renderer :: Renderer
renderer =
    { name: "C#"
    , aceMode: "csharp"
    , render: renderCSharp
    }

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType _ = false

nullableFromSet :: Set.Set IRType -> Maybe IRType
nullableFromSet s =
    case L.fromFoldable s of
    IRNull : x : L.Nil -> Just x
    x : IRNull : L.Nil -> Just x
    _ -> Nothing

renderUnionToCSharp :: Set.Set IRType -> String
renderUnionToCSharp s =
    case nullableFromSet s of
    Just x -> if isValueType x then renderTypeToCSharp x <> "?" else renderTypeToCSharp x
    Nothing -> "Either<" <> intercalate ", " (Set.map renderTypeToCSharp s) <> ">"

renderTypeToCSharp :: IRType -> String
renderTypeToCSharp = case _ of
    IRNothing -> "object"
    IRNull -> "object"
    IRInteger -> "int"
    IRDouble -> "double"
    IRBool -> "bool"
    IRString -> "string"
    IRArray a -> renderTypeToCSharp a <> "[]"
    IRClass (IRClassData name _) -> csNameStyle name
    IRUnion types -> renderUnionToCSharp types

renderCSharp :: L.List IRClassData -> Doc Unit
renderCSharp classes = do
    line "namespace QuickType"
    line "{"
    blank
    indent do
        line "using System.Net;"
        line "using Newtonsoft.Json;"
        blank
        for_ classes \cls -> do
            renderCSharpClass cls
            blank
    line "}"

csNameStyle :: String -> String
csNameStyle = camelCase >>> capitalize

renderCSharpClass :: IRClassData -> Doc Unit
renderCSharpClass (IRClassData name properties) = do
    line $ words ["class", csNameStyle name]
    line "{"
    indent do

        -- TODO don't rely on 'TopLevel'
        when (name == "TopLevel") do
            line "public static TopLevel LoadFromUrl(string url)"
            line "{"
            indent do
                line "var json = new WebClient().DownloadString(url);"
                line "return JsonConvert.DeserializeObject<TopLevel>(json);"
            line "}"
            blank

        for_ (Map.toUnfoldable properties :: Array _) \(Tuple.Tuple pname ptype) -> do
            line do
                string "[JsonProperty(\""
                string pname
                string "\")]"
            line do
                string "public "
                string $ renderTypeToCSharp ptype
                words ["", csNameStyle pname, "{ get; set; }"]
                blank
    line "}"

module CSharp
    ( renderer
    ) where

import Doc
import IR
import Prelude
import Types

import Data.Foldable (for_, intercalate)
import Data.List (List, (:))
import Data.List as L
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.String.Util (capitalize, camelCase)
import Data.Tuple as Tuple

renderer :: Renderer
renderer =
    { name: "C#"
    , aceMode: "csharp"
    , render: renderCSharp
    }

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType _ = false

nullableFromSet :: Set.Set IRType -> Maybe IRType
nullableFromSet s =
    case L.fromFoldable s of
    IRNull : x : L.Nil -> Just x
    x : IRNull : L.Nil -> Just x
    _ -> Nothing

renderUnionToCSharp :: Set.Set IRType -> String
renderUnionToCSharp s =
    case nullableFromSet s of
    Just x -> if isValueType x then renderTypeToCSharp x <> "?" else renderTypeToCSharp x
    Nothing -> "Either<" <> intercalate ", " (Set.map renderTypeToCSharp s) <> ">"

renderTypeToCSharp :: IRType -> String
renderTypeToCSharp = case _ of
    IRNothing -> "object"
    IRNull -> "object"
    IRInteger -> "int"
    IRDouble -> "double"
    IRBool -> "bool"
    IRString -> "string"
    IRArray a -> renderTypeToCSharp a <> "[]"
    IRClass (IRClassData name _) -> csNameStyle name
    IRUnion types -> renderUnionToCSharp types

renderCSharp :: L.List IRClassData -> Doc Unit
renderCSharp classes = do
    line "namespace QuickType"
    line "{"
    blank

    indent do
        line "using Newtonsoft.Json;"
        blank
        for_ classes \cls -> do
            renderCSharpClass cls
            blank
    line "}"

csNameStyle :: String -> String
csNameStyle = camelCase >>> capitalize

renderCSharpClass :: IRClassData -> Doc Unit
renderCSharpClass (IRClassData name properties) = do
    line $ words ["class", csNameStyle name]
    line "{"
    indent do
        for_ (Map.toUnfoldable properties :: Array _) \(Tuple.Tuple pname ptype) -> do
            line do
                string "[JsonProperty(\""
                string pname
                string "\")]"
            line do
                string "public "
                string $ renderTypeToCSharp ptype
                words ["", csNameStyle pname, "{ get; set; }"]
                blank
    line "}"


Rename some aspects of the component example

module Container where

import Prelude
import Data.Maybe (Maybe(..), maybe)
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Button as Button

data Query a
  = HandleButton Button.Message a
  | CheckButtonState a

type State =
  { toggleCount :: Int
  , buttonState :: Maybe Boolean
  }

data Slot = ButtonSlot
derive instance eqButtonSlot :: Eq Slot
derive instance ordButtonSlot :: Ord Slot

component :: forall m. H.Component HH.HTML Query Unit Void m
component =
  H.parentComponent
    { initialState: const initialState
    , render
    , eval
    , receiver: const Nothing
    }
  where

  initialState :: State
  initialState =
    { toggleCount: 0
    , buttonState: Nothing }

  render :: State -> H.ParentHTML Query Button.Query Slot m
  render state =
    HH.div_
      [ HH.slot ButtonSlot Button.myButton unit (HE.input HandleButton)
      , HH.p_
          [ HH.text ("Button has been toggled " <> show state.toggleCount <> " time(s)") ]
      , HH.p_
          [ HH.text
              $ "Last time I checked, the button was: "
              <> (maybe "(not checked yet)" (if _ then "on" else "off") state.buttonState)
              <> ". "
          , HH.button
              [ HE.onClick (HE.input_ CheckButtonState) ]
              [ HH.text "Check now" ]
          ]
      ]

  eval :: Query ~> H.ParentDSL State Query Button.Query Slot Void m
  eval = case _ of
    HandleButton (Button.Toggled _) next -> do
      H.modify (\st -> st { toggleCount = st.toggleCount + 1 })
      pure next
    CheckButtonState next -> do
      buttonState <- H.query ButtonSlot $ H.request Button.IsOn
      H.modify (_ { buttonState = buttonState })
      pure next

module Container where

import Prelude
import Data.Maybe (Maybe(..), maybe)
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Button as Button

data Query a
  = HandleButton Button.Message a
  | CheckButtonState a

type State =
  { toggleCount :: Int
  , buttonState :: Maybe Boolean
  }

data Slot = Button
derive instance eqTickSlot :: Eq Slot
derive instance ordTickSlot :: Ord Slot

component :: forall m. H.Component HH.HTML Query Unit Void m
component =
  H.parentComponent
    { initialState: const initialState
    , render
    , eval
    , receiver: const Nothing
    }
  where

  initialState :: State
  initialState =
    { toggleCount: 0
    , buttonState: Nothing }

  render :: State -> H.ParentHTML Query Button.Query Slot m
  render state =
    HH.div_
      [ HH.slot Button Button.myButton unit (HE.input HandleButton)
      , HH.p_
          [ HH.text ("Button has been toggled " <> show state.toggleCount <> " time(s)") ]
      , HH.p_
          [ HH.text
              $ "Last time I checked, the button was: "
              <> (maybe "(not checked yet)" (if _ then "on" else "off") state.buttonState)
              <> ". "
          , HH.button
              [ HE.onClick (HE.input_ CheckButtonState) ]
              [ HH.text "Check now" ]
          ]
      ]

  eval :: Query ~> H.ParentDSL State Query Button.Query Slot Void m
  eval = case _ of
    HandleButton (Button.Toggled _) next -> do
      H.modify (\st -> st { toggleCount = st.toggleCount + 1 })
      pure next
    CheckButtonState next -> do
      buttonState <- H.query Button $ H.request Button.IsOn
      H.modify (_ { buttonState = buttonState })
      pure next


Simplify application parser

Simplify application parser

module Lambda.Language.Parse
  ( parseAll
  , parseStatement
  , parseDefinition
  , parseExpression
  , unsafeParse
  , formatParseError
  , module X
  ) where

import Lambda.Prelude hiding (between)

import Control.Lazy (fix)
import Data.Array as Array
import Data.Int (fromString)
import Data.Maybe (fromJust)
import Data.String.CodeUnits (fromCharArray)
import Lambda.Language.Name (Name, isSubscriptChar, name, name_, subscriptToInt)
import Lambda.Language.Syntax (Statement(..), Definition(..), Expression(..))
import Partial.Unsafe (unsafeCrashWith, unsafePartial)
import Text.Parsing.Parser (ParseError) as X
import Text.Parsing.Parser (ParseError, Parser, parseErrorMessage, parseErrorPosition, runParser)
import Text.Parsing.Parser.Combinators (between, sepBy, try)
import Text.Parsing.Parser.Pos (Position(..))
import Text.Parsing.Parser.String (char, eof, satisfy, skipSpaces, string)

-- | Run a parser and then consume all trailing space
parseAll :: forall a. Parser String a -> String -> Either ParseError a
parseAll p s = runParser s (skipSpaces *> p <* eof)

-- | Run a parser, crashing if it fails to parse the input. Use this
-- | only for trusted input, e.g. in tests or default definitions.
unsafeParse :: forall a. Parser String a -> String -> a
unsafeParse p s = case parseAll p s of
  Left err ->
    let { message, source, caret } = formatParseError s err
    in unsafeCrashWith $ Array.intercalate "\n"
      [ message
      , source
      , caret
      ]
  Right a -> a

-- | Format a parse error to highlight the position where the malformed
-- | input was encountered.
formatParseError :: String -> ParseError -> { message :: String, source :: String, caret :: String }
formatParseError text err =
  { message: "Parse error: " <> message <> " at column " <> show column
  , source: text
  , caret: caret
  }
 where
  message = parseErrorMessage err
  column = positionColumn $ parseErrorPosition err
  caret = fromCharArray (Array.replicate (column - 1) ' ') <> "^"

-- | Project column from `Position`
positionColumn :: Position -> Int
positionColumn (Position {column}) = column

-- | Parse a `Definition` or an expression
parseStatement :: Parser String Statement
parseStatement = try (Define <$> parseDefinition) <|> (Eval <$> parseExpression)

-- | Parse a `Definition`
-- |
-- | ```ebnf
-- | definition
-- |   = name, {name}, "=", expression ;          (* Definition *)
-- | ```
-- |
parseDefinition :: Parser String Definition
parseDefinition = map Definition
  $ {name:_, args:_, expr:_}
  <$> parseName
  <*> Array.many parseName
  <*> (token (string "=") *> parseExpression)

-- | Parse an expression
-- |
-- | ```ebnf
-- |
-- | expression
-- |   = lambda, name, {name}, ".", expression    (* Lambda abstraction *)
-- |   | name                                     (* Variable *)
-- |   | expression, expression                   (* Application *)
-- |   | "(", expression, ")"                     (* Parentheses *)
-- |   | {digit}                                  (* Natural number *)
-- |   | "[", [expressions], "]"                  (* List *)
-- |   ;
-- |
-- | expressions
-- |   = expression, [",", expressions] ;         (* One or more comma-separated expressions *)
-- |
-- | lambda
-- |   = "\"                                      (* Backslash *)
-- |   | "λ"                                      (* Greek letter lambda *)
-- |   ;
-- | ```
-- |
parseExpression :: Parser String Expression
parseExpression = fix \parseExpr -> foldl Apply
  <$> parseAtom parseExpr
  <*> Array.many (parseAtom parseExpr)

parseAtom :: Parser String Expression -> Parser String Expression
parseAtom parseExpr =
  parseLambda <|> parseNat <|> parseList parseExpr <|> parens parseExpr <|> parseVar
 where
  parseLambda :: Parser String Expression
  parseLambda = do
    void $ token $ string "\\" <|> string "λ"
    names <- Array.some parseName
    void $ token $ string "."
    body <- parseExpr
    pure $ foldr Lambda body names

-- | Apply a parser between two grouping characters.
balance :: forall a. Char -> Char -> Parser String a -> Parser String a
balance lhs rhs = between (token (char lhs)) (token (char rhs))

-- | Apply a parser between parens.
parens :: forall a. Parser String a -> Parser String a
parens = balance '(' ')'

-- | Apply a parser between brackets.
brackets :: forall a. Parser String a -> Parser String a
brackets = balance '[' ']'

-- | Convert comma-delimited list to Church-encoded list.
toList :: List Expression -> Expression
toList xs =
  Lambda cons (Lambda nil (loop xs))
 where
  cons = name_ "cons"
  nil = name_ "nil"
  loop Nil = Var nil
  loop (Cons y ys) = Apply (Apply (Var cons) y) (loop ys)

-- | Convert a natural number to a Church numeral
toChurch :: Int -> Expression
toChurch n =
  Lambda s (Lambda z (loop n))
 where
  s = name_ "s"
  z = name_ "z"
  loop k
    | k <= 0 = Var z
    | otherwise = Apply (Var s) (loop (k - 1))

-- | Parse a natural number.
parseNat :: Parser String Expression
parseNat = token do
  digits <- Array.some $ satisfy isDigit
  let n = unsafePartial $ fromJust $ fromString $ fromCharArray digits
  pure $ toChurch n

-- | Parse a comma-separated list between brackets.
parseList :: Parser String Expression -> Parser String Expression
parseList p = toList <$> brackets (p `sepBy` token (char ','))

-- | Parse a variable.
parseVar :: Parser String Expression
parseVar = Var <$> parseName

-- | Parse a `Name`. This is one of the more complicated parsers,
-- | because I have absolutely no chill, apparently.
-- |
-- | ```ebnf
-- | name
-- |   = (letter | "_")                           (* Initial letter or underscore *)
-- |   , {letter | "-"}                           (* Zero or more letters or hyphens *)
-- |   , ["?"]                                    (* Optional question mark *)
-- |   , {subscript | digit}                      (* Zero or more subscripts or digits *)
-- |   ;
-- |
-- | letter                                       (* Lowercase latin letters *)
-- |   = "a" | "b" | "c" | "d" | "e" | "f" | "g"
-- |   | "h" | "i" | "j" | "k" | "l" | "m" | "n"
-- |   | "o" | "p" | "q" | "r" | "s" | "t" | "u"
-- |   | "v" | "w" | "x" | "y" | "z" ;
-- |
-- | subscript                                    (* Subscripts *)
-- |   = "₀" | "₁" | "₂" | "₃" | "₄" | "₅" | "₆"
-- |   | "₇" | "₈" | "₉" ;
-- |
-- | digit                                        (* Decimal digits *)
-- |   = "0" | "1" | "2" | "3" | "4" | "5" | "6"
-- |   | "7" | "8" | "9" ;
-- | ```
-- |
parseName :: Parser String Name
parseName = token do
  first <- satisfy firstChar
  body <- Array.many $ satisfy bodyChar
  question <- string "?" <|> pure ""
  subscript <- Just <$> parseSubscript <|> pure Nothing
  let var = fromCharArray ([first] <> body) <> question
  pure $ name var subscript

-- | Parse subscripts for a `Name`
parseSubscript :: Parser String Int
parseSubscript = subscriptToInt <<< fromCharArray <$> Array.some (satisfy isSubscriptChar)

-- | Parse the first character of a `Name`
firstChar :: Char -> Boolean
firstChar c = isLower c || c == '_'

-- | Parse the remaining (non-question-mark, non-subscript-y)
-- | characters of a `Name`.
bodyChar :: Char -> Boolean
bodyChar c = isLower c || c == '-'

-- | Is a character a decimal digit?
isDigit :: Char -> Boolean
isDigit c = '0' <= c && c <= '9'

-- | Is a character a lowercase letter?
isLower :: Char -> Boolean
isLower c = 'a' <= c && c <= 'z'

-- | Extend a parser to consume trailing whitespace
token :: forall a. Parser String a -> Parser String a
token p = p <* skipSpaces

module Lambda.Language.Parse
  ( parseAll
  , parseStatement
  , parseDefinition
  , parseExpression
  , unsafeParse
  , formatParseError
  , module X
  ) where

import Lambda.Prelude hiding (between)

import Control.Lazy (fix)
import Data.Array as Array
import Data.Int (fromString)
import Data.Maybe (fromJust)
import Data.String.CodeUnits (fromCharArray)
import Lambda.Language.Name (Name, isSubscriptChar, name, name_, subscriptToInt)
import Lambda.Language.Syntax (Statement(..), Definition(..), Expression(..))
import Partial.Unsafe (unsafeCrashWith, unsafePartial)
import Text.Parsing.Parser (ParseError) as X
import Text.Parsing.Parser (ParseError, Parser, parseErrorMessage, parseErrorPosition, runParser)
import Text.Parsing.Parser.Combinators (between, sepBy, try)
import Text.Parsing.Parser.Pos (Position(..))
import Text.Parsing.Parser.String (char, eof, satisfy, skipSpaces, string)

-- | Run a parser and then consume all trailing space
parseAll :: forall a. Parser String a -> String -> Either ParseError a
parseAll p s = runParser s (skipSpaces *> p <* eof)

-- | Run a parser, crashing if it fails to parse the input. Use this
-- | only for trusted input, e.g. in tests or default definitions.
unsafeParse :: forall a. Parser String a -> String -> a
unsafeParse p s = case parseAll p s of
  Left err ->
    let { message, source, caret } = formatParseError s err
    in unsafeCrashWith $ Array.intercalate "\n"
      [ message
      , source
      , caret
      ]
  Right a -> a

-- | Format a parse error to highlight the position where the malformed
-- | input was encountered.
formatParseError :: String -> ParseError -> { message :: String, source :: String, caret :: String }
formatParseError text err =
  { message: "Parse error: " <> message <> " at column " <> show column
  , source: text
  , caret: caret
  }
 where
  message = parseErrorMessage err
  column = positionColumn $ parseErrorPosition err
  caret = fromCharArray (Array.replicate (column - 1) ' ') <> "^"

-- | Project column from `Position`
positionColumn :: Position -> Int
positionColumn (Position {column}) = column

-- | Parse a `Definition` or an expression
parseStatement :: Parser String Statement
parseStatement = try (Define <$> parseDefinition) <|> (Eval <$> parseExpression)

-- | Parse a `Definition`
-- |
-- | ```ebnf
-- | definition
-- |   = name, {name}, "=", expression ;          (* Definition *)
-- | ```
-- |
parseDefinition :: Parser String Definition
parseDefinition = map Definition
  $ {name:_, args:_, expr:_}
  <$> parseName
  <*> Array.many parseName
  <*> (token (string "=") *> parseExpression)

-- | Parse an expression
-- |
-- | ```ebnf
-- |
-- | expression
-- |   = lambda, name, {name}, ".", expression    (* Lambda abstraction *)
-- |   | name                                     (* Variable *)
-- |   | expression, expression                   (* Application *)
-- |   | "(", expression, ")"                     (* Parentheses *)
-- |   | {digit}                                  (* Natural number *)
-- |   | "[", [expressions], "]"                  (* List *)
-- |   ;
-- | expressions
-- |   = expression, [",", expressions] ;         (* One or more comma-separated expressions *)
-- |
-- | lambda
-- |   = "\"                                      (* Backslash *)
-- |   | "λ"                                      (* Greek letter lambda *)
-- |   ;
-- | ```
-- |
parseExpression :: Parser String Expression
parseExpression =
  fix parseApply
 where
  parseApply p = do
    first <- parseAtom
    rest <- Array.many parseAtom
    case rest of
      [] -> pure first
      _  -> pure (foldl Apply first rest)
   where
    parseAtom :: Parser String Expression
    parseAtom = parseLambda <|> parseNat <|> parseList p <|> parens p <|> parseVar

    parseLambda :: Parser String Expression
    parseLambda = do
      void $ token $ string "\\" <|> string "λ"
      names <- Array.some parseName
      void $ token $ string "."
      body <- p
      pure $ foldr Lambda body names

-- | Apply a parser between two grouping characters.
balance :: forall a. Char -> Char -> Parser String a -> Parser String a
balance lhs rhs = between (token (char lhs)) (token (char rhs))

-- | Apply a parser between parens.
parens :: forall a. Parser String a -> Parser String a
parens = balance '(' ')'

-- | Apply a parser between brackets.
brackets :: forall a. Parser String a -> Parser String a
brackets = balance '[' ']'

-- | Convert comma-delimited list to Church-encoded list.
toList :: List Expression -> Expression
toList xs =
  Lambda cons (Lambda nil (loop xs))
 where
  cons = name_ "cons"
  nil = name_ "nil"
  loop Nil = Var nil
  loop (Cons y ys) = Apply (Apply (Var cons) y) (loop ys)

-- | Convert a natural number to a Church numeral
toChurch :: Int -> Expression
toChurch n =
  Lambda s (Lambda z (loop n))
 where
  s = name_ "s"
  z = name_ "z"
  loop k
    | k <= 0 = Var z
    | otherwise = Apply (Var s) (loop (k - 1))

-- | Parse a natural number.
parseNat :: Parser String Expression
parseNat = token do
  digits <- Array.some $ satisfy isDigit
  let n = unsafePartial $ fromJust $ fromString $ fromCharArray digits
  pure $ toChurch n

-- | Parse a comma-separated list between brackets.
parseList :: Parser String Expression -> Parser String Expression
parseList p = toList <$> brackets (p `sepBy` token (char ','))

-- | Parse a variable.
parseVar :: Parser String Expression
parseVar = Var <$> parseName

-- | Parse a `Name`. This is one of the more complicated parsers,
-- | because I have absolutely no chill, apparently.
-- |
-- | ```ebnf
-- | name
-- |   = (letter | "_")                           (* Initial letter or underscore *)
-- |   , {letter | "-"}                           (* Zero or more letters or hyphens *)
-- |   , ["?"]                                    (* Optional question mark *)
-- |   , {subscript | digit}                      (* Zero or more subscripts or digits *)
-- |   ;
-- |
-- | letter                                       (* Lowercase latin letters *)
-- |   = "a" | "b" | "c" | "d" | "e" | "f" | "g"
-- |   | "h" | "i" | "j" | "k" | "l" | "m" | "n"
-- |   | "o" | "p" | "q" | "r" | "s" | "t" | "u"
-- |   | "v" | "w" | "x" | "y" | "z" ;
-- |
-- | subscript                                    (* Subscripts *)
-- |   = "₀" | "₁" | "₂" | "₃" | "₄" | "₅" | "₆"
-- |   | "₇" | "₈" | "₉" ;
-- |
-- | digit                                        (* Decimal digits *)
-- |   = "0" | "1" | "2" | "3" | "4" | "5" | "6"
-- |   | "7" | "8" | "9" ;
-- | ```
-- |
parseName :: Parser String Name
parseName = token do
  first <- satisfy firstChar
  body <- Array.many $ satisfy bodyChar
  question <- string "?" <|> pure ""
  subscript <- Just <$> parseSubscript <|> pure Nothing
  let var = fromCharArray ([first] <> body) <> question
  pure $ name var subscript

-- | Parse subscripts for a `Name`
parseSubscript :: Parser String Int
parseSubscript = subscriptToInt <<< fromCharArray <$> Array.some (satisfy isSubscriptChar)

-- | Parse the first character of a `Name`
firstChar :: Char -> Boolean
firstChar c = isLower c || c == '_'

-- | Parse the remaining (non-question-mark, non-subscript-y)
-- | characters of a `Name`.
bodyChar :: Char -> Boolean
bodyChar c = isLower c || c == '-'

-- | Is a character a decimal digit?
isDigit :: Char -> Boolean
isDigit c = '0' <= c && c <= '9'

-- | Is a character a lowercase letter?
isLower :: Char -> Boolean
isLower c = 'a' <= c && c <= 'z'

-- | Extend a parser to consume trailing whitespace
token :: forall a. Parser String a -> Parser String a
token p = p <* skipSpaces


remove DateTime from InputType

remove DateTime from InputType

fixes #17

module Data.BrowserFeatures.InputType
  ( InputType(..)
  , renderInputType
  , allInputTypes
  ) where

import Prelude

data InputType
  = Color
  | Date
  | DateTimeLocal
  | Time
  | Month
  | Week
  | Email
  | Url
  | Number
  | Search
  | Range
  | Text

allInputTypes :: Array InputType
allInputTypes =
  [ Color
  , Date
  , DateTimeLocal
  , Time
  , Month
  , Week
  , Email
  , Url
  , Number
  , Search
  , Range
  , Text
  ]

derive instance eqInputType :: Eq InputType
derive instance ordInputType :: Ord InputType

instance showInputType :: Show InputType where
  show Color = "Color"
  show Date = "Date"
  show DateTimeLocal = "DateTimeLocal"
  show Time = "Time"
  show Month = "Month"
  show Week = "Week"
  show Email = "Email"
  show Url = "Url"
  show Number = "Number"
  show Search = "Search"
  show Range = "Range"
  show Text = "Text"

-- | Render an `InputType` into the corresponding value of the `type` attribute
-- | on an `input` element.
renderInputType :: InputType -> String
renderInputType Color = "color"
renderInputType Date = "date"
renderInputType DateTimeLocal = "datetime-local"
renderInputType Time = "time"
renderInputType Month = "month"
renderInputType Week = "week"
renderInputType Email = "email"
renderInputType Url = "url"
renderInputType Number = "number"
renderInputType Search = "search"
renderInputType Range = "range"
renderInputType Text = "text"

module Data.BrowserFeatures.InputType
  ( InputType(..)
  , renderInputType
  , allInputTypes
  ) where

import Prelude

data InputType
  = Color
  | Date
  | DateTime
  | DateTimeLocal
  | Time
  | Month
  | Week
  | Email
  | Url
  | Number
  | Search
  | Range
  | Text

allInputTypes :: Array InputType
allInputTypes =
  [ Color
  , Date
  , DateTime
  , DateTimeLocal
  , Time
  , Month
  , Week
  , Email
  , Url
  , Number
  , Search
  , Range
  , Text
  ]

derive instance eqInputType :: Eq InputType
derive instance ordInputType :: Ord InputType

instance showInputType :: Show InputType where
  show Color = "Color"
  show Date = "Date"
  show DateTime = "DateTime"
  show DateTimeLocal = "DateTimeLocal"
  show Time = "Time"
  show Month = "Month"
  show Week = "Week"
  show Email = "Email"
  show Url = "Url"
  show Number = "Number"
  show Search = "Search"
  show Range = "Range"
  show Text = "Text"

-- | Render an `InputType` into the corresponding value of the `type` attribute
-- | on an `input` element.
renderInputType :: InputType -> String
renderInputType Color = "color"
renderInputType Date = "date"
renderInputType DateTime = "datetime"
renderInputType DateTimeLocal = "datetime-local"
renderInputType Time = "time"
renderInputType Month = "month"
renderInputType Week = "week"
renderInputType Email = "email"
renderInputType Url = "url"
renderInputType Number = "number"
renderInputType Search = "search"
renderInputType Range = "range"
renderInputType Text = "text"