Configuration.hs

{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs               #-}
{-# LANGUAGE NoMonomorphismRestriction  #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}

-- | JSON syntax and data types for user facing request configuration
module Voicebase.V2Beta.Configuration
  (Configuration(..), channels, language, detections, ChannelSpeakers(..), left, right, Speaker(..), Detection(..), Language(..), JSONInvertible(..))
where

import           Control.Isomorphism.Partial hiding (left, right)
import           Control.Lens.TH
import           Data.Aeson
import           Data.Aeson.Roundtrip
import           Data.String
import           Data.Text                   (Text)
import           Prelude                     hiding ((*>), (<$>), (<*>))
import           Text.Roundtrip.Classes
import           Text.Roundtrip.Combinators

class JSONInvertible a where
  syntax :: JSONSyntax s => s a

-- https://voicebase.readthedocs.io/en/v2-beta/how-to-guides/languages.html
data Language =
  Dutch | EnglishUS | EnglishUK | EnglishAus | French | German | Italian | Portuguese | SpanishLatinAmerican | SpanishSpain
  deriving (Eq, Ord, Show, Read)
defineIsomorphisms ''Language

instance JSONInvertible Language where
  syntax =
        dutch                <$> jsonString `is` "nl-NL"
    <|> englishUS            <$> jsonString `is` "en-US"
    <|> englishUK            <$> jsonString `is` "en-UK"
    <|> englishAus           <$> jsonString `is` "en-AU"
    <|> french               <$> jsonString `is` "fr-FR"
    <|> german               <$> jsonString `is` "de-DE"
    <|> italian              <$> jsonString `is` "it-IT"
    <|> portuguese           <$> jsonString `is` "pt-BR"
    <|> spanishLatinAmerican <$> jsonString `is` "es-LA"
    <|> spanishSpain         <$> jsonString `is` "es-ES"

newtype Speaker = Speaker Text deriving (Eq, Ord, Show, Read, IsString)

defineIsomorphisms ''Speaker

instance JSONInvertible Speaker where
  syntax = speaker <$> jsonField "speaker" jsonString

data ChannelSpeakers = ChannelSpeakers {
  _left    :: Speaker
  , _right :: Speaker
} deriving (Eq, Ord, Show, Read)

makeLenses ''ChannelSpeakers
defineIsomorphisms ''ChannelSpeakers

instance JSONInvertible ChannelSpeakers where
  syntax = channelSpeakers <$> jsonField "left" syntax <*> jsonField "right" syntax

data Detection = RedactingPCI
  deriving (Eq, Ord, Show, Read)

defineIsomorphisms ''Detection

infixr 7 ##
(##) = jsonField

instance JSONInvertible Detection where
  syntax = redactingPCI <$> "redact" ## redactSyntax
                         *> "model" ## (jsonString `is` "PCI")
    where
      redactSyntax = "transcripts" ## (jsonString `is` "[redacted]")
                   *> "audio" ## audioSyntax
      audioSyntax = "tone" ## (jsonIntegral `is` 270)
                  *> "gain" ## (jsonRealFloat `is` 0.5)

data Configuration = Configuration {
    _channels   :: Maybe ChannelSpeakers
  , _language   :: Language
  , _detections :: [ Detection ]
} deriving (Eq, Ord, Show, Read)
defineIsomorphisms ''Configuration
makeLenses ''Configuration

instance JSONInvertible Configuration where
  syntax = jsonField "configuration" $ configuration
      <$> optional ("ingest" ## "channels" ## syntax)
      <*> "language" ## syntax
      <*> "detections" ## many syntax