Codec.hs

{-# LANGUAGE DeriveGeneric #-}

-- | Internal module for handling conversion between raw text and structured data.
module Quantum.Random.Codec (

  QRResponse (..),
  QRSettings (..),
  defaults,
  parseResponse,
  parseSettings,
  updateTarSize,
  updateMinSize,
  updateDefaultStyle

) where

import Quantum.Random.Exceptions
import Quantum.Random.Display

import GHC.Generics               (Generic)
import Data.Aeson                 (FromJSON,ToJSON,eitherDecode)
import Data.Text                  (Text)
import Data.ByteString.Lazy       (ByteString)
import Data.ByteString.Lazy.Char8 (pack,unpack)
import Text.Regex.Posix           ((=~))
import Data.Bifunctor             (first)


-- | Corresponds to the JSON object returned by ANU, minus 'q' prefixes.
--   The 'process' function performs appropriate renamings.
data QRResponse = QRResponse { qtype   :: !Text
                             , qlength :: !Int
                             , qdata   :: ![Int]
                             , success :: !Bool } deriving (Show, Generic)

-- | Corresponds to the JSON object in which settings are stored locally.
data QRSettings = QRSettings { minStoreSize :: Int
                             , targetStoreSize :: Int
                             , defaultDisplayStyle :: DisplayStyle } deriving (Show, Generic)


instance FromJSON QRResponse
instance ToJSON   QRResponse
instance FromJSON QRSettings
instance ToJSON   QRSettings

-- | Default settings.
defaults :: QRSettings
defaults = QRSettings 400 800 ColorHex

-- | Update the minimum store size field of a settings record.
updateMinSize :: Int -> QRSettings -> QRSettings
updateMinSize n qs = qs { minStoreSize = n }

-- | Update the target store size field of a settings record.
updateTarSize :: Int -> QRSettings -> QRSettings
updateTarSize n qs = qs { targetStoreSize = n }

-- | Update the default 'DisplayStyle' of a settings record.
updateDefaultStyle :: DisplayStyle -> QRSettings -> QRSettings
updateDefaultStyle sty qs = qs { defaultDisplayStyle = sty }

-- | Replace instances of the words "data", "type", "length", with "qdata", "qtype", "qlength"
--   respectively, to avoid clashes between record field names and keywords/Prelude.
process :: ByteString -> ByteString
process = pack . repData . repType . repLength . unpack

repData :: String -> String
repData = replaceWord "data" "qdata"

repType :: String -> String
repType = replaceWord "type" "qtype"

repLength :: String -> String
repLength = replaceWord "length" "qlength"


replaceWord :: String -> String -> String -> String
replaceWord x y s = let (a,_,c) = s =~ x :: (String, String, String)
                    in  a ++ y ++ c

-- | From a Bytestring, attempt to decode a response from ANU ('QRResponse').
parseResponse :: ByteString -> Either QRException QRResponse
parseResponse = first ParseResponseError . eitherDecode . process

-- | From a Bytestring, attempt to decode a settings record.
parseSettings :: ByteString -> Either QRException QRSettings
parseSettings = first ParseSettingsError . eitherDecode