diff options
Diffstat (limited to 'Val.hs')
-rw-r--r-- | Val.hs | 38 |
1 files changed, 38 insertions, 0 deletions
@@ -0,0 +1,38 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric, FlexibleInstances, OverloadedStrings #-} + +module Val where + +import Data.ByteString +import GHC.Generics (Generic) +import Data.Aeson +import Data.Aeson.Types +import qualified Codec.Binary.Base64 as B64 +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +-- | Newtype of ByteString so we can have JSON instances without orphans. +newtype Val = Val { val :: ByteString } + deriving (Show, Generic, Eq, Monoid) + +-- | JSON instances for Val, using base64 encoding when the value +-- is not utf-8 encoded, and otherwise using a more efficient encoding. +instance ToJSON Val where + toJSON (Val b) = case T.decodeUtf8' b of + Right v -> object [ "v" .= v ] + Left _ -> object [ "b64" .= b64 b ] +instance FromJSON Val where + parseJSON (Object o) = do + mv <- o .:? "v" + case mv of + Just v -> return $ Val $ T.encodeUtf8 v + Nothing -> Val <$> (unb64 =<< o .: "b64") + parseJSON invalid = typeMismatch "ByteString" invalid + +b64 :: ByteString -> T.Text +b64 = T.decodeUtf8 . B64.encode + +unb64 :: Monad m => T.Text -> m ByteString +unb64 t = either + (\_ -> fail "bad base64 data") + return + ( B64.decode $ T.encodeUtf8 t) |