<commit_before>-- Canvas.Hs, control javascript canvas with Haskell
-- Copyright (C) 2013, <NAME>, <NAME>, <NAME>, <NAME>,
-- <NAME>
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
-- 
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-- Lesser General Public License for more details.
-- 
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301
-- USA

{-# LANGUAGE OverloadedStrings #-}

{- | 
    The CanvasHs.Protocol.Input module exposes a FromJSON instance for 'Event' which allows
    JOSN strings describing an event te bo decoded by Aeson
-}
module CanvasHs.Protocol.Input (FromJSON(..)) where


import Data.Aeson ((.:), (.:?), FromJSON(..), Value(..))
import Control.Applicative ((<$>), (<*>))
import System.FilePath.Posix (takeExtension)

import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.UTF8 as BU
import qualified Data.ByteString.Lazy.UTF8 as BUL
import qualified Data.ByteString.Base64.Lazy as B64

import CanvasHs.Data

-- | JSONEventData describes eventdata which could be incoming in a JSONstring as a record which can later be used
--   to construct an 'Event'
data JSONEventData = JSONEventData {
        jeventId :: Maybe BU.ByteString,
        x :: Maybe Int,
        y :: Maybe Int,
        x1 :: Maybe Int, -- Only for mousedrag
        y1 :: Maybe Int, -- Only for mousedrag
        jeventId1 :: Maybe BU.ByteString, -- Only for mousedrag
        x2 :: Maybe Int, -- Only for mousedrag
        y2 :: Maybe Int, -- Only for mousedrag
        jeventId2 :: Maybe BU.ByteString, -- Only for mousedrag
        key :: Maybe BU.ByteString,
        control :: Maybe Bool,
        alt :: Maybe Bool,
        shift :: Maybe Bool,
        xdelta :: Maybe Int,
        ydelta :: Maybe Int,
        width :: Maybe Int,
        height :: Maybe Int,
        filename :: Maybe BSL.ByteString,
        filecontents :: Maybe BSL.ByteString,
        value :: Maybe BSL.ByteString
    } deriving(Eq, Show)

-- | The FromJSON instance for JSONEventData allows the fromJSON instance of 'Event' to use parseJSON on the data field    
instance FromJSON JSONEventData where
    parseJSON (Object v) = JSONEventData         <$>
                            v .:? "id"           <*>
                            v .:? "x"            <*>
                            v .:? "y"            <*>
                            v .:? "x1"           <*> -- Only for mousedrag
                            v .:? "y1"           <*> -- Only for mousedrag
                            v .:? "id1"          <*> -- Only for mousedrag
                            v .:? "x2"           <*> -- Only for mousedrag
                            v .:? "y2"           <*> -- Only for mousedrag
                            v .:? "id2"          <*> -- Only for mousedrag
                            v .:? "key"          <*>
                            v .:? "control"      <*>
                            v .:? "alt"          <*>
                            v .:? "shift"        <*>
                            v .:? "xdelta"       <*>
                            v .:? "ydelta"       <*>
                            v .:? "width"        <*>
                            v .:? "height"       <*>
                            v .:? "filename"     <*> -- Only for upload events
                            v .:? "filecontents" <*> -- Only for upload events
                            v .:? "value"
    parseJSON _ = error "A toplevel JSON should be an object"

-- | The FromJSON instance of 'Event' allows incoming JSON strings describing an event to be decoded by Aeson, 
--   incoming strings hold an event field identyfing the type of event and a datafield which describes the event
--   both of these are read by Aeson and read by the makeEvent function
instance FromJSON Event where
    parseJSON (Object v) = do
        makeEvent <$>
            v .: "event" <*>
            v .: "data"
    parseJSON _ = error "A toplevel JSON should be an object"

-- Ooit gehoord van pattern matching, nou ik blijkbaar wel
makeEvent :: BU.ByteString -> JSONEventData -> Event
makeEvent "mousedown" 
    (JSONEventData{jeventId = Just eid, x = Just x, y = Just y}) 
        = MouseDown (x, y) (BU.toString eid)

makeEvent "mouseclick"
    (JSONEventData{jeventId = Just eid, x = Just x, y = Just y})  
        = MouseClick (x, y) (BU.toString eid)

makeEvent "mouseup" 
    (JSONEventData{jeventId = Just eid, x = Just x, y = Just y})
         = MouseUp (x, y) (BU.toString eid)

makeEvent "mousedoubleclick"
    (JSONEventData{jeventId = Just eid, x = Just x, y = Just y})
         = MouseDoubleClick (x, y) (BU.toString eid)

makeEvent "mousedrag"
    (JSONEventData{jeventId1 = Just eid1, x1 = Just x1, y1 = Just y1, jeventId2 = Just eid2, x2 = Just x2, y2 = Just y2})
        = MouseDrag (x1, y1) (BU.toString eid1) (x2, y2) (BU.toString eid2)

makeEvent "mouseover"
    (JSONEventData{jeventId = Just eid, x = Just x, y = Just y})
         = MouseOver (x, y) (BU.toString eid)

makeEvent "mouseout"
    (JSONEventData{jeventId = Just eid, x = Just x, y = Just y})
         = MouseOut (x, y) (BU.toString eid)

makeEvent "keydown"
    (JSONEventData{key = Just k, control = Just c, alt = Just a, shift = Just sh})
        = KeyDown (BU.toString k) (makeModifiers c a sh)

makeEvent "keyclick"
    (JSONEventData{key = Just k, control = Just c, alt = Just a, shift = Just sh})
        = KeyClick (BU.toString k) (makeModifiers c a sh)

makeEvent "keyup"
    (JSONEventData{key = Just k, control = Just c, alt = Just a, shift = Just sh})
        = KeyUp (BU.toString k) (makeModifiers c a sh)

makeEvent "scroll"
    (JSONEventData{jeventId = Just eid, xdelta = Just xd, ydelta = Just yd})
        = Scroll (BU.toString eid) xd yd

makeEvent "upload"
    (JSONEventData{filecontents = Just fc})
        = UploadComplete (BUL.toString $ b, b)
        where
            (Right b) = B64.decode fc
            <commit_msg>Fixed the InputProtocol: mousedrag doesnt actually send a second Id<commit_after>-- Canvas.Hs, control javascript canvas with Haskell
-- Copyright (C) 2013, <NAME>, <NAME>, <NAME>, <NAME>,
-- <NAME>
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
-- 
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-- Lesser General Public License for more details.
-- 
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301
-- USA

{-# LANGUAGE OverloadedStrings #-}

{- | 
    The CanvasHs.Protocol.Input module exposes a FromJSON instance for 'Event' which allows
    JOSN strings describing an event te bo decoded by Aeson
-}
module CanvasHs.Protocol.Input (FromJSON(..)) where


import Data.Aeson ((.:), (.:?), FromJSON(..), Value(..))
import Control.Applicative ((<$>), (<*>))
import System.FilePath.Posix (takeExtension)

import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.UTF8 as BU
import qualified Data.ByteString.Lazy.UTF8 as BUL
import qualified Data.ByteString.Base64.Lazy as B64

import CanvasHs.Data

-- | JSONEventData describes eventdata which could be incoming in a JSONstring as a record which can later be used
--   to construct an 'Event'
data JSONEventData = JSONEventData {
        jeventId :: Maybe BU.ByteString,
        x :: Maybe Int,
        y :: Maybe Int,
        x1 :: Maybe Int, -- Only for mousedrag
        y1 :: Maybe Int, -- Only for mousedrag
        jeventId1 :: Maybe BU.ByteString, -- Only for mousedrag
        x2 :: Maybe Int, -- Only for mousedrag
        y2 :: Maybe Int, -- Only for mousedrag
        jeventId2 :: Maybe BU.ByteString, -- Only for mousedrag
        key :: Maybe BU.ByteString,
        control :: Maybe Bool,
        alt :: Maybe Bool,
        shift :: Maybe Bool,
        xdelta :: Maybe Int,
        ydelta :: Maybe Int,
        width :: Maybe Int,
        height :: Maybe Int,
        filename :: Maybe BSL.ByteString,
        filecontents :: Maybe BSL.ByteString,
        value :: Maybe BSL.ByteString
    } deriving(Eq, Show)

-- | The FromJSON instance for JSONEventData allows the fromJSON instance of 'Event' to use parseJSON on the data field    
instance FromJSON JSONEventData where
    parseJSON (Object v) = JSONEventData         <$>
                            v .:? "id"           <*>
                            v .:? "x"            <*>
                            v .:? "y"            <*>
                            v .:? "x1"           <*> -- Only for mousedrag
                            v .:? "y1"           <*> -- Only for mousedrag
                            v .:? "id1"          <*> -- Only for mousedrag
                            v .:? "x2"           <*> -- Only for mousedrag
                            v .:? "y2"           <*> -- Only for mousedrag
                            v .:? "key"          <*>
                            v .:? "control"      <*>
                            v .:? "alt"          <*>
                            v .:? "shift"        <*>
                            v .:? "xdelta"       <*>
                            v .:? "ydelta"       <*>
                            v .:? "width"        <*>
                            v .:? "height"       <*>
                            v .:? "filename"     <*> -- Only for upload events
                            v .:? "filecontents" <*> -- Only for upload events
                            v .:? "value"
    parseJSON _ = error "A toplevel JSON should be an object"

-- | The FromJSON instance of 'Event' allows incoming JSON strings describing an event to be decoded by Aeson, 
--   incoming strings hold an event field identyfing the type of event and a datafield which describes the event
--   both of these are read by Aeson and read by the makeEvent function
instance FromJSON Event where
    parseJSON (Object v) = do
        makeEvent <$>
            v .: "event" <*>
            v .: "data"
    parseJSON _ = error "A toplevel JSON should be an object"

-- Ooit gehoord van pattern matching, nou ik blijkbaar wel
makeEvent :: BU.ByteString -> JSONEventData -> Event
makeEvent "mousedown" 
    (JSONEventData{jeventId = Just eid, x = Just x, y = Just y}) 
        = MouseDown (x, y) (BU.toString eid)

makeEvent "mouseclick"
    (JSONEventData{jeventId = Just eid, x = Just x, y = Just y})  
        = MouseClick (x, y) (BU.toString eid)

makeEvent "mouseup" 
    (JSONEventData{jeventId = Just eid, x = Just x, y = Just y})
         = MouseUp (x, y) (BU.toString eid)

makeEvent "mousedoubleclick"
    (JSONEventData{jeventId = Just eid, x = Just x, y = Just y})
         = MouseDoubleClick (x, y) (BU.toString eid)

makeEvent "mousedrag"
    (JSONEventData{jeventId1 = Just eid1, x1 = Just x1, y1 = Just y1, x2 = Just x2, y2 = Just y2})
        = MouseDrag (x1, y1) (BU.toString eid1) (x2, y2)

makeEvent "mouseover"
    (JSONEventData{jeventId = Just eid, x = Just x, y = Just y})
         = MouseOver (x, y) (BU.toString eid)

makeEvent "mouseout"
    (JSONEventData{jeventId = Just eid, x = Just x, y = Just y})
         = MouseOut (x, y) (BU.toString eid)

makeEvent "keydown"
    (JSONEventData{key = Just k, control = Just c, alt = Just a, shift = Just sh})
        = KeyDown (BU.toString k) (makeModifiers c a sh)

makeEvent "keyclick"
    (JSONEventData{key = Just k, control = Just c, alt = Just a, shift = Just sh})
        = KeyClick (BU.toString k) (makeModifiers c a sh)

makeEvent "keyup"
    (JSONEventData{key = Just k, control = Just c, alt = Just a, shift = Just sh})
        = KeyUp (BU.toString k) (makeModifiers c a sh)

makeEvent "scroll"
    (JSONEventData{jeventId = Just eid, xdelta = Just xd, ydelta = Just yd})
        = Scroll (BU.toString eid) xd yd

makeEvent "upload"
    (JSONEventData{filecontents = Just fc})
        = UploadComplete (BUL.toString $ b, b)
        where
            (Right b) = B64.decode fc
            
{'fraction_non_alphanumeric': 0.10816725283313794, 'fraction_numerical': 0.008284486127393513, 'mean_word_length': 1.940933118823259, 'pattern_counts': {'":': 0, '<': 60, '<?xml version=': 0, '>': 64, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 39, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1549056', 'n_tokens_mistral': 3877, 'n_tokens_neox': 3759, 'n_words': 1391}