1 files changed, 38 insertions, 0 deletions
diff --git a/Val.hs b/Val.hs
new file mode 100644
index 0000000..86a35c9
--- /dev/null
+++ b/Val.hs
@@ -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)