{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}

module Server.Api.V0.Contract where

import GHC.Generics
import qualified Data.Aeson as A
import qualified Data.Map as M
import qualified Data.Text as T

data Course = Course
    { Course -> Text
title :: T.Text
    , Course -> Text
dictionaryId :: T.Text
    , Course -> CourseStyle
style :: CourseStyle
    } deriving ((forall x. Course -> Rep Course x)
-> (forall x. Rep Course x -> Course) -> Generic Course
forall x. Rep Course x -> Course
forall x. Course -> Rep Course x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Course -> Rep Course x
from :: forall x. Course -> Rep Course x
$cto :: forall x. Rep Course x -> Course
to :: forall x. Rep Course x -> Course
Generic, Int -> Course -> ShowS
[Course] -> ShowS
Course -> String
(Int -> Course -> ShowS)
-> (Course -> String) -> ([Course] -> ShowS) -> Show Course
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Course -> ShowS
showsPrec :: Int -> Course -> ShowS
$cshow :: Course -> String
show :: Course -> String
$cshowList :: [Course] -> ShowS
showList :: [Course] -> ShowS
Show)

data CourseStyle = CourseStyle
    { CourseStyle -> Maybe String
color1 :: Maybe String
    , CourseStyle -> Maybe String
iconUrl :: Maybe String
    } deriving ((forall x. CourseStyle -> Rep CourseStyle x)
-> (forall x. Rep CourseStyle x -> CourseStyle)
-> Generic CourseStyle
forall x. Rep CourseStyle x -> CourseStyle
forall x. CourseStyle -> Rep CourseStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CourseStyle -> Rep CourseStyle x
from :: forall x. CourseStyle -> Rep CourseStyle x
$cto :: forall x. Rep CourseStyle x -> CourseStyle
to :: forall x. Rep CourseStyle x -> CourseStyle
Generic, Int -> CourseStyle -> ShowS
[CourseStyle] -> ShowS
CourseStyle -> String
(Int -> CourseStyle -> ShowS)
-> (CourseStyle -> String)
-> ([CourseStyle] -> ShowS)
-> Show CourseStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CourseStyle -> ShowS
showsPrec :: Int -> CourseStyle -> ShowS
$cshow :: CourseStyle -> String
show :: CourseStyle -> String
$cshowList :: [CourseStyle] -> ShowS
showList :: [CourseStyle] -> ShowS
Show)

data Deck = Deck
    { Deck -> Text
title :: T.Text
    , Deck -> Text
dictionaryId :: T.Text
    , Deck -> [Card]
cards :: [Card]
    , Deck -> Maybe DeckPreferences
deckPreferences :: Maybe DeckPreferences
    , Deck -> Maybe DeckProficiency
deckProficiency :: Maybe DeckProficiency
    } deriving ((forall x. Deck -> Rep Deck x)
-> (forall x. Rep Deck x -> Deck) -> Generic Deck
forall x. Rep Deck x -> Deck
forall x. Deck -> Rep Deck x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Deck -> Rep Deck x
from :: forall x. Deck -> Rep Deck x
$cto :: forall x. Rep Deck x -> Deck
to :: forall x. Rep Deck x -> Deck
Generic, Int -> Deck -> ShowS
[Deck] -> ShowS
Deck -> String
(Int -> Deck -> ShowS)
-> (Deck -> String) -> ([Deck] -> ShowS) -> Show Deck
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Deck -> ShowS
showsPrec :: Int -> Deck -> ShowS
$cshow :: Deck -> String
show :: Deck -> String
$cshowList :: [Deck] -> ShowS
showList :: [Deck] -> ShowS
Show)

data Card = Card
    { Card -> Text
title :: T.Text
    , Card -> Text
shortDescription :: T.Text
    } deriving ((forall x. Card -> Rep Card x)
-> (forall x. Rep Card x -> Card) -> Generic Card
forall x. Rep Card x -> Card
forall x. Card -> Rep Card x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Card -> Rep Card x
from :: forall x. Card -> Rep Card x
$cto :: forall x. Rep Card x -> Card
to :: forall x. Rep Card x -> Card
Generic, Int -> Card -> ShowS
[Card] -> ShowS
Card -> String
(Int -> Card -> ShowS)
-> (Card -> String) -> ([Card] -> ShowS) -> Show Card
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Card -> ShowS
showsPrec :: Int -> Card -> ShowS
$cshow :: Card -> String
show :: Card -> String
$cshowList :: [Card] -> ShowS
showList :: [Card] -> ShowS
Show)

data DeckPreferences = DeckPreferences
    { DeckPreferences -> Map Text CardPreferences
cardPreferences :: M.Map T.Text CardPreferences
    } deriving ((forall x. DeckPreferences -> Rep DeckPreferences x)
-> (forall x. Rep DeckPreferences x -> DeckPreferences)
-> Generic DeckPreferences
forall x. Rep DeckPreferences x -> DeckPreferences
forall x. DeckPreferences -> Rep DeckPreferences x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeckPreferences -> Rep DeckPreferences x
from :: forall x. DeckPreferences -> Rep DeckPreferences x
$cto :: forall x. Rep DeckPreferences x -> DeckPreferences
to :: forall x. Rep DeckPreferences x -> DeckPreferences
Generic, Int -> DeckPreferences -> ShowS
[DeckPreferences] -> ShowS
DeckPreferences -> String
(Int -> DeckPreferences -> ShowS)
-> (DeckPreferences -> String)
-> ([DeckPreferences] -> ShowS)
-> Show DeckPreferences
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeckPreferences -> ShowS
showsPrec :: Int -> DeckPreferences -> ShowS
$cshow :: DeckPreferences -> String
show :: DeckPreferences -> String
$cshowList :: [DeckPreferences] -> ShowS
showList :: [DeckPreferences] -> ShowS
Show)

data CardStatus = CurrentlyLearning | AlreadyMastered | NotStarted
    deriving (CardStatus -> CardStatus -> Bool
(CardStatus -> CardStatus -> Bool)
-> (CardStatus -> CardStatus -> Bool) -> Eq CardStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CardStatus -> CardStatus -> Bool
== :: CardStatus -> CardStatus -> Bool
$c/= :: CardStatus -> CardStatus -> Bool
/= :: CardStatus -> CardStatus -> Bool
Eq, (forall x. CardStatus -> Rep CardStatus x)
-> (forall x. Rep CardStatus x -> CardStatus) -> Generic CardStatus
forall x. Rep CardStatus x -> CardStatus
forall x. CardStatus -> Rep CardStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CardStatus -> Rep CardStatus x
from :: forall x. CardStatus -> Rep CardStatus x
$cto :: forall x. Rep CardStatus x -> CardStatus
to :: forall x. Rep CardStatus x -> CardStatus
Generic, Int -> CardStatus -> ShowS
[CardStatus] -> ShowS
CardStatus -> String
(Int -> CardStatus -> ShowS)
-> (CardStatus -> String)
-> ([CardStatus] -> ShowS)
-> Show CardStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CardStatus -> ShowS
showsPrec :: Int -> CardStatus -> ShowS
$cshow :: CardStatus -> String
show :: CardStatus -> String
$cshowList :: [CardStatus] -> ShowS
showList :: [CardStatus] -> ShowS
Show)

data CardPreferences = CardPreferences
    { CardPreferences -> CardStatus
status :: CardStatus
    } deriving ((forall x. CardPreferences -> Rep CardPreferences x)
-> (forall x. Rep CardPreferences x -> CardPreferences)
-> Generic CardPreferences
forall x. Rep CardPreferences x -> CardPreferences
forall x. CardPreferences -> Rep CardPreferences x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CardPreferences -> Rep CardPreferences x
from :: forall x. CardPreferences -> Rep CardPreferences x
$cto :: forall x. Rep CardPreferences x -> CardPreferences
to :: forall x. Rep CardPreferences x -> CardPreferences
Generic, Int -> CardPreferences -> ShowS
[CardPreferences] -> ShowS
CardPreferences -> String
(Int -> CardPreferences -> ShowS)
-> (CardPreferences -> String)
-> ([CardPreferences] -> ShowS)
-> Show CardPreferences
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CardPreferences -> ShowS
showsPrec :: Int -> CardPreferences -> ShowS
$cshow :: CardPreferences -> String
show :: CardPreferences -> String
$cshowList :: [CardPreferences] -> ShowS
showList :: [CardPreferences] -> ShowS
Show)

instance A.FromJSON CardStatus where
    parseJSON :: Value -> Parser CardStatus
parseJSON = Options -> Value -> Parser CardStatus
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON Options
A.defaultOptions

data DeckProficiency = DeckProficiency
    { DeckProficiency -> Map Text CardProficiency
cardProficiencies :: M.Map T.Text CardProficiency
    } deriving ((forall x. DeckProficiency -> Rep DeckProficiency x)
-> (forall x. Rep DeckProficiency x -> DeckProficiency)
-> Generic DeckProficiency
forall x. Rep DeckProficiency x -> DeckProficiency
forall x. DeckProficiency -> Rep DeckProficiency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeckProficiency -> Rep DeckProficiency x
from :: forall x. DeckProficiency -> Rep DeckProficiency x
$cto :: forall x. Rep DeckProficiency x -> DeckProficiency
to :: forall x. Rep DeckProficiency x -> DeckProficiency
Generic, Int -> DeckProficiency -> ShowS
[DeckProficiency] -> ShowS
DeckProficiency -> String
(Int -> DeckProficiency -> ShowS)
-> (DeckProficiency -> String)
-> ([DeckProficiency] -> ShowS)
-> Show DeckProficiency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeckProficiency -> ShowS
showsPrec :: Int -> DeckProficiency -> ShowS
$cshow :: DeckProficiency -> String
show :: DeckProficiency -> String
$cshowList :: [DeckProficiency] -> ShowS
showList :: [DeckProficiency] -> ShowS
Show)

data CardProficiency = CardProficiency
    { CardProficiency -> Double
score :: Double
    } deriving ((forall x. CardProficiency -> Rep CardProficiency x)
-> (forall x. Rep CardProficiency x -> CardProficiency)
-> Generic CardProficiency
forall x. Rep CardProficiency x -> CardProficiency
forall x. CardProficiency -> Rep CardProficiency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CardProficiency -> Rep CardProficiency x
from :: forall x. CardProficiency -> Rep CardProficiency x
$cto :: forall x. Rep CardProficiency x -> CardProficiency
to :: forall x. Rep CardProficiency x -> CardProficiency
Generic, Int -> CardProficiency -> ShowS
[CardProficiency] -> ShowS
CardProficiency -> String
(Int -> CardProficiency -> ShowS)
-> (CardProficiency -> String)
-> ([CardProficiency] -> ShowS)
-> Show CardProficiency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CardProficiency -> ShowS
showsPrec :: Int -> CardProficiency -> ShowS
$cshow :: CardProficiency -> String
show :: CardProficiency -> String
$cshowList :: [CardProficiency] -> ShowS
showList :: [CardProficiency] -> ShowS
Show)

instance A.ToJSON Course where
    toEncoding :: Course -> Encoding
toEncoding = Options -> Course -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
A.genericToEncoding Options
A.defaultOptions

instance A.ToJSON CourseStyle where
    toEncoding :: CourseStyle -> Encoding
toEncoding = Options -> CourseStyle -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
A.genericToEncoding Options
A.defaultOptions

instance A.ToJSON Deck where
    toEncoding :: Deck -> Encoding
toEncoding = Options -> Deck -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
A.genericToEncoding Options
A.defaultOptions

instance A.ToJSON Card where
    toEncoding :: Card -> Encoding
toEncoding = Options -> Card -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
A.genericToEncoding Options
A.defaultOptions

instance A.ToJSON DeckPreferences where
    toEncoding :: DeckPreferences -> Encoding
toEncoding = Options -> DeckPreferences -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
A.genericToEncoding Options
A.defaultOptions

instance A.ToJSON CardPreferences where
    toEncoding :: CardPreferences -> Encoding
toEncoding = Options -> CardPreferences -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
A.genericToEncoding Options
A.defaultOptions

instance A.ToJSON CardStatus where
    toEncoding :: CardStatus -> Encoding
toEncoding = Options -> CardStatus -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
A.genericToEncoding Options
A.defaultOptions

instance A.ToJSON DeckProficiency where
    toEncoding :: DeckProficiency -> Encoding
toEncoding = Options -> DeckProficiency -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
A.genericToEncoding Options
A.defaultOptions

instance A.ToJSON CardProficiency where
    toEncoding :: CardProficiency -> Encoding
toEncoding = Options -> CardProficiency -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
A.genericToEncoding Options
A.defaultOptions