{-# LANGUAGE OverloadedStrings #-}
module Serializer
( exerciseToJSON
, personalizedExerciseToJSON
, validateExerciseAnswer
) where

import Core
import Util (shuffle_)
import qualified Data.ByteString.Lazy as BS
import qualified Data.Text as T
import qualified Data.Aeson as A
import Data.List (sort)
import System.Random (StdGen)

-- * Serialization of personalized exercises
personalizedExerciseToJSON :: PersonalizedExercise -> StdGen -> A.Value
personalizedExerciseToJSON :: PersonalizedExercise -> StdGen -> Value
personalizedExerciseToJSON (PersonalizedExercise Exercise
exercise Bool
shouldDisplayHint) StdGen
r0 = [Pair] -> Value
A.object
    [ Key
"exercise" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= (Exercise -> StdGen -> Value
exerciseToJSON Exercise
exercise StdGen
r0)
    , Key
"shouldDisplayHint" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Bool
shouldDisplayHint
    ]

-- * Serialization of exercises
exerciseToJSON :: Exercise -> StdGen -> A.Value

exerciseToJSON :: Exercise -> StdGen -> Value
exerciseToJSON (MultipleChoiceExercise Text
title [ExerciseSentence]
sentences [Text]
correctAlternatives [Text]
incorrectAlternatives Bool
fixedOrdering) StdGen
r0 = [Pair] -> Value
A.object
    [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= (Text
"multiple-choice" :: T.Text)
    , Key
"title" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Text
title
    , Key
"sentences" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= ((ExerciseSentence -> Value) -> [ExerciseSentence] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ExerciseSentence -> Value
exerciseSentenceToJSON [ExerciseSentence]
sentences)
    , Key
"alternatives" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= (if Bool
fixedOrdering then [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort else StdGen -> [Text] -> [Text]
forall a. StdGen -> [a] -> [a]
shuffle_ StdGen
r0) ([Text]
correctAlternatives [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
incorrectAlternatives)
    ]

exerciseToJSON (SingleChoiceExercise Text
title [ExerciseSentence]
sentences Text
correctAlternative [Text]
incorrectAlternatives Bool
fixedOrdering) StdGen
r0 = [Pair] -> Value
A.object
    [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= (Text
"single-choice" :: T.Text)
    , Key
"title" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Text
title
    , Key
"sentences" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= ((ExerciseSentence -> Value) -> [ExerciseSentence] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ExerciseSentence -> Value
exerciseSentenceToJSON [ExerciseSentence]
sentences)
    , Key
"alternatives" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= (if Bool
fixedOrdering then [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort else StdGen -> [Text] -> [Text]
forall a. StdGen -> [a] -> [a]
shuffle_ StdGen
r0) (Text
correctAlternative Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
incorrectAlternatives)
    ]

exerciseToJSON (MatchingExercise Text
title [ExerciseSentence]
sentences [(Text, Text)]
items) StdGen
r0 = [Pair] -> Value
A.object
    [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= (Text
"matching" :: T.Text)
    , Key
"title" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Text
title
    , Key
"sentences" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= ((ExerciseSentence -> Value) -> [ExerciseSentence] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ExerciseSentence -> Value
exerciseSentenceToJSON [ExerciseSentence]
sentences)
    , Key
"left_items" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst [(Text, Text)]
items
    , Key
"right_items" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= StdGen -> [Text] -> [Text]
forall a. StdGen -> [a] -> [a]
shuffle_ StdGen
r0 (((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> b
snd [(Text, Text)]
items)
    ]

exerciseToJSON (TypingExercise Text
title [ExerciseSentence]
sentences Text -> Bool
_ Text
canonicalAnswer) StdGen
r0 = [Pair] -> Value
A.object
    [ Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= (Text
"typing" :: T.Text)
    , Key
"title" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Text
title
    , Key
"sentences" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= ((ExerciseSentence -> Value) -> [ExerciseSentence] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ExerciseSentence -> Value
exerciseSentenceToJSON [ExerciseSentence]
sentences)
    , Key
"canonicalAnswer" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Text
canonicalAnswer
    ]

exerciseSentenceToJSON :: ExerciseSentence -> A.Value
exerciseSentenceToJSON :: ExerciseSentence -> Value
exerciseSentenceToJSON (ExerciseSentence Bool
lojbanic Text
text) = [Pair] -> Value
A.object
    [ Key
"text" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Text
text
    , Key
"lojbanic" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
A..= Bool
lojbanic
    ]

-- Deserialization of answers
newtype MultipleChoiceExerciseAnswer = MultipleChoiceExerciseAnswer {
    MultipleChoiceExerciseAnswer -> [Text]
mceaCorrectAlternatives :: [T.Text]
}

newtype SingleChoiceExerciseAnswer = SingleChoiceExerciseAnswer {
    SingleChoiceExerciseAnswer -> Text
sceaCorrectAlternative :: T.Text
}

newtype MatchingExerciseAnswer = MatchingExerciseAnswer {
    MatchingExerciseAnswer -> [Text]
meaOrderedAlternatives :: [T.Text]
}

newtype TypingExerciseAnswer = TypingExerciseAnswer {
    TypingExerciseAnswer -> Text
teaText :: T.Text
}

instance A.FromJSON MultipleChoiceExerciseAnswer where
    parseJSON :: Value -> Parser MultipleChoiceExerciseAnswer
parseJSON (A.Object Object
v) = [Text] -> MultipleChoiceExerciseAnswer
MultipleChoiceExerciseAnswer
        ([Text] -> MultipleChoiceExerciseAnswer)
-> Parser [Text] -> Parser MultipleChoiceExerciseAnswer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"correctAlternatives"

instance A.FromJSON SingleChoiceExerciseAnswer where
    parseJSON :: Value -> Parser SingleChoiceExerciseAnswer
parseJSON (A.Object Object
v) = Text -> SingleChoiceExerciseAnswer
SingleChoiceExerciseAnswer
        (Text -> SingleChoiceExerciseAnswer)
-> Parser Text -> Parser SingleChoiceExerciseAnswer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"correctAlternative"

instance A.FromJSON MatchingExerciseAnswer where
    parseJSON :: Value -> Parser MatchingExerciseAnswer
parseJSON (A.Object Object
v) = [Text] -> MatchingExerciseAnswer
MatchingExerciseAnswer
         ([Text] -> MatchingExerciseAnswer)
-> Parser [Text] -> Parser MatchingExerciseAnswer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"orderedAlternatives"

instance A.FromJSON TypingExerciseAnswer where
    parseJSON :: Value -> Parser TypingExerciseAnswer
parseJSON (A.Object Object
v) = Text -> TypingExerciseAnswer
TypingExerciseAnswer
        (Text -> TypingExerciseAnswer)
-> Parser Text -> Parser TypingExerciseAnswer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"text"

-- Validation of answers
validateExerciseAnswer :: Exercise -> BS.ByteString -> Maybe A.Value

{-validateExerciseAnswer (MultipleChoiceExercise text correctAlternatives incorrectAlternatives)  s = do-}
    {-answer <- A.decode s-}
    {-return $ (sort $ mceaCorrectAlternatives answer) == (sort correctAlternatives)-}

validateExerciseAnswer :: Exercise -> ByteString -> Maybe Value
validateExerciseAnswer (SingleChoiceExercise Text
title [ExerciseSentence]
sentences Text
correctAlternative [Text]
incorrectAlternatives Bool
fixedOrdering) ByteString
s = do
    SingleChoiceExerciseAnswer
answer <- ByteString -> Maybe SingleChoiceExerciseAnswer
forall a. FromJSON a => ByteString -> Maybe a
A.decode ByteString
s
    Value -> Maybe Value
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
        [ (Key
"correct", Bool -> Value
A.Bool (Bool -> Value) -> Bool -> Value
forall a b. (a -> b) -> a -> b
$ SingleChoiceExerciseAnswer -> Text
sceaCorrectAlternative SingleChoiceExerciseAnswer
answer Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
correctAlternative)
        , (Key
"correctAlternative", Text -> Value
A.String Text
correctAlternative)
        ]

validateExerciseAnswer (MatchingExercise Text
title [ExerciseSentence]
sentences [(Text, Text)]
items) ByteString
s = do
    MatchingExerciseAnswer
answer <- ByteString -> Maybe MatchingExerciseAnswer
forall a. FromJSON a => ByteString -> Maybe a
A.decode ByteString
s
    Value -> Maybe Value
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
        [ (Key
"correct", Bool -> Value
A.Bool (Bool -> Value) -> Bool -> Value
forall a b. (a -> b) -> a -> b
$ MatchingExerciseAnswer -> [Text]
meaOrderedAlternatives MatchingExerciseAnswer
answer [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> b
snd [(Text, Text)]
items)
        ]

validateExerciseAnswer (TypingExercise Text
title [ExerciseSentence]
sentences Text -> Bool
validate Text
canonicalAnswer) ByteString
s = do
    TypingExerciseAnswer
answer <- ByteString -> Maybe TypingExerciseAnswer
forall a. FromJSON a => ByteString -> Maybe a
A.decode ByteString
s
    Value -> Maybe Value
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object
        [ (Key
"correct", Bool -> Value
A.Bool (Bool -> Value) -> Bool -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Bool
validate (TypingExerciseAnswer -> Text
teaText TypingExerciseAnswer
answer))
        , (Key
"canonicalAnswer", Text -> Value
A.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
canonicalAnswer)
        ]