flare-test.purs

module Test.Main where

import Prelude (Applicative, Apply, Functor, Show, Unit(), (<*>), (<>), (<$>), ($), (<<<), id, bind, map, pure, return, unit)

import Control.Applicative.Free (FreeAp(), NaturalTransformation(), liftFreeAp, foldFreeAp)
import Control.Apply (lift2)
import Control.Monad.Eff (Eff())

import DOM (DOM())
import DOM.Node.Types (Element())

import Math (pow)

import Signal (Signal())
import Signal.Channel (Chan(), channel, send, subscribe)

import Unsafe.Coerce (unsafeCoerce)

data Flare a = Flare (Array Element) (Signal a)

instance functorFlare :: Functor Flare where
  map f (Flare cs sig) = Flare cs (map f sig)

instance applyFlare :: Apply Flare where
  apply (Flare cs1 sig1) (Flare cs2 sig2) = Flare (cs1 <> cs2) (sig1 <*> sig2)

instance applicativeFlare :: Applicative Flare where
  pure x = Flare [] (pure x)

type UI = FreeAp UIF

data UIF a
  = NumberUI Label Number (Flare Number -> a)
  | NumberRangeUI Label Number Number Number Number (Flare Number -> a)
  | StringUI Label String (Flare String -> a)
  | LiftUI (forall e b. Eff e (Signal b)) (forall b. Flare b -> a)

type Label = String

type ElementId = String

numberUI :: Label -> Number -> UI (Flare Number)
numberUI label value = liftFreeAp (NumberUI label value id)

numberRangeUI :: Label -> Number -> Number -> Number -> Number -> UI (Flare Number)
numberRangeUI label min max step value = liftFreeAp (NumberRangeUI label min max step value id)

stringUI :: Label -> String -> UI (Flare String)
stringUI label value = liftFreeAp (StringUI label value id)

lift :: forall a. Signal a -> UI (Flare a)
lift sig = pure (Flare [] sig)

liftUI :: forall e a. Eff (chan :: Chan, dom :: DOM | e) (Signal a) -> UI (Flare a)
liftUI eff = liftFreeAp (LiftUI (unsafeCoerce eff) (unsafeCoerce <<< id <<< unsafeCoerce))

uiNat :: NaturalTransformation UIF (Eff (dom :: DOM, chan :: Chan))
uiNat fa =
  case fa of
       NumberUI label value k -> k <$> mkFlare cNumber label value

       NumberRangeUI label min max step value k -> k <$> mkFlare (cNumberRange min max step) label value

       StringUI label value k -> k <$> mkFlare cString label value

       LiftUI signal k -> k <$> (Flare [] <$> signal)
  where
  mkFlare :: forall a. CreateComponent a -> Label -> a -> Eff (dom :: DOM, chan :: Chan) (Flare a)
  mkFlare create label value = do
    chan <- channel value
    comp <- create label value (send chan)
    let signal = subscribe chan
    return (Flare [comp] signal)

type CreateComponent a = forall e. Label -> a -> (a -> Eff (chan :: Chan) Unit) -> Eff (dom :: DOM, chan :: Chan | e) Element

foreign import cNumber :: CreateComponent Number

foreign import cNumberRange :: Number -> Number -> Number -> CreateComponent Number

foreign import cString :: CreateComponent String

runFlare :: forall a. (Show a)
         => ElementId
         -> ElementId
         -> UI (Flare a)
         -> Eff (dom :: DOM, chan :: Chan) Unit
runFlare controls target ui = do
  (Flare components signal) <- foldFreeAp uiNat ui
  --appendComponents controls components
  --S.runSignal (map (show >>> renderString target) signal)
  return unit

main :: Eff (chan :: Chan, dom :: DOM) Unit
main = do
  runFlare "controls1" "output1" $
    lift2 pow <$> numberUI "Base" 2.0
              <*> numberUI "Exponent" 10.0