module Data.Aeson.Types
(
Value(..)
, Array
, Object
, FromJSON(..)
, ToJSON(..)
, (.=)
, (.:)
, (.:?)
, object
) where
import Control.Applicative
import Control.DeepSeq (NFData(..))
import Data.Map (Map)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Text (Text, pack, unpack)
import qualified Data.Text.Lazy as LT
import Data.Time.Clock (UTCTime)
import Data.Time.Format (formatTime, parseTime)
import Data.Typeable (Typeable)
import Data.Vector (Vector)
import System.Locale (defaultTimeLocale)
import qualified Data.Map as M
import qualified Data.Vector as V
type Object = Map Text Value
type Array = Vector Value
data Value = Object Object
| Array Array
| String Text
| Number Double
| Bool !Bool
| Null
deriving (Eq, Show, Typeable)
instance NFData Value where
rnf (Object o) = rnf o
rnf (Array a) = V.foldl' (\x y -> rnf y `seq` x) () a
rnf (String s) = rnf s
rnf (Number n) = rnf n
rnf (Bool b) = rnf b
rnf Null = ()
(.=) :: ToJSON a => Text -> a -> Object
name .= value = M.singleton name (toJSON value)
(.:) :: (Alternative f, FromJSON a) => Object -> Text -> f a
obj .: key = case M.lookup key obj of
Nothing -> empty
Just v -> fromJSON v
(.:?) :: (Alternative f, FromJSON a) => Object -> Text -> f (Maybe a)
obj .:? key = case M.lookup key obj of
Nothing -> pure Nothing
Just v -> fromJSON v
object :: [Object] -> Value
object = Object . M.unions
class ToJSON a where
toJSON :: a -> Value
class FromJSON a where
fromJSON :: Alternative f => Value -> f a
instance (ToJSON a) => ToJSON (Maybe a) where
toJSON (Just a) = toJSON a
toJSON Nothing = Null
instance (FromJSON a) => FromJSON (Maybe a) where
fromJSON Null = pure Nothing
fromJSON a = Just <$> fromJSON a
instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
toJSON (Left a) = toJSON a
toJSON (Right b) = toJSON b
instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where
fromJSON a = Left <$> fromJSON a <|> Right <$> fromJSON a
instance ToJSON Bool where
toJSON = Bool
instance FromJSON Bool where
fromJSON (Bool b) = pure b
fromJSON _ = empty
instance ToJSON Double where
toJSON = Number
instance FromJSON Double where
fromJSON (Number n) = pure n
fromJSON _ = empty
instance ToJSON Int where
toJSON = Number . fromIntegral
instance FromJSON Int where
fromJSON (Number n) = pure (floor n)
fromJSON _ = empty
instance ToJSON Integer where
toJSON = Number . fromIntegral
instance FromJSON Integer where
fromJSON (Number n) = pure (floor n)
fromJSON _ = empty
instance ToJSON Text where
toJSON = String
instance FromJSON Text where
fromJSON (String t) = pure t
fromJSON _ = empty
instance ToJSON LT.Text where
toJSON = String . LT.toStrict
instance FromJSON LT.Text where
fromJSON (String t) = pure (LT.fromStrict t)
fromJSON _ = empty
instance ToJSON B.ByteString where
toJSON = String . decodeUtf8
instance FromJSON B.ByteString where
fromJSON (String t) = pure . encodeUtf8 $ t
fromJSON _ = empty
instance ToJSON LB.ByteString where
toJSON = toJSON . B.concat . LB.toChunks
instance FromJSON LB.ByteString where
fromJSON (String t) = pure . LB.fromChunks . (:[]) . encodeUtf8 $ t
fromJSON _ = empty
mapA :: (Applicative f) => (t -> f a) -> [t] -> f [a]
mapA f = go
where
go (a:as) = (:) <$> f a <*> go as
go [] = pure []
instance (ToJSON a) => ToJSON [a] where
toJSON = Array . V.fromList . map toJSON
instance (FromJSON a) => FromJSON [a] where
fromJSON (Array a) = mapA fromJSON (V.toList a)
fromJSON _ = empty
instance (ToJSON a) => ToJSON (Vector a) where
toJSON = Array . V.map toJSON
instance (FromJSON a) => FromJSON (Vector a) where
fromJSON (Array a) = V.fromList <$> mapA fromJSON (V.toList a)
fromJSON _ = empty
instance ToJSON Value where
toJSON a = a
instance FromJSON Value where
fromJSON a = pure a
instance ToJSON UTCTime where
toJSON t = String (pack (formatTime defaultTimeLocale "/Date(%s)/" t))
instance FromJSON UTCTime where
fromJSON (String t) =
case parseTime defaultTimeLocale "/Date(%s)/" (unpack t) of
Just d -> pure d
_ -> empty
fromJSON _ = empty
instance (ToJSON a, ToJSON b) => ToJSON (a,b) where
toJSON (a,b) = toJSON [toJSON a, toJSON b]
instance (FromJSON a, FromJSON b) => FromJSON (a,b) where
fromJSON (Array ab) = case V.toList ab of
[a,b] -> (,) <$> fromJSON a <*> fromJSON b
_ -> empty
fromJSON _ = empty