Another test

Another test

module OverlappingInstances where

data A = A | B

instance eqA1 :: Eq A where
  (==) A A = true
  (==) B B = true
  (==) _ _ = false
  (/=) x y = not (x == y)

instance eqA2 :: Eq A where
  (==) _ _ = true
  (/=) _ _ = false

instance ordA :: Ord A where
  compare A B = LT
  compare B A = GT
  compare _ _ = EQ

test :: forall a. (Ord a) => a -> a -> String
test x y = show $ x == y

main = Debug.Trace.trace $ test A B

error: pathspec 'examples/failing/OverlappingInstances2.purs' did not match any file(s) known to git


Add ApiError component for explaining api/parse/snapshot errors

module Components.ApiError
  ( component
  ) where

import Components.Markup

import Lambda.Api (Error(..))
import Lambda.Prelude (Maybe(..), (<>), show, ($), (<<<))
import Lambda.Language.Pretty (pretty, Rep(..), toString)

component :: { error :: Error } -> JSX
component = markup <<< explain <<< _.error

explain :: Error -> Array Markup
explain = case _ of
  BadSnapshot error ->
    [ para
      [ text "Something went wrong while processing a snapshot:"
      ]
    , code [toString $ pretty Raw error]
    , para $ bug Definitely
    ]
  ParseError error ->
    [ para
      [ text "A response from the API failed to parse:"
      ]
    , code [error]
    , para $ bug Probably
    ]
  Missing code ->
    [ para $
      [ text "The snapshot identified by "
      , text $ show code
      , text " doesn't appear to exist anymore. "
      ] <> bug Maybe
    ]
  HttpError (Just error) ->
    [ para
      [ text "Something went wrong while communicating with the API:"
      ]
    , code [error]
    , para $ bug Probably
    ]
  HttpError Nothing ->
    [ para $
      [ text "Something went wrong while communicating with the API. "
      ] <> bug Probably
    ]

bug :: Likelihood -> Array Leaf
bug = case _ of
  Definitely ->
    [ text "This is definitely a bug. If you have time to "
    , fileAnIssue
    , text ", I'd really appreciate it!"
    ]
  Probably ->
    [ text "This is probably a bug. If you have time to "
    , fileAnIssue
    , text ", I'd really appreciate it!"
    ]
  Maybe ->
    [ text "If you think this looks like a bug, feel free to "
    , fileAnIssue
    , text ". Thanks!"
    ]
 where
  fileAnIssue = link
    { this: "file an issue"
    , to: "github.com/cdparks/lambda-machine/issues"
    }

data Likelihood
  = Definitely
  | Probably
  | Maybe

error: pathspec 'frontend/src/Components/ApiError.purs' did not match any file(s) known to git


Initial work on Language.PureScript.Pretty.Common

prettyPrintObjectKey depends on values in the not-yet-ported
Language.PureScript.Parser.Common

module Language.PureScript.Pretty.Common where

import Control.Monad.State.Trans
import Control.Monad.State.Class
import Data.Array (map)
import Data.Maybe
import Data.Monoid
import Data.Traversable (traverse)
import Data.String (joinWith)
--TODO: import Language.PureScript.Parser.Common (reservedPsNames, opChars)

-- |
-- Wrap a string in parentheses
--
parens :: String -> String
parens s = "(" ++ s ++ ")"

data PrinterState = PrinterState { indent :: Number }

instance showPrinterState :: Show PrinterState where
  show (PrinterState { indent = i }) = "PrinterState { indent: " ++ show i ++ " }"

instance eqPrinterState :: Eq PrinterState where
  (==) (PrinterState { indent = i1 }) (PrinterState { indent = i2 }) = i1 == i2
  (/=) x y = not (x == y)

instance ordPrinterState :: Ord PrinterState where
  compare (PrinterState { indent = i1 }) (PrinterState { indent = i2 }) = compare i1 i2

-- |
-- Number of characters per identation level
--
blockIndent :: Number
blockIndent = 4

-- |
-- Pretty print with a new indentation level
--
withIndent :: StateT PrinterState Maybe String -> StateT PrinterState Maybe String
withIndent action = do
  modify $ \(PrinterState st) -> PrinterState $ st { indent = st.indent + blockIndent }
  result <- action
  modify $ \(PrinterState st) -> PrinterState $ st { indent = st.indent - blockIndent }
  return result

-- |
-- Get the current indentation level
--
currentIndent :: StateT PrinterState Maybe String
currentIndent = do
  PrinterState { indent = current } <- get
  return $ replicate current " "
  where
  replicate 0 x = ""
  replicate n x = x ++ replicate (n - 1) x

-- |
-- Print many lines
--
prettyPrintMany :: forall a. (a -> StateT PrinterState Maybe String) -> [a] -> StateT PrinterState Maybe String
prettyPrintMany f xs = do
  ss <- traverse f xs
  indentString <- currentIndent
  return $ joinWith "\n" $ map ((++) indentString) ss

{-
-- |
-- Prints an object key, escaping reserved names.
--
TODO: prettyPrintObjectKey :: String -> String
prettyPrintObjectKey s | s `elem` reservedPsNames = show s
                       | head s `elem` opChars = show s
                       | otherwise = s
-}

error: pathspec 'src/Language/PureScript/Pretty/Common.purs' did not match any file(s) known to git


Catch exception on close

Catch exception on close

module Gonimo.UI.Socket.Channel where

import Prelude
import Control.Monad.Eff.Console as Console
import Data.Array as Arr
import Data.CatQueue as Q
import Data.List as List
import Data.Tuple as Tuple
import Gonimo.Client.Effects as Gonimo
import Gonimo.UI.Socket.Message as Message
import Pux.Html.Attributes as A
import Pux.Html.Elements as H
import Pux.Html.Events as E
import WebRTC.MediaStream as MediaStream
import WebRTC.MediaStream.Track as Track
import WebRTC.RTC as RTC
import WebRTC.RTCRtpSender as Sender
import Control.Monad.Aff (Aff)
import Control.Monad.Aff.Class (liftAff)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Exception (catchException)
import Control.Monad.IO (IO)
import Control.Monad.Maybe.Trans (MaybeT(MaybeT), runMaybeT)
import Control.Monad.Reader (runReaderT)
import Control.Monad.Reader.Class (ask, class MonadReader)
import Control.Monad.State.Class (modify, get)
import Data.Array (zip)
import Data.Foldable (traverse_)
import Data.Identity (runIdentity)
import Data.Lens ((+=), (-=), (^?), _Just, lens, Lens, (.=), use, (%=), to, LensP)
import Data.List (List(Cons, Nil))
import Data.Maybe (fromMaybe, isJust, maybe, Maybe(Nothing, Just))
import Data.Traversable (traverse)
import Data.Tuple (snd, fst, uncurry, curry, Tuple(Tuple))
import Gonimo.Client.Types (toIO, Settings)
import Gonimo.Client.Vibrations (stopVibration, startVibration, Vibrator)
import Gonimo.Pux (noEffects, runGonimo, Component, Update, onlyModify, ComponentType)
import Gonimo.Server.Db.Entities (Family(Family), Device(Device))
import Gonimo.Server.State.Types (MessageNumber(MessageNumber))
import Gonimo.Server.Types.Lenses (_Baby)
import Gonimo.Types (Secret(Secret), Key(Key))
import Gonimo.UI.Socket.Channel.Types (audioStats, maxMessagesInFlight, messagesInFlight, messageQueue, Action(EnqueueMessage), Action(..), State, Props, StreamConnectionState(..), StreamConnectionStats, videoStats, connectionState, packetsReceived, TrackKind(..), vibrator)
import Gonimo.UI.Socket.Lenses (mediaStream)
import Gonimo.UI.Socket.Message (runMaybeIceCandidate, MaybeIceCandidate(JustIceCandidate, NoIceCandidate), encodeToString, decodeFromString, Message)
import Gonimo.Util (stopSound, playSound, loadSound, boostVolumeMediaStream, coerceEffects)
import Gonimo.WebAPI (deleteSocketByFamilyIdByFromDeviceByToDeviceByChannelIdMessagesByMessageNumber, putSocketByFamilyIdByFromDeviceByToDeviceByChannelId)
import Gonimo.WebAPI.Subscriber (getSocketByFamilyIdByFromDeviceByToDeviceByChannelId)
import Pux.Html (text, Html)
import Pux.Html.Attributes (offset)
import Servant.PureScript.Affjax (unsafeToString)
import Servant.Subscriber (Subscriptions)
import Unsafe.Coerce (unsafeCoerce)
import WebRTC.MediaStream (createObjectURL, mediaStreamToBlob, stopStream, getUserMedia, MediaStreamConstraints(MediaStreamConstraints), MediaStream)
import WebRTC.MediaStream.Track (addEventListener, MediaStreamTrack)
import WebRTC.RTC (closeRTCPeerConnection, RTCPeerConnection, iceConnectionState, oniceconnectionstatechange, onconnectionstatechange, onnegotiationneeded, MediaStreamEvent, setLocalDescription, createAnswer, iceEventCandidate, IceEvent, onicecandidate, onaddstream, addIceCandidate, setRemoteDescription, fromRTCSessionDescription, createOffer, addStream, RTCIceCandidateInit, Ice, newRTCPeerConnection)
import WebRTC.Util (onConnectionDrop)

init :: Maybe MediaStream -> IO State
init stream = do
  rtcConnection <- liftEff (newRTCPeerConnection { iceServers : [ { urls : [ "turn:gonimo.com:3478" ]
                                                                  , username : "gonimo"
                                                                  , credential : "Aeloh5chai2eil1" -- FIXME: For production this obviously should not be hardcoded.
                                                                  , credentialType : "password"
                                                                  }
                                                                ]
                                                 }
                           )
  ourStream <- runMaybeT $ do
    origStream <- MaybeT <<< pure $ stream
    -- Close rtc connection once a track ends - so parent will notice local problems:
    tracks <- liftEff $ MediaStream.getTracks origStream
    let addListener event = liftEff <<< addEventListener event (const (closeRTCConnectionCatch rtcConnection))
    traverse_ (addListener "ended") tracks
    traverse_ (addListener "mute") tracks
    traverse_ (addListener "inactive") tracks -- Let's see if this helps
    liftEff $ boostVolumeMediaStream origStream

  connState <- liftEff $ iceConnectionState rtcConnection
  let isBabyStation = isJust stream
  alarm' <- if isBabyStation -- We only need alarm at the parent side
            then pure Nothing
            else map Just <<< liftAff $ loadSound "/sounds/pup_alert.mp3"
  pure $  { mediaStream : ourStream
          , remoteStream : Nothing
          , rtcConnection : rtcConnection
          , isBabyStation : isBabyStation
          , messageQueue  : Nil
          , messagesInFlight : 0
          , audioStats : initStreamConnectionStats
          , videoStats : initStreamConnectionStats
          , vibrator   : Nothing
          , alarm : alarm'
          , alarmIsOn : false
          }

initStreamConnectionStats :: StreamConnectionStats
initStreamConnectionStats = { packetsReceived : 0
                            , connectionState : ConnectionNotAvailable
                            }

remoteStream :: forall a b r. Lens { "remoteStream" :: a | r } { "remoteStream" :: b | r } a b
remoteStream = lens _."remoteStream" (_ { "remoteStream" = _ })

update :: forall ps. Update (Props ps) State Action
update action = case action of
  InitConnection                     -> handleInit -- Things we can't do in init already.
  StartStreaming constraints         -> handleStartStreaming constraints
  StartNegotiation                   -> handleStartNegotiation
  SetMediaStream stream              -> handleSetMediaStream stream
  StopStreaming                      -> closeConnection
  CloseConnection                    -> handleCloseConnection
  AcceptMessages num messages        -> handleAcceptMessages num messages
  OnIceCandidate iceEvent            -> handleOnIceCandidate iceEvent
  OnAddStream streamEvent            -> handleOnAddStream streamEvent
  OnAudioConnectionDrop mPackets     -> handleOnConnectionDrop audioStats mPackets
  OnVideoConnectionDrop mPackets     -> handleOnConnectionDrop videoStats mPackets
  RegisterMediaTracks tracks         -> traverse_ handleRegisterMediaTrack tracks *> pure []
  SetRemoteStream stream             -> remoteStream .= Just stream *> pure []
  ReportError _                      -> noEffects
  EnqueueMessage message             -> handleEnqueueMessage message
  MessageSent nAction                -> handleMessageSent nAction
  SetVibrator mVibrator              -> handleSetVibrator mVibrator
  TurnOnAlarm onOff                  -> handleTurnOnAlarm onOff
  ConnectionClosed                      -> noEffects
  Nop                                -> noEffects

handleInit :: forall ps. ComponentType (Props ps) State Action
handleInit = do
  props <- ask :: Component (Props ps) State (Props ps)
  state <- get :: Component (Props ps) State State
  pure
    [ do
         liftEff $ onaddstream (coerceEffects <<< props.sendAction <<< OnAddStream ) state.rtcConnection
         liftEff $ onicecandidate (coerceEffects <<< props.sendAction <<< OnIceCandidate ) state.rtcConnection
         liftEff $ onnegotiationneeded (coerceEffects <<< props.sendAction $ StartNegotiation) state.rtcConnection
         if state.isBabyStation
           then pure Nop
           else pure $ EnqueueMessage Message.StartStreaming
    ]

handleStartStreaming :: forall ps.
                        MediaStreamConstraints
                        -> ComponentType (Props ps) State Action
handleStartStreaming constraints =
  pure [ liftAff $ SetMediaStream <$> coerceEffects (getUserMedia constraints) ]

handleSetMediaStream :: forall ps. MediaStream -> ComponentType (Props ps) State Action
handleSetMediaStream stream = do
  mediaStream .= Just stream
  startStreaming stream

startStreaming :: forall ps. MediaStream -> ComponentType (Props ps) State Action
startStreaming stream = do
  state <- get
  pure [ do
            liftEff $ addStream stream state.rtcConnection
            pure Nop
       ]

handleStartNegotiation :: forall ps. ComponentType (Props ps) State Action
handleStartNegotiation = do
  state <- get
  pure [ do
            offer <- liftAff $ createOffer state.rtcConnection
            liftAff $ setLocalDescription offer state.rtcConnection
            pure <<< EnqueueMessage $ Message.SessionDescriptionOffer offer
       ]

handleOnIceCandidate :: forall ps. IceEvent -> ComponentType (Props ps) State Action
handleOnIceCandidate event = do
  let candidate = iceEventCandidate event
  let mCandidate = maybe NoIceCandidate JustIceCandidate candidate
  pure [ pure <<< EnqueueMessage $ Message.IceCandidate mCandidate ]

handleOnAddStream :: forall ps. MediaStreamEvent  -> ComponentType (Props ps) State Action
handleOnAddStream event = do
    state <- get
    props <- ask
    let registerConnDrop = if state.isBabyStation
                           then []
                           else [ registerOnConnectionDrop props state ]
    pure $ registerConnDrop
         <> [ do
              url <- liftEff <<< createObjectURL <<< mediaStreamToBlob $ event.stream
              pure $ SetRemoteStream $ { stream : event.stream, objectURL : url }
            ]
  where
    registerOnConnectionDrop :: Props ps -> State -> IO Action
    registerOnConnectionDrop props state = do
      mVideoTrack <- map Arr.head <<< liftEff $ MediaStream.getVideoTracks event.stream
      mAudioTrack <- map Arr.head <<< liftEff $ MediaStream.getAudioTracks event.stream
      let kindArray kind = Arr.fromFoldable <<< map (const kind)
      maybeRegister props OnAudioConnectionDrop mAudioTrack state.rtcConnection
      maybeRegister props OnVideoConnectionDrop mVideoTrack state.rtcConnection
      -- pure $ RegisterMediaTracks (kindArray audioStats mAudioTrack <> kindArray videoStats mVideoTrack)
      pure $ RegisterMediaTracks (kindArray AudioTrack mAudioTrack <> kindArray VideoTrack mVideoTrack)

    maybeRegister :: Props ps -> (Maybe Int -> Action) -> Maybe MediaStreamTrack -> RTCPeerConnection -> IO Unit
    maybeRegister _ _ Nothing _ = pure unit
    maybeRegister props mkAction mTrack@(Just track) pc = do
      let eventHandler = coerceEffects <<< props.sendAction <<< mkAction
      liftEff $ onConnectionDrop eventHandler mTrack pc
      liftEff $ addEventListener "ended" (const (eventHandler Nothing)) track
      liftEff $ addEventListener "ended" (const (Console.log "Track ended")) track

handleOnConnectionDrop :: forall ps. LensP State StreamConnectionStats
                          -> Maybe Int -> ComponentType (Props ps) State Action
handleOnConnectionDrop stats mPackets= do
    case mPackets of
      Nothing -> do
        stats <<< connectionState %= updateState ConnectionDied
        status <- use (stats <<< connectionState)
        case status of
          ConnectionDied -> do
            let vibratorActions = [ do
                                       vibrator' <- liftEff $ startVibration [200, 100, 250, 100, 300]
                                       pure $ (SetVibrator <<< Just) vibrator'
                                  ]
            alarmActions <- handleTurnOnAlarm true
            pure $ alarmActions <> vibratorActions
          _ -> pure []
      Just packets -> do
        stats <<< packetsReceived .= packets
        stats <<< connectionState %= updateState ConnectionReliable
        pure []
  where
    -- updateState new old
    updateState :: StreamConnectionState -> StreamConnectionState -> StreamConnectionState
    updateState ConnectionNotAvailable ConnectionDied = ConnectionNotAvailable -- User can stop a dead connection.
    updateState _ ConnectionDied = ConnectionDied -- In all other cases it remains dead.
    updateState ConnectionUnknown ConnectionNotAvailable = ConnectionUnknown
    updateState _ ConnectionNotAvailable = ConnectionNotAvailable
    updateState new _ = new

handleSetVibrator :: forall ps. Maybe Vibrator -> ComponentType (Props ps) State Action
handleSetVibrator mVibrator = do
  state <- get :: Component (Props ps) State State
  let oldVibrator = state.vibrator
  vibrator .= mVibrator
  pure [ liftEff $ do
            traverse_ stopVibration oldVibrator
            pure Nop
       ]

handleTurnOnAlarm :: forall ps. Boolean -> ComponentType (Props ps) State Action
handleTurnOnAlarm onOff = do
  state <- get :: Component (Props ps) State State
  let old = state.alarmIsOn
  modify $ _ { alarmIsOn = onOff }
  let actions =
        if onOff
        then [ do
                  liftEff $ traverse_ playSound state.alarm
                  pure Nop
            ]
        else [ do
                  liftEff $ traverse_ stopSound state.alarm
                  pure Nop
            ]
  if old /= onOff
    then pure actions
    else pure []

handleRegisterMediaTrack :: forall ps. TrackKind -> Component (Props ps) State Unit
handleRegisterMediaTrack AudioTrack = audioStats <<< connectionState .= ConnectionUnknown
handleRegisterMediaTrack VideoTrack = videoStats <<< connectionState .= ConnectionUnknown

getSendMessages :: forall ps. Component (Props ps) State (Array String -> IO Action)
getSendMessages = do
  let sendMessages = putSocketByFamilyIdByFromDeviceByToDeviceByChannelId
  props <- ask
  let familyId' = props.familyId
  let fromDevice' = props.ourId
  let toDevice' = props.theirId
  let channelId' = props.cSecret
  let sendMessage = map MessageSent
                    <<< toIO props.settings
                    <<< ( \msgs ->  do
                             sendMessages msgs familyId' fromDevice' toDevice' channelId'
                             pure Nop
                        )
  pure sendMessage

handleAcceptMessages :: forall ps. MessageNumber -> Array String -> ComponentType (Props ps) State Action
handleAcceptMessages msgNumber msgs = do
  let decoded = Arr.mapMaybe decodeFromString msgs
  props <- ask
  let deleteMessage = deleteSocketByFamilyIdByFromDeviceByToDeviceByChannelIdMessagesByMessageNumber
  deleteActions <- runGonimo $ do
    deleteMessage props.familyId props.theirId props.ourId props.cSecret msgNumber
    pure Nop
  messageActions <- Arr.concat <$> traverse handleMessage decoded
  pure $ deleteActions <> messageActions

handleMessage :: forall ps. Message -> ComponentType (Props ps) State Action
handleMessage msg = do
  state <- get
  case msg of
    Message.StartStreaming -> fromMaybe (pure []) $ startStreaming <$> state.mediaStream
    Message.SessionDescriptionOffer description ->
      pure [ do
              liftAff $ setRemoteDescription description state.rtcConnection
              answer <- liftAff $ createAnswer state.rtcConnection
              liftAff $ setLocalDescription answer state.rtcConnection
              pure <<< EnqueueMessage $ Message.SessionDescriptionAnswer answer
          ]
    Message.SessionDescriptionAnswer description ->
      pure [ do
              liftAff $ setRemoteDescription description state.rtcConnection
              pure Nop
          ]
    Message.IceCandidate candidate ->
      pure [ do
              let test = runMaybeIceCandidate candidate
              case test of
                Nothing -> pure unit -- let's see whether this helps
                Just c -> liftAff $ addIceCandidate (runMaybeIceCandidate candidate) state.rtcConnection
              pure Nop
          ]
    Message.CloseConnection -> closeConnection

closeConnection :: forall ps. ComponentType (Props ps) State Action
closeConnection = do
  state <- get :: Component (Props ps) State State
  let conn = state.rtcConnection
  audioStats <<< connectionState .= ConnectionNotAvailable
  videoStats <<< connectionState .= ConnectionNotAvailable
  alarmA <- handleTurnOnAlarm false
  pure $ [ liftEff $ do
            catchException (\_ -> Console.log "Stopping vibrations failed!")
              $ traverse_ stopVibration state.vibrator
            pure $ SetVibrator Nothing
        , liftEff $ do
            closeRTCConnectionCatch conn
            pure ConnectionClosed
        ]
    <> alarmA

handleCloseConnection :: forall ps. ComponentType (Props ps) State Action
handleCloseConnection = do
  state <- get :: Component (Props ps) State State
  closeActions <- closeConnection
  pure $ [ pure $ EnqueueMessage Message.CloseConnection ] <> closeActions

handleEnqueueMessage :: forall ps. Message -> ComponentType (Props ps) State Action
handleEnqueueMessage message = do
  let strMsg = encodeToString message
  allClear <- use $ messagesInFlight <<< to (_ < maxMessagesInFlight)
  sendMessages <- getSendMessages
  if allClear
    then do
      messagesInFlight += 1
      pure [ sendMessages $ Arr.singleton strMsg ] -- Ready to take off!
    else do
      messageQueue %= Cons strMsg
      pure []

handleMessageSent :: forall ps. Action -> ComponentType (Props ps) State Action
handleMessageSent nAction = do
  messagesInFlight -= 1
  newActions <- update nAction
  queue :: List String <- use messageQueue
  sendMessages <- getSendMessages
  let messages = Arr.fromFoldable $ List.reverse queue
  ourActions <-
        if Arr.null messages
        then pure []
        else do
          messageQueue .= Nil :: (List String)
          messagesInFlight += 1
          pure [ sendMessages messages ]
  pure $ newActions <> ourActions

view :: forall ps. Props ps -> State -> Html Action
view props state =
  let
    mBabyDevice = Tuple.lookup props.theirId props.onlineDevices
    babyName = fromMaybe "unknown baby" $ mBabyDevice ^? _Just <<< _Baby
  in
    H.div [ A.className "panel panel-default" ]
            [ H.div [ A.className "panel-heading" ]
              [
                H.text babyName
              ]
            , H.div [ A.style [Tuple "position" "relative"]] -- Needed so absolute positioning of error works.
              [ viewVideo state
              , viewError state
              ]
            , viewStreamStatus state
            ]

viewVideo :: State -> Html Action
viewVideo state =
   case state.remoteStream of
       Nothing -> H.text $ "Sorry - no video there yet, please check that your camera/microphone "
                  <> "are enabled on the baby station and your browser allows us to access it."
       Just stream ->
         H.video [ A.src stream.objectURL
                 , A.autoPlay "true"
                 , A.controls true
                 , A.width "100%"
                 ] []

viewError :: State -> Html Action
viewError state =
  let
    isBroken connState = case connState of
      ConnectionDied -> true
      _              -> false
    audioBroken = isBroken state.audioStats.connectionState
    videoBroken = isBroken state.videoStats.connectionState
    brokenText = if audioBroken && not videoBroken
                 then "Audio connection broken!"
                 else if not audioBroken && videoBroken
                      then "Video connection broken!"
                      else "Connection broken!"

    errorView = H.div [ A.className "brokenConnectionOverlay" ]
                [ H.h2 [] [ H.text brokenText ]
                , H.p []
                  [
                    H.text "Please reconnect or check on your baby!"
                  ]
                ]
  in
   if audioBroken || videoBroken
   then errorView
   else H.div [] []

viewStreamStatus :: State -> Html Action
viewStreamStatus state =
  let
     getStatus connState = case connState of
       ConnectionNotAvailable -> H.text "x"
       ConnectionUnknown  -> H.text "Might break unnoticed"
       ConnectionReliable -> H.text "Reliable"
       ConnectionDied     -> H.text "Dead"
     videoStatus = getStatus state.videoStats.connectionState
     audioStatus = getStatus state.audioStats.connectionState
  in
   H.div []
   [ H.text "Audio: " , audioStatus
   , H.text ", "
   , H.text "Video: ", videoStatus
   ]

getSubscriptions :: forall m ps. (MonadReader Settings m) => Props ps -> m (Subscriptions Action)
getSubscriptions props =
  let
    receiveMessage = getSocketByFamilyIdByFromDeviceByToDeviceByChannelId toAction
    toAction :: Maybe (Maybe (Tuple MessageNumber (Array String))) -> Action
    toAction (Just (Just (Tuple num messages))) = AcceptMessages num messages
    toAction (Just Nothing) = Nop
    toAction Nothing = Nop
  in
    receiveMessage props.familyId props.theirId props.ourId props.cSecret

closeRTCConnectionCatch :: forall eff. RTCPeerConnection -> Eff eff Unit
closeRTCConnectionCatch conn =
  catchException (\_ -> coerceEffects $ Console.log "Closing RTC connection failed!")
  $ closeRTCPeerConnection conn

module Gonimo.UI.Socket.Channel where

import Prelude
import Control.Monad.Eff.Console as Console
import Data.Array as Arr
import Data.CatQueue as Q
import Data.List as List
import Data.Tuple as Tuple
import Gonimo.Client.Effects as Gonimo
import Gonimo.UI.Socket.Message as Message
import Pux.Html.Attributes as A
import Pux.Html.Elements as H
import Pux.Html.Events as E
import WebRTC.MediaStream as MediaStream
import WebRTC.MediaStream.Track as Track
import WebRTC.RTC as RTC
import WebRTC.RTCRtpSender as Sender
import Control.Monad.Aff (Aff)
import Control.Monad.Aff.Class (liftAff)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Exception (catchException)
import Control.Monad.IO (IO)
import Control.Monad.Maybe.Trans (MaybeT(MaybeT), runMaybeT)
import Control.Monad.Reader (runReaderT)
import Control.Monad.Reader.Class (ask, class MonadReader)
import Control.Monad.State.Class (modify, get)
import Data.Array (zip)
import Data.Foldable (traverse_)
import Data.Identity (runIdentity)
import Data.Lens ((+=), (-=), (^?), _Just, lens, Lens, (.=), use, (%=), to, LensP)
import Data.List (List(Cons, Nil))
import Data.Maybe (fromMaybe, isJust, maybe, Maybe(Nothing, Just))
import Data.Traversable (traverse)
import Data.Tuple (snd, fst, uncurry, curry, Tuple(Tuple))
import Gonimo.Client.Types (toIO, Settings)
import Gonimo.Client.Vibrations (stopVibration, startVibration, Vibrator)
import Gonimo.Pux (noEffects, runGonimo, Component, Update, onlyModify, ComponentType)
import Gonimo.Server.Db.Entities (Family(Family), Device(Device))
import Gonimo.Server.State.Types (MessageNumber(MessageNumber))
import Gonimo.Server.Types.Lenses (_Baby)
import Gonimo.Types (Secret(Secret), Key(Key))
import Gonimo.UI.Socket.Channel.Types (audioStats, maxMessagesInFlight, messagesInFlight, messageQueue, Action(EnqueueMessage), Action(..), State, Props, StreamConnectionState(..), StreamConnectionStats, videoStats, connectionState, packetsReceived, TrackKind(..), vibrator)
import Gonimo.UI.Socket.Lenses (mediaStream)
import Gonimo.UI.Socket.Message (runMaybeIceCandidate, MaybeIceCandidate(JustIceCandidate, NoIceCandidate), encodeToString, decodeFromString, Message)
import Gonimo.Util (stopSound, playSound, loadSound, boostVolumeMediaStream, coerceEffects)
import Gonimo.WebAPI (deleteSocketByFamilyIdByFromDeviceByToDeviceByChannelIdMessagesByMessageNumber, putSocketByFamilyIdByFromDeviceByToDeviceByChannelId)
import Gonimo.WebAPI.Subscriber (getSocketByFamilyIdByFromDeviceByToDeviceByChannelId)
import Pux.Html (text, Html)
import Pux.Html.Attributes (offset)
import Servant.PureScript.Affjax (unsafeToString)
import Servant.Subscriber (Subscriptions)
import Unsafe.Coerce (unsafeCoerce)
import WebRTC.MediaStream (createObjectURL, mediaStreamToBlob, stopStream, getUserMedia, MediaStreamConstraints(MediaStreamConstraints), MediaStream)
import WebRTC.MediaStream.Track (addEventListener, MediaStreamTrack)
import WebRTC.RTC (closeRTCPeerConnection, RTCPeerConnection, iceConnectionState, oniceconnectionstatechange, onconnectionstatechange, onnegotiationneeded, MediaStreamEvent, setLocalDescription, createAnswer, iceEventCandidate, IceEvent, onicecandidate, onaddstream, addIceCandidate, setRemoteDescription, fromRTCSessionDescription, createOffer, addStream, RTCIceCandidateInit, Ice, newRTCPeerConnection)
import WebRTC.Util (onConnectionDrop)

init :: Maybe MediaStream -> IO State
init stream = do
  rtcConnection <- liftEff (newRTCPeerConnection { iceServers : [ { urls : [ "turn:gonimo.com:3478" ]
                                                                  , username : "gonimo"
                                                                  , credential : "Aeloh5chai2eil1" -- FIXME: For production this obviously should not be hardcoded.
                                                                  , credentialType : "password"
                                                                  }
                                                                ]
                                                 }
                           )
  ourStream <- runMaybeT $ do
    origStream <- MaybeT <<< pure $ stream
    -- Close rtc connection once a track ends - so parent will notice local problems:
    tracks <- liftEff $ MediaStream.getTracks origStream
    let addListener event = liftEff <<< addEventListener event (const (closeRTCPeerConnection rtcConnection))
    traverse_ (addListener "ended") tracks
    traverse_ (addListener "mute") tracks
    traverse_ (addListener "inactive") tracks -- Let's see if this helps
    liftEff $ boostVolumeMediaStream origStream

  connState <- liftEff $ iceConnectionState rtcConnection
  let isBabyStation = isJust stream
  alarm' <- if isBabyStation -- We only need alarm at the parent side
            then pure Nothing
            else map Just <<< liftAff $ loadSound "/sounds/pup_alert.mp3"
  pure $  { mediaStream : ourStream
          , remoteStream : Nothing
          , rtcConnection : rtcConnection
          , isBabyStation : isBabyStation
          , messageQueue  : Nil
          , messagesInFlight : 0
          , audioStats : initStreamConnectionStats
          , videoStats : initStreamConnectionStats
          , vibrator   : Nothing
          , alarm : alarm'
          , alarmIsOn : false
          }

initStreamConnectionStats :: StreamConnectionStats
initStreamConnectionStats = { packetsReceived : 0
                            , connectionState : ConnectionNotAvailable
                            }

remoteStream :: forall a b r. Lens { "remoteStream" :: a | r } { "remoteStream" :: b | r } a b
remoteStream = lens _."remoteStream" (_ { "remoteStream" = _ })

update :: forall ps. Update (Props ps) State Action
update action = case action of
  InitConnection                     -> handleInit -- Things we can't do in init already.
  StartStreaming constraints         -> handleStartStreaming constraints
  StartNegotiation                   -> handleStartNegotiation
  SetMediaStream stream              -> handleSetMediaStream stream
  StopStreaming                      -> closeConnection
  CloseConnection                    -> handleCloseConnection
  AcceptMessages num messages        -> handleAcceptMessages num messages
  OnIceCandidate iceEvent            -> handleOnIceCandidate iceEvent
  OnAddStream streamEvent            -> handleOnAddStream streamEvent
  OnAudioConnectionDrop mPackets     -> handleOnConnectionDrop audioStats mPackets
  OnVideoConnectionDrop mPackets     -> handleOnConnectionDrop videoStats mPackets
  RegisterMediaTracks tracks         -> traverse_ handleRegisterMediaTrack tracks *> pure []
  SetRemoteStream stream             -> remoteStream .= Just stream *> pure []
  ReportError _                      -> noEffects
  EnqueueMessage message             -> handleEnqueueMessage message
  MessageSent nAction                -> handleMessageSent nAction
  SetVibrator mVibrator              -> handleSetVibrator mVibrator
  TurnOnAlarm onOff                  -> handleTurnOnAlarm onOff
  ConnectionClosed                      -> noEffects
  Nop                                -> noEffects

handleInit :: forall ps. ComponentType (Props ps) State Action
handleInit = do
  props <- ask :: Component (Props ps) State (Props ps)
  state <- get :: Component (Props ps) State State
  pure
    [ do
         liftEff $ onaddstream (coerceEffects <<< props.sendAction <<< OnAddStream ) state.rtcConnection
         liftEff $ onicecandidate (coerceEffects <<< props.sendAction <<< OnIceCandidate ) state.rtcConnection
         liftEff $ onnegotiationneeded (coerceEffects <<< props.sendAction $ StartNegotiation) state.rtcConnection
         if state.isBabyStation
           then pure Nop
           else pure $ EnqueueMessage Message.StartStreaming
    ]

handleStartStreaming :: forall ps.
                        MediaStreamConstraints
                        -> ComponentType (Props ps) State Action
handleStartStreaming constraints =
  pure [ liftAff $ SetMediaStream <$> coerceEffects (getUserMedia constraints) ]

handleSetMediaStream :: forall ps. MediaStream -> ComponentType (Props ps) State Action
handleSetMediaStream stream = do
  mediaStream .= Just stream
  startStreaming stream

startStreaming :: forall ps. MediaStream -> ComponentType (Props ps) State Action
startStreaming stream = do
  state <- get
  pure [ do
            liftEff $ addStream stream state.rtcConnection
            pure Nop
       ]

handleStartNegotiation :: forall ps. ComponentType (Props ps) State Action
handleStartNegotiation = do
  state <- get
  pure [ do
            offer <- liftAff $ createOffer state.rtcConnection
            liftAff $ setLocalDescription offer state.rtcConnection
            pure <<< EnqueueMessage $ Message.SessionDescriptionOffer offer
       ]

handleOnIceCandidate :: forall ps. IceEvent -> ComponentType (Props ps) State Action
handleOnIceCandidate event = do
  let candidate = iceEventCandidate event
  let mCandidate = maybe NoIceCandidate JustIceCandidate candidate
  pure [ pure <<< EnqueueMessage $ Message.IceCandidate mCandidate ]

handleOnAddStream :: forall ps. MediaStreamEvent  -> ComponentType (Props ps) State Action
handleOnAddStream event = do
    state <- get
    props <- ask
    let registerConnDrop = if state.isBabyStation
                           then []
                           else [ registerOnConnectionDrop props state ]
    pure $ registerConnDrop
         <> [ do
              url <- liftEff <<< createObjectURL <<< mediaStreamToBlob $ event.stream
              pure $ SetRemoteStream $ { stream : event.stream, objectURL : url }
            ]
  where
    registerOnConnectionDrop :: Props ps -> State -> IO Action
    registerOnConnectionDrop props state = do
      mVideoTrack <- map Arr.head <<< liftEff $ MediaStream.getVideoTracks event.stream
      mAudioTrack <- map Arr.head <<< liftEff $ MediaStream.getAudioTracks event.stream
      let kindArray kind = Arr.fromFoldable <<< map (const kind)
      maybeRegister props OnAudioConnectionDrop mAudioTrack state.rtcConnection
      maybeRegister props OnVideoConnectionDrop mVideoTrack state.rtcConnection
      -- pure $ RegisterMediaTracks (kindArray audioStats mAudioTrack <> kindArray videoStats mVideoTrack)
      pure $ RegisterMediaTracks (kindArray AudioTrack mAudioTrack <> kindArray VideoTrack mVideoTrack)

    maybeRegister :: Props ps -> (Maybe Int -> Action) -> Maybe MediaStreamTrack -> RTCPeerConnection -> IO Unit
    maybeRegister _ _ Nothing _ = pure unit
    maybeRegister props mkAction mTrack@(Just track) pc = do
      let eventHandler = coerceEffects <<< props.sendAction <<< mkAction
      liftEff $ onConnectionDrop eventHandler mTrack pc
      liftEff $ addEventListener "ended" (const (eventHandler Nothing)) track
      liftEff $ addEventListener "ended" (const (Console.log "Track ended")) track

handleOnConnectionDrop :: forall ps. LensP State StreamConnectionStats
                          -> Maybe Int -> ComponentType (Props ps) State Action
handleOnConnectionDrop stats mPackets= do
    case mPackets of
      Nothing -> do
        stats <<< connectionState %= updateState ConnectionDied
        status <- use (stats <<< connectionState)
        case status of
          ConnectionDied -> do
            let vibratorActions = [ do
                                       vibrator' <- liftEff $ startVibration [200, 100, 250, 100, 300]
                                       pure $ (SetVibrator <<< Just) vibrator'
                                  ]
            alarmActions <- handleTurnOnAlarm true
            pure $ alarmActions <> vibratorActions
          _ -> pure []
      Just packets -> do
        stats <<< packetsReceived .= packets
        stats <<< connectionState %= updateState ConnectionReliable
        pure []
  where
    -- updateState new old
    updateState :: StreamConnectionState -> StreamConnectionState -> StreamConnectionState
    updateState ConnectionNotAvailable ConnectionDied = ConnectionNotAvailable -- User can stop a dead connection.
    updateState _ ConnectionDied = ConnectionDied -- In all other cases it remains dead.
    updateState ConnectionUnknown ConnectionNotAvailable = ConnectionUnknown
    updateState _ ConnectionNotAvailable = ConnectionNotAvailable
    updateState new _ = new

handleSetVibrator :: forall ps. Maybe Vibrator -> ComponentType (Props ps) State Action
handleSetVibrator mVibrator = do
  state <- get :: Component (Props ps) State State
  let oldVibrator = state.vibrator
  vibrator .= mVibrator
  pure [ liftEff $ do
            traverse_ stopVibration oldVibrator
            pure Nop
       ]

handleTurnOnAlarm :: forall ps. Boolean -> ComponentType (Props ps) State Action
handleTurnOnAlarm onOff = do
  state <- get :: Component (Props ps) State State
  let old = state.alarmIsOn
  modify $ _ { alarmIsOn = onOff }
  let actions =
        if onOff
        then [ do
                  liftEff $ traverse_ playSound state.alarm
                  pure Nop
            ]
        else [ do
                  liftEff $ traverse_ stopSound state.alarm
                  pure Nop
            ]
  if old /= onOff
    then pure actions
    else pure []

handleRegisterMediaTrack :: forall ps. TrackKind -> Component (Props ps) State Unit
handleRegisterMediaTrack AudioTrack = audioStats <<< connectionState .= ConnectionUnknown
handleRegisterMediaTrack VideoTrack = videoStats <<< connectionState .= ConnectionUnknown

getSendMessages :: forall ps. Component (Props ps) State (Array String -> IO Action)
getSendMessages = do
  let sendMessages = putSocketByFamilyIdByFromDeviceByToDeviceByChannelId
  props <- ask
  let familyId' = props.familyId
  let fromDevice' = props.ourId
  let toDevice' = props.theirId
  let channelId' = props.cSecret
  let sendMessage = map MessageSent
                    <<< toIO props.settings
                    <<< ( \msgs ->  do
                             sendMessages msgs familyId' fromDevice' toDevice' channelId'
                             pure Nop
                        )
  pure sendMessage

handleAcceptMessages :: forall ps. MessageNumber -> Array String -> ComponentType (Props ps) State Action
handleAcceptMessages msgNumber msgs = do
  let decoded = Arr.mapMaybe decodeFromString msgs
  props <- ask
  let deleteMessage = deleteSocketByFamilyIdByFromDeviceByToDeviceByChannelIdMessagesByMessageNumber
  deleteActions <- runGonimo $ do
    deleteMessage props.familyId props.theirId props.ourId props.cSecret msgNumber
    pure Nop
  messageActions <- Arr.concat <$> traverse handleMessage decoded
  pure $ deleteActions <> messageActions

handleMessage :: forall ps. Message -> ComponentType (Props ps) State Action
handleMessage msg = do
  state <- get
  case msg of
    Message.StartStreaming -> fromMaybe (pure []) $ startStreaming <$> state.mediaStream
    Message.SessionDescriptionOffer description ->
      pure [ do
              liftAff $ setRemoteDescription description state.rtcConnection
              answer <- liftAff $ createAnswer state.rtcConnection
              liftAff $ setLocalDescription answer state.rtcConnection
              pure <<< EnqueueMessage $ Message.SessionDescriptionAnswer answer
          ]
    Message.SessionDescriptionAnswer description ->
      pure [ do
              liftAff $ setRemoteDescription description state.rtcConnection
              pure Nop
          ]
    Message.IceCandidate candidate ->
      pure [ do
              let test = runMaybeIceCandidate candidate
              case test of
                Nothing -> pure unit -- let's see whether this helps
                Just c -> liftAff $ addIceCandidate (runMaybeIceCandidate candidate) state.rtcConnection
              pure Nop
          ]
    Message.CloseConnection -> closeConnection

closeConnection :: forall ps. ComponentType (Props ps) State Action
closeConnection = do
  state <- get :: Component (Props ps) State State
  let conn = state.rtcConnection
  audioStats <<< connectionState .= ConnectionNotAvailable
  videoStats <<< connectionState .= ConnectionNotAvailable
  alarmA <- handleTurnOnAlarm false
  pure $ [ liftEff $ do
            catchException (\_ -> Console.log "Stopping vibrations failed!")
              $ traverse_ stopVibration state.vibrator
            pure $ SetVibrator Nothing
        , liftEff $ do
            catchException (\_ -> Console.log "Closing RTC connection failed!")
              $ closeRTCPeerConnection conn
            pure ConnectionClosed
        ]
    <> alarmA

handleCloseConnection :: forall ps. ComponentType (Props ps) State Action
handleCloseConnection = do
  state <- get :: Component (Props ps) State State
  closeActions <- closeConnection
  pure $ [ pure $ EnqueueMessage Message.CloseConnection ] <> closeActions

handleEnqueueMessage :: forall ps. Message -> ComponentType (Props ps) State Action
handleEnqueueMessage message = do
  let strMsg = encodeToString message
  allClear <- use $ messagesInFlight <<< to (_ < maxMessagesInFlight)
  sendMessages <- getSendMessages
  if allClear
    then do
      messagesInFlight += 1
      pure [ sendMessages $ Arr.singleton strMsg ] -- Ready to take off!
    else do
      messageQueue %= Cons strMsg
      pure []

handleMessageSent :: forall ps. Action -> ComponentType (Props ps) State Action
handleMessageSent nAction = do
  messagesInFlight -= 1
  newActions <- update nAction
  queue :: List String <- use messageQueue
  sendMessages <- getSendMessages
  let messages = Arr.fromFoldable $ List.reverse queue
  ourActions <-
        if Arr.null messages
        then pure []
        else do
          messageQueue .= Nil :: (List String)
          messagesInFlight += 1
          pure [ sendMessages messages ]
  pure $ newActions <> ourActions

view :: forall ps. Props ps -> State -> Html Action
view props state =
  let
    mBabyDevice = Tuple.lookup props.theirId props.onlineDevices
    babyName = fromMaybe "unknown baby" $ mBabyDevice ^? _Just <<< _Baby
  in
    H.div [ A.className "panel panel-default" ]
            [ H.div [ A.className "panel-heading" ]
              [
                H.text babyName
              ]
            , H.div [ A.style [Tuple "position" "relative"]] -- Needed so absolute positioning of error works.
              [ viewVideo state
              , viewError state
              ]
            , viewStreamStatus state
            ]

viewVideo :: State -> Html Action
viewVideo state =
   case state.remoteStream of
       Nothing -> H.text $ "Sorry - no video there yet, please check that your camera/microphone "
                  <> "are enabled on the baby station and your browser allows us to access it."
       Just stream ->
         H.video [ A.src stream.objectURL
                 , A.autoPlay "true"
                 , A.controls true
                 , A.width "100%"
                 ] []

viewError :: State -> Html Action
viewError state =
  let
    isBroken connState = case connState of
      ConnectionDied -> true
      _              -> false
    audioBroken = isBroken state.audioStats.connectionState
    videoBroken = isBroken state.videoStats.connectionState
    brokenText = if audioBroken && not videoBroken
                 then "Audio connection broken!"
                 else if not audioBroken && videoBroken
                      then "Video connection broken!"
                      else "Connection broken!"

    errorView = H.div [ A.className "brokenConnectionOverlay" ]
                [ H.h2 [] [ H.text brokenText ]
                , H.p []
                  [
                    H.text "Please reconnect or check on your baby!"
                  ]
                ]
  in
   if audioBroken || videoBroken
   then errorView
   else H.div [] []

viewStreamStatus :: State -> Html Action
viewStreamStatus state =
  let
     getStatus connState = case connState of
       ConnectionNotAvailable -> H.text "x"
       ConnectionUnknown  -> H.text "Might break unnoticed"
       ConnectionReliable -> H.text "Reliable"
       ConnectionDied     -> H.text "Dead"
     videoStatus = getStatus state.videoStats.connectionState
     audioStatus = getStatus state.audioStats.connectionState
  in
   H.div []
   [ H.text "Audio: " , audioStatus
   , H.text ", "
   , H.text "Video: ", videoStatus
   ]

getSubscriptions :: forall m ps. (MonadReader Settings m) => Props ps -> m (Subscriptions Action)
getSubscriptions props =
  let
    receiveMessage = getSocketByFamilyIdByFromDeviceByToDeviceByChannelId toAction
    toAction :: Maybe (Maybe (Tuple MessageNumber (Array String))) -> Action
    toAction (Just (Just (Tuple num messages))) = AcceptMessages num messages
    toAction (Just Nothing) = Nop
    toAction Nothing = Nop
  in
    receiveMessage props.familyId props.theirId props.ourId props.cSecret


moves Emitters into their own module.

moves Emitters into their own module.

module Openspace.Ui.Emitter where

import Control.Monad.Eff

import Rx.JQuery
import Rx.Observable

import qualified Control.Monad.JQuery as J

import Data.Maybe
import Data.Tuple hiding(zip)
import Data.Traversable
import Data.Array (append)
import qualified Data.Map as M

import DOM

type Emitter = Tuple String (Observable J.JQueryEvent)
type Emitters = M.Map String (Observable J.JQueryEvent)

mkObservable :: forall eff. J.JQuery -> String -> Eff( dom::DOM | eff) (Tuple String (Observable J.JQueryEvent))
mkObservable emitter event = (Tuple event) <$> (event `onAsObservable` emitter)

--getEmitters' :: forall eff. Tuple String [String] -> Eff( dom::DOM | eff) [Emitter]
--getEmitters' (Tuple container events) = sequence $ do c <- J.select container
--                                                      mkObservable c <$> events

--getEmitters :: forall eff. [Tuple String [String]] -> Eff( dom :: DOM | eff) Emitters
getEmitters = do
    menuEmitter <- J.select "#menuContainer"
    let menu = mkObservable menuEmitter <$> ["addTopic", "dragOverTrash", "dragLeaveTrash"]

    topicEmitter <- J.select "#topicsContainer"
    let topic = mkObservable topicEmitter <$> ["dragStartTopic", "dragEndTopic"]

    gridEmitter <- J.select "#gridContainer"
    let grid = mkObservable gridEmitter <$> ["dragOverSlot", "dragLeaveSlot"]

    M.fromList <$> (sequence $ menu `append` topic `append` grid)

emitterLookup :: Emitters -> String -> Observable J.JQueryEvent
emitterLookup es s =
  case M.lookup s es of
    Just ob -> ob
    Nothing -> empty

error: pathspec 'src/Openspace/Ui/Emitter.purs' did not match any file(s) known to git


expedition evaluation

expedition evaluation

module KanColle.Expedition.Evaluate where

import Prelude
import Data.Array
import qualified Data.String as S
import Data.Int
import Math
import Data.Function

import KanColle.Expedition
import KanColle.Expedition.Income
import KanColle.Expedition.Minimal
import KanColle.Expedition.Cost

type EvalResult =
  { eId :: Int
  , netIncome :: Income
  , score :: Number
  , time :: Int
  }

incomeDiff :: Income -> ECost -> Income
incomeDiff (Income i) (ECost e) = case e.shipCost of
    ShipCost sc -> Income
        { fuel: i.fuel - sc.fuel
        , ammo: i.ammo - sc.ammo
        , steel: i.steel
        , bauxite: i.bauxite
        }

ordMax :: forall a. (Ord a) => a -> a -> a
ordMax a b = if a >= b then a else b

minToHour :: Int -> Number
minToHour m = toNumber m / 60.0

comparing :: forall a b. (Ord a) => (b -> a) -> b -> b -> Ordering
comparing prj x y = prj x `compare` prj y

sortByHourlyGain :: (Income -> Int) -> Array EvalResult
sortByHourlyGain evalCost = sortBy (flip compareScore) expeditions
  where
    compareScore = comparing (\x -> x.score)
    expeditions :: Array EvalResult
    expeditions = map collectInfo expeditionIds
    collectInfo eId = { eId: eId
                      , netIncome: netIncome
                      , time: cost.time
                      , score: score }
      where
        netIncome = getExpeditionIncome eId `incomeDiff` getExpeditionMinCost eId
        cost = getExpeditionCost eId
        score = toNumber (evalCost netIncome) / minToHour cost.time

sortWithAfkTime :: (Income -> Int) -> Number -> Int -> Array EvalResult
sortWithAfkTime evalCost timePenalty afkMinutes = sortBy (flip compareScore) expeditions
  where
    compareScore = comparing (\x -> x.score)
    expeditions :: Array EvalResult
    expeditions = map collectInfo expeditionIds
    collectInfo eId = { eId: eId
                      , netIncome: netIncome
                      , time: totalExpTime
                      , score: score }
      where
        costMinutes = (getExpeditionCost eId).time
        netIncome = getExpeditionIncome eId `incomeDiff` getExpeditionMinCost eId
        totalExpTime = ordMax costMinutes afkMinutes
        scoreNoPenalty = toNumber (evalCost netIncome) / minToHour totalExpTime
        timeDiffPenalty :: Number
        timeDiffPenalty = timePenalty * toNumber (ordMax 0 (costMinutes - afkMinutes))
        score = scoreNoPenalty - timeDiffPenalty

showEvalResult :: EvalResult -> String
showEvalResult er = case er.netIncome of
    Income inc ->
      "Expedition #" <> show er.eId <> ": "
                     <> showHourly inc.fuel <> " | "
                     <> showHourly inc.ammo <> " | "
                     <> showHourly inc.steel <> " | "
                     <> showHourly inc.bauxite <> " | "
                     <> show er.score
  where
    -- TODO
    showHourly v = show (toNumber v / (toNumber (getExpeditionCost er.eId).time / 60.0))

evalResultToJS :: EvalResult -> {eId :: Int, result :: Array Number}
evalResultToJS er = case er.netIncome of
    Income inc ->
      { eId: er.eId
      , result: [ hourly inc.fuel
                , hourly inc.ammo
                , hourly inc.steel
                , hourly inc.bauxite
                , er.score
                ] }
  where
    hourly v = (toNumber v / minToHour er.time)

simpleEvalCost :: (Int -> Int -> Int -> Int -> Int) -> Income -> Int
simpleEvalCost f (Income i) = f i.fuel i.ammo i.steel i.bauxite

evalNetIncomeHourlyJS :: (Fn4 Int Int Int Int Int) -> Array {eId:: Int, result :: Array Number}
evalNetIncomeHourlyJS sEvalCost = map evalResultToJS $
    sortByHourlyGain (simpleEvalCost (runFn4 sEvalCost))

evalNetIncomeWithAfkMinutesJS' :: (Fn4 Int Int Int Int Int) -> Number -> Int
                              -> Array {eId:: Int, result :: Array Number}
evalNetIncomeWithAfkMinutesJS' sEvalCost penalty afkMinutes = map evalResultToJS $
    sortWithAfkTime (simpleEvalCost (runFn4 sEvalCost)) penalty afkMinutes

evalNetIncomeWithAfkMinutesJS :: Fn3 (Fn4 Int Int Int Int Int)
                                     Number
                                     Int
                                     (Array {eId:: Int, result :: Array Number})
evalNetIncomeWithAfkMinutesJS = mkFn3 evalNetIncomeWithAfkMinutesJS'

error: pathspec 'src/KanColle/Expedition/Evaluate.purs' did not match any file(s) known to git


Version 0.1.0 of purescript-ractive

Version 0.1.0 of purescript-ractive

module Control.Monad.Eff.Ractive where

import Control.Monad.Eff
import Data.Foreign.EasyFFI

-- TODO: How to restrict values a of type String?
type Data a = {
  template :: String,
  el :: String,
  partials :: { | a}}

-- TODO: Add Event Type

foreign import data RactiveM :: !

foreign import data Ractive :: *

type RactiveEff a = forall e. Eff (ractiveM :: RactiveM | e) a

ffiF = unsafeForeignFunction
ffiP = unsafeForeignProcedure

ractive :: forall a. String -> String -> a -> RactiveEff Ractive
ractive = ffiF ["template", "document", "data", ""] "new Ractive({template:template, el: document, data:data})"

ractiveFromData :: forall a. Data a -> RactiveEff Ractive
ractiveFromData = ffiF ["data", ""] "new Ractive(data);"

get :: forall a. String -> Ractive -> RactiveEff a
get = ffiF ["field", "ractive", ""] "ractive.get(field)"

-- TODO: Add support for setting objects {}
--set :: forall a. String -> a -> Ractive -> RactiveEff Ractive
--set = ffiF ["selector", "value", "ractive", ""]
  "function () { ractive.set(selector, value); return ractive}()"
foreign import set
  "function set(selector) {\
  \ return function(value) {\
  \   return function(ractive) { \
  \     return function () {\
  \     ractive.set(selector, value); \
  \   } \
  \ }\
  \}}" :: forall a. String -> a -> Ractive -> RactiveEff Unit

foreign import setPartial
  "function setPartial(selector) {\
  \  return function (value) {\
  \    return function (ractive) {\
  \      return function () {\
  \        ractive.partials[selector] = value; \
  \}}}}" :: String -> String -> Ractive -> RactiveEff Unit

foreign import getPartial
  "function getPartial(selector) {\
  \ return function(ractive) {\
  \   return function () {\
  \     return ractive.partials[selector]; \
  \   } \
  \  } \
  \}" :: String -> Ractive -> RactiveEff String

--on :: forall e. String -> (Ractive -> Eff e Unit) -> Ractive -> RactiveEff Unit
--on = ffiF ["event", "handler", "ractive", ""]
--  "ractive.on(event, handler)"
foreign import on
   "function on(event) {\
   \  return function(handler) { \
   \    return function(ractive) { \
   \      return function() { \
   \        ractive.on(event, function(ev) { \
   \          return handler(this)(); \
   \        }); \
   \        return ractive; \
   \      } \
   \    } \
   \  } \
   \}" :: forall a e. String -> (Ractive -> Eff e a) -> Ractive -> RactiveEff Ractive

error: pathspec 'src/Control/Monad/Ractive/Ractive.purs' did not match any file(s) known to git


fix typo & design

fix typo & design

module Gonimo.UI.Invite where

import Gonimo.UI.Html
import Gonimo.Client.Effects as Gonimo
import Gonimo.Client.LocalStorage as Key
import Gonimo.Client.Types as Gonimo
import Gonimo.UI.Html as Html
import Gonimo.WebAPI.Types as WebAPI
import Pux.Html.Attributes as A
import Pux.Html.Elements as H
import Pux.Html.Events as E
import Browser.LocalStorage (STORAGE, localStorage)
import Control.Apply ((*>))
import Control.Monad.Aff (Aff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Except.Trans (runExceptT)
import Control.Monad.IO (IO)
import Control.Monad.Reader.Class (ask)
import Control.Monad.Reader.Trans (runReaderT)
import Control.Monad.State.Class (get, modify)
import Data.Either (Either(Right, Left))
import Data.Generic (gShow)
import Data.Maybe (isJust, isNothing, Maybe(..))
import Data.Tuple (uncurry, Tuple(Tuple))
import Global (encodeURI)
import Gonimo.Client.Types (Settings, GonimoError, Gonimo, class ReportErrorAction)
import Gonimo.Pux (noEffects, onlyModify, Update, runGonimo, class MonadComponent)
import Gonimo.Server.DbEntities (Invitation(Invitation), Family(Family))
import Gonimo.Server.Types (InvitationDelivery(EmailInvitation), AuthToken, AuthToken(GonimoSecret))
import Gonimo.Types (Key(Key), Secret(Secret))
import Gonimo.WebAPI (postInvitationsOutbox, postInvitationsByFamilyId, postFamilies, SPParams_(SPParams_), postAccounts, postFunnyName)
import Gonimo.WebAPI.Types (AuthData(AuthData))
import Partial.Unsafe (unsafeCrashWith)
import Pux (renderToDOM, fromSimple, start)
import Pux.Html (a, button, br, i, input, p, h1, h2, h3, text, span, Html, img, div, small, li, ul, nav)
import Pux.Html.Attributes (offset)
import Pux.Html.Attributes.Aria as A
import Servant.PureScript.Affjax (AjaxError)
import Servant.PureScript.Settings (gDefaultEncodeURLPiece, defaultSettings, SPSettings_(SPSettings_))
import Signal (constant, Signal)
import Prelude hiding (div)

type Props ps = { settings  :: Settings
                , rFamilyId :: Key Family
                , rFamily   :: Family
                , baseURL :: String
                | ps
                }

type State =
  { email          :: String
  , invitationSent :: Boolean
  , invitationId   :: Key Invitation
  , invitation   :: Invitation
  }

-- | We take our props in init to ensure the caller takes care of providing proper props.
--   Ensuring this on the first call to update is a tad to late.
init :: forall ps. Tuple (Key Invitation) Invitation -> Props ps -> State
init (Tuple invKey inv) _ = { email : ""
                            , invitationSent : false
                            , invitationId : invKey
                            , invitation : inv
                            }

data Action = SetEmail String
            | SendInvitation
            | InvitationSent
            | ReportError GonimoError
            | MakeNewInvitation
            | SetInvitationData (Key Invitation) Invitation
            | GoToOverview
            | GoToBabyStation
            | Nop

instance reportErrorActionAction :: ReportErrorAction Action where
  reportError = ReportError

update :: forall ps. Update (Props ps) State Action
update action = case action of
  (SetEmail email )         -> onlyModify $ _ { email = email, invitationSent = false }
  InvitationSent            -> handleInvitationSent
  SendInvitation            -> handleSendInvitation
  MakeNewInvitation         -> handleMakeNewInvitation
  SetInvitationData id' inv -> onlyModify $ \state -> state { invitationId = id', invitation = inv }
  GoToOverview              -> noEffects
  GoToBabyStation           -> noEffects
  ReportError err           -> noEffects
  Nop                       -> noEffects

makeInviteLink :: String -> Invitation -> String
makeInviteLink baseURL (Invitation inv) = baseURL <> "?" <> "acceptInvitation="
                                          <> gDefaultEncodeURLPiece inv.invitationSecret

handleInvitationSent :: forall m ps. (MonadComponent (Props ps) State m) => m (Array (IO Action))
handleInvitationSent = do
  modify $ _ { invitationSent = true }
  pure [ pure MakeNewInvitation ] -- Prevent user from re-using the already sent invitation

handleMakeNewInvitation :: forall m ps. (MonadComponent (Props ps) State m) => m (Array (IO Action))
handleMakeNewInvitation = do
  props <- ask
  runGonimo $ uncurry SetInvitationData <$> postInvitationsByFamilyId props.rFamilyId

handleSendInvitation :: forall m ps. (MonadComponent (Props ps) State m) => m (Array (IO Action))
handleSendInvitation = do
  state <- get
  runGonimo $ do
    postInvitationsOutbox $ WebAPI.SendInvitation state.invitationId (EmailInvitation state.email)
    pure InvitationSent

--------------------------------------------------------------------------------

view :: forall ps. Props ps -> State -> Html Action
view props state =
    let invitationLink = makeInviteLink (props.baseURL) state.invitation
     in div []
                   [ div [A.className "page-header"]
                     [ div [A.className "container"]
                       [ h3 [] [ text "Device Management"
                               , br [] []
                               , small []
                                 [ text $ "Here you can add new devices to your"
                                       <> " families, you only have to visit the"
                                       <> " following one-time link on another device." ]
                               ]
                       ]
                     ]
                   , div [A.className "container"]
                     [ h3 [] [text "copy & paste"]
                     , div [A.className "jumbotron"]
                       [ p [] [ text $ "You can either copy & paste it in to your"
                                    <> " favourite messenger (e.g. WhatsApp) to"
                                    <> " send it."
                              ]
                       , div [ A.className "input-group" ]
                           [ span [ A.className "input-group-addon glyphicon glyphicon-copy", A.id_ "sdflkjsll291" ]
                             []
                           , input [ A.type_ "text", A.className "form-control", A.readOnly true
                                   , A.value (makeInviteLink (props.baseURL) state.invitation)
                                   ] []
                           ]
                       ]
                     ]
                   , div [A.className "container"]
                     [ h3 [] [text "email"]
                     , div [A.className "jumbotron"]
                       [ p []  [ text "Or you can let us do the work send it via email …"
                               ]
                       , div [ E.onKeyUp handleEnter ]
                         [ div [A.className "input-group"]
                           [ span [A.className "input-group-addon glyphicon glyphicon-envelope"] []
                           , input [ A.type_ "text"
                                   , A.className "form-control"
                                   , A.placeholder "mail@example.com"
                                   , E.onInput $ \ev -> SetEmail ev.target.value
                                   , A.value state.email
                                   ] []
                           ]
                         ]
                       , button [ A.className "btn btn-block btn-info"
                                 , A.style [Tuple "margin-left" "0px"]
                                 , A.type_ "button"
                                 , E.onClick $ const $ SendInvitation
                                 ]
                         [ text " Send Invitation! "
                         , span [A.className "glyphicon glyphicon-send"] []
                         ]
                       , if state.invitationSent
                         then div [ A.className "alert alert-success"]
                              [ h3 [] [text $ "Invitation sent successfully to '"
                                           <> state.email <> "'!"
                                      , br [] []
                                      , small [] [text $ "But don't forget to add"
                                            <> " 'noreply@gonimo.com' to your address book,"
                                            <> " otherwise this invitation might end up in"
                                            <> " your spam-folder!"]
                                      ]
                              , button [ A.className "btn btn-block btn-default"
                                       , A.style [Tuple "margin-left" "0px"] ]
                                [ text $ "Oops - Did you send the invitation to the wrong recipient?"
                                , br [] []
                                , text "No problem just click me and then and then 'decline' to invalidate the link."
                                , br [] []
                                , br [] []
                                , text "TODO: how to preserve the previous one time link?"
                                ]
                              ]
                         else span [] []
                       ]
                     ]
                   , div [A.className "container"]
                       [ text "Invitation successfully transmitted? Then go back to overview or make this device a baby station right away .... " ]
                   , nav []
                     [ ul [ A.className "pager" ]
                       [ li [ A.className "previous"
                            , E.onClick $ const $ GoToOverview
                            ] [a [] [ span [A.ariaHidden "true"] [text "← "]
                                    , text "Back to Overview"
                                    ]
                              ]
                       , li [ A.className "next"
                            , E.onClick $ const $ GoToBabyStation
                            ] [ a [] [ text "Make this device a baby station"
                                     , span [A.ariaHidden "true"] [text " →"]
                                     ]
                              ]
                       ]

                     ]
                   , div [A.className "jumbotron"]
                     [ p [] [ text "Want to add another device?" ]
                     , button [ A.className "btn btn-block btn-info"
                              , A.type_ "button"
                              , E.onClick $ const $ MakeNewInvitation
                              ]
                       [ span [ A.className "glyphicon glyphicon-repeat"] []
                       , text " Generate new one-time link "
                       ]
                     ]
                   ]
  where
    handleEnter :: E.KeyboardEvent -> Action
    handleEnter ev = if ev.keyCode == 13 then SendInvitation else Nop

viewSent :: State -> Html Action
viewSent state = viewLogo $ text "Invitation sucessfully sent!"

module Gonimo.UI.Invite where

import Gonimo.UI.Html
import Gonimo.Client.Effects as Gonimo
import Gonimo.Client.LocalStorage as Key
import Gonimo.Client.Types as Gonimo
import Gonimo.UI.Html as Html
import Gonimo.WebAPI.Types as WebAPI
import Pux.Html.Attributes as A
import Pux.Html.Elements as H
import Pux.Html.Events as E
import Browser.LocalStorage (STORAGE, localStorage)
import Control.Apply ((*>))
import Control.Monad.Aff (Aff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Except.Trans (runExceptT)
import Control.Monad.IO (IO)
import Control.Monad.Reader.Class (ask)
import Control.Monad.Reader.Trans (runReaderT)
import Control.Monad.State.Class (get, modify)
import Data.Either (Either(Right, Left))
import Data.Generic (gShow)
import Data.Maybe (isJust, isNothing, Maybe(..))
import Data.Tuple (uncurry, Tuple(Tuple))
import Global (encodeURI)
import Gonimo.Client.Types (Settings, GonimoError, Gonimo, class ReportErrorAction)
import Gonimo.Pux (noEffects, onlyModify, Update, runGonimo, class MonadComponent)
import Gonimo.Server.DbEntities (Invitation(Invitation), Family(Family))
import Gonimo.Server.Types (InvitationDelivery(EmailInvitation), AuthToken, AuthToken(GonimoSecret))
import Gonimo.Types (Key(Key), Secret(Secret))
import Gonimo.WebAPI (postInvitationsOutbox, postInvitationsByFamilyId, postFamilies, SPParams_(SPParams_), postAccounts, postFunnyName)
import Gonimo.WebAPI.Types (AuthData(AuthData))
import Partial.Unsafe (unsafeCrashWith)
import Pux (renderToDOM, fromSimple, start)
import Pux.Html (a, button, br, i, input, p, h1, h2, h3, text, span, Html, img, div, small, li, ul, nav)
import Pux.Html.Attributes (offset)
import Pux.Html.Attributes.Aria as A
import Servant.PureScript.Affjax (AjaxError)
import Servant.PureScript.Settings (gDefaultEncodeURLPiece, defaultSettings, SPSettings_(SPSettings_))
import Signal (constant, Signal)
import Prelude hiding (div)

type Props ps = { settings  :: Settings
                , rFamilyId :: Key Family
                , rFamily   :: Family
                , baseURL :: String
                | ps
                }

type State =
  { email          :: String
  , invitationSent :: Boolean
  , invitationId   :: Key Invitation
  , invitation   :: Invitation
  }

-- | We take our props in init to ensure the caller takes care of providing proper props.
--   Ensuring this on the first call to update is a tad to late.
init :: forall ps. Tuple (Key Invitation) Invitation -> Props ps -> State
init (Tuple invKey inv) _ = { email : ""
                            , invitationSent : false
                            , invitationId : invKey
                            , invitation : inv
                            }

data Action = SetEmail String
            | SendInvitation
            | InvitationSent
            | ReportError GonimoError
            | MakeNewInvitation
            | SetInvitationData (Key Invitation) Invitation
            | GoToOverview
            | GoToBabyStation
            | Nop

instance reportErrorActionAction :: ReportErrorAction Action where
  reportError = ReportError

update :: forall ps. Update (Props ps) State Action
update action = case action of
  (SetEmail email )         -> onlyModify $ _ { email = email, invitationSent = false }
  InvitationSent            -> handleInvitationSent
  SendInvitation            -> handleSendInvitation
  MakeNewInvitation         -> handleMakeNewInvitation
  SetInvitationData id' inv -> onlyModify $ \state -> state { invitationId = id', invitation = inv }
  GoToOverview              -> noEffects
  GoToBabyStation           -> noEffects
  ReportError err           -> noEffects
  Nop                       -> noEffects

makeInviteLink :: String -> Invitation -> String
makeInviteLink baseURL (Invitation inv) = baseURL <> "?" <> "acceptInvitation="
                                          <> gDefaultEncodeURLPiece inv.invitationSecret

handleInvitationSent :: forall m ps. (MonadComponent (Props ps) State m) => m (Array (IO Action))
handleInvitationSent = do
  modify $ _ { invitationSent = true }
  pure [ pure MakeNewInvitation ] -- Prevent user from re-using the already sent invitation

handleMakeNewInvitation :: forall m ps. (MonadComponent (Props ps) State m) => m (Array (IO Action))
handleMakeNewInvitation = do
  props <- ask
  runGonimo $ uncurry SetInvitationData <$> postInvitationsByFamilyId props.rFamilyId

handleSendInvitation :: forall m ps. (MonadComponent (Props ps) State m) => m (Array (IO Action))
handleSendInvitation = do
  state <- get
  runGonimo $ do
    postInvitationsOutbox $ WebAPI.SendInvitation state.invitationId (EmailInvitation state.email)
    pure InvitationSent

--------------------------------------------------------------------------------

view :: forall ps. Props ps -> State -> Html Action
view props state =
    let invitationLink = makeInviteLink (props.baseURL) state.invitation
     in div []
                   [ div [A.className "page-header"]
                     [ div [A.className "container"]
                       [ h3 [] [ text "Device Management"
                               , br [] []
                               , small []
                                 [ text $ "Here you can add new devices to your"
                                       <> " families, you only have to visit the"
                                       <> " following one-time link on another device." ]
                               ]
                       ]
                     ]
                   , div [A.className "container"]
                     [ h3 [] [text "copy & paste"]
                     , div [A.className "jumbotron"]
                       [ p [] [ text $ "You can either copy & paste it in to your"
                                    <> " favourite messenger (e.g. WhatsApp) to"
                                    <> " send it."
                              ]
                       , div [ A.className "input-group" ]
                           [ span [ A.className "input-group-addon glyphicon glyphicon-copy", A.id_ "sdflkjsll291" ]
                             []
                           , input [ A.type_ "text", A.className "form-control", A.readOnly true
                                   , A.value (makeInviteLink (props.baseURL) state.invitation)
                                   ] []
                           ]
                       ]
                     ]
                   , div [A.className "container"]
                     [ h3 [] [text "email"]
                     , div [A.className "jumbotron"]
                       [ p []  [ text "Or you can let us do the work send it via email …"
                               ]
                       , div [ E.onKeyUp handleEnter ]
                         [ div [A.className "input-group"]
                           [ span [A.className "input-group-addon glyphicon glyphicon-envelope"] []
                           , input [ A.type_ "text"
                                   , A.className "form-control"
                                   , A.placeholder "mail@example.com"
                                   , E.onInput $ \ev -> SetEmail ev.target.value
                                   , A.value state.email
                                   ] []
                           ]
                         ]
                       , button [ A.className "btn btn-block btn-info"
                                 , A.style [Tuple "margin-left" "0px"]
                                 , A.type_ "button"
                                 , E.onClick $ const $ SendInvitation
                                 ]
                         [ text " Send Invitation! "
                         , span [A.className "glyphicon glyphicon-send"] []
                         ]
                       , if state.invitationSent
                         then div [ A.className "alert alert-success"]
                              [ h3 [] [text $ "Invitation sent successfully to '"
                                           <> state.email <> "'!"
                                      , br [] []
                                      , small [] [text $ "But don't forget to add"
                                            <> " 'noreply@gonimo.com' to your adress book,"
                                            <> " otherwise this invitation might end up in"
                                            <> " your spam-folder!"]
                                      ]
                              , button [ A.className "btn btn-block btn-primary"
                                       , A.style [Tuple "margin-left" "0px"] ]
                                [ text $ "Oops … - sent the invitation to the wrong recepient."
                                , br [] []
                                , text "No problem just click me and then and then 'decline' to invalidate the link."
                                , br [] []
                                , br [] []
                                , text "TODO: how to preserve the previous one time link?"
                                ]
                              ]
                         else span [] []
                       ]
                     ]
                   , div [A.className "container"]
                       [ text "Invitation successfully transmitted? Then go back to overview or make this device a baby station right away .... " ]
                   , nav []
                     [ ul [ A.className "pager" ]
                       [ li [ A.className "previous"
                            , E.onClick $ const $ GoToOverview
                            ] [a [] [ span [A.ariaHidden "true"] [text "← "]
                                    , text "Back to Overview"
                                    ]
                              ]
                       , li [ A.className "next"
                            , E.onClick $ const $ GoToBabyStation
                            ] [ a [] [ text "Make this device a baby station"
                                     , span [A.ariaHidden "true"] [text " →"]
                                     ]
                              ]
                       ]

                     ]
                   , div [A.className "jumbotron"]
                     [ p [] [ text "Want to add another device?" ]
                     , button [ A.className "btn btn-block btn-info"
                              , A.type_ "button"
                              , E.onClick $ const $ MakeNewInvitation
                              ]
                       [ span [ A.className "glyphicon glyphicon-repeat"] []
                       , text " Generate new one-time link "
                       ]
                     ]
                   ]
  where
    handleEnter :: E.KeyboardEvent -> Action
    handleEnter ev = if ev.keyCode == 13 then SendInvitation else Nop

viewSent :: State -> Html Action
viewSent state = viewLogo $ text "Invitation sucessfully sent!"


Added haskell implementation

Added haskell implementation

module LinearSearch where

-- Written and tested in in Purescript 0.12
import Prelude ((+), (==))
import Data.Array
import Data.Maybe (Maybe(..))

exampleSearch :: Maybe Int
exampleSearch = linear_Search [29,24,5,7,69,1,56] 5
--should answer Just 2

linear_Search :: Array Int -> Int -> Maybe Int
linear_Search arr value = search arr value 0

search :: Array Int -> Int -> Int -> Maybe Int
search arr value pos = case uncons arr of
		Just { head: x, tail: xs } ->
			if x == value then Just pos
						  else search xs value (pos+1)
  		Nothing -> Nothing

error: pathspec 'search/jump_search/haskell/LinearSearch.purs' did not match any file(s) known to git