<commit_before>-----------------------------------------------------------------------------
-- Copyright 2009, Open Universiteit Nederland. This file is distributed 
-- under the terms of the GNU General Public License. For more information, 
-- see the file "LICENSE.txt", which is included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  <EMAIL>
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-- Services using JSON notation
--
-----------------------------------------------------------------------------
module Service.ModeJSON (processJSON) where

import Common.Context
import Common.Utils (Some(..), distinct)
import Common.Exercise
import Common.Strategy (makePrefix)
import Common.Transformation hiding (ruleList, defaultArgument)
import Text.JSON
import Service.Request
import Service.Types (Evaluator(..), Type, encodeDefault, decodeDefault, Encoder(..), Decoder(..))
import qualified Service.Types as Tp
import qualified Service.TypedAbstractService as TAS
import Service.ServiceList hiding (Service)
import qualified Service.ExerciseList as List
import Control.Monad
import Data.Maybe
import Data.Char

-- TODO: Clean-up code
extractCode :: JSON -> ExerciseCode
extractCode = fromMaybe noCode . List.resolveExerciseCode . f
 where 
   f (String s) = s
   f (Array [String _, String _, a@(Array _)]) = f a
   f (Array (String s:tl)) | any (\c -> not (isAlphaNum c || isSpace c || c == '.')) s = f (Array tl)
   f (Array (hd:_)) = f hd
   f _ = ""
      
processJSON :: String -> IO (Request, String, String)
processJSON input = do
   txt <- jsonRPC input myHandler
   case fmap jsonRequest (parseJSON input) of
      Just (Right req) -> return (req, txt, "application/json")
      Just (Left err)  -> fail err
      _                -> fail "no parse"

jsonRequest :: JSON -> Either String Request
jsonRequest json = do
   srv  <- case lookupM "method" json of
              Just (String s) -> return s
              _               -> fail "Invalid method"
   code <- liftM (return . extractCode) (lookupM "params" json)
   enc  <- case lookupM "encoding" json of
              Nothing         -> return Nothing<commit_msg>Fixed a bug in ModeJSON (exercise codes)<commit_after>-----------------------------------------------------------------------------
-- Copyright 2009, Open Universiteit Nederland. This file is distributed 
-- under the terms of the GNU General Public License. For more information, 
-- see the file "LICENSE.txt", which is included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  <EMAIL>
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-- Services using JSON notation
--
-----------------------------------------------------------------------------
module Service.ModeJSON (processJSON) where

import Common.Context
import Common.Utils (Some(..), distinct)
import Common.Exercise
import Common.Strategy (makePrefix)
import Common.Transformation hiding (ruleList, defaultArgument)
import Text.JSON
import Service.Request
import Service.Types (Evaluator(..), Type, encodeDefault, decodeDefault, Encoder(..), Decoder(..))
import qualified Service.Types as Tp
import qualified Service.TypedAbstractService as TAS
import Service.ServiceList hiding (Service)
import qualified Service.ExerciseList as List
import Control.Monad
import Data.Maybe
import Data.Char

-- TODO: Clean-up code
extractCode :: JSON -> ExerciseCode
extractCode = fromMaybe noCode . List.resolveExerciseCode . f
 where 
   f (String s) = s
   f (Array [String _, String _, a@(Array _)]) = f a
   f (Array (String s:tl)) | any (\c -> not (isAlphaNum c || isSpace c || c `elem` ".-")) s = f (Array tl)
   f (Array (hd:_)) = f hd
   f _ = ""
      
processJSON :: String -> IO (Request, String, String)
processJSON input = do
   txt <- jsonRPC input myHandler
   case fmap jsonRequest (parseJSON input) of
      Just (Right req) -> return (req, txt, "application/json")
      Just (Left err)  -> fail err
      _                -> fail "no parse"

jsonRequest :: JSON -> Either String Request
jsonRequest json = do
   srv  <- case lookupM "method" json of
              Just (String s) -> return s
              _               -> fail "Invalid method"
   code <- liftM (return . extractCode) (lookupM "params" json)
   enc  <- case lookupM "encoding" json of
              Nothing         -> return Nothing
{'fraction_non_alphanumeric': 0.19791666666666666, 'fraction_numerical': 0.0017730496453900709, 'mean_word_length': 2.0826502732240435, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 25, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4297727', 'n_tokens_mistral': 1163, 'n_tokens_neox': 1144, 'n_words': 444}