module Rest.Types.Container
( List(..)
, StringMap(..)
, fromStringMap
, toStringMap
, SomeOutput(..)
) where
import Control.Applicative
import Data.Aeson
import Data.JSON.Schema hiding (Object, Value)
import Data.JSON.Schema.Combinators (field)
import Data.Map (Map)
import Data.String
import Data.String.ToString
import Data.Text (pack, unpack)
import Data.Typeable
import GHC.Generics
import Generics.Generic.Aeson
import Generics.Regular (PF, deriveAll)
import Generics.Regular.XmlPickler (gxpickle)
import Text.XML.HXT.Arrow.Pickle
import Text.XML.HXT.Arrow.Pickle.Schema
import Text.XML.HXT.Arrow.Pickle.Xml
import qualified Data.HashMap.Strict as H
import qualified Data.Map as M
data List a = List
{ offset :: Int
, count :: Int
, items :: [a]
} deriving (Generic, Show, Typeable)
deriveAll ''List "PFList"
type instance PF (List a) = PFList a
instance XmlPickler a => XmlPickler (List a) where xpickle = gxpickle
instance ToJSON a => ToJSON (List a) where toJSON = gtoJson
instance FromJSON a => FromJSON (List a) where parseJSON = gparseJson
instance JSONSchema a => JSONSchema (List a) where schema = gSchema
newtype StringMap a b = StringMap { unMap :: [(a, b)] } deriving (Show, Typeable)
deriveAll ''StringMap "PFStringMap"
type instance PF (StringMap a b) = PFStringMap a b
instance (IsString a, ToString a, XmlPickler b) => XmlPickler (StringMap a b) where
xpickle = xpElem "map" (xpWrap (StringMap, unMap) (xpList (xpPair (xpElem "key" (xpWrap (fromString,toString) xpText)) xpickle)))
instance (ToString a, ToJSON b) => ToJSON (StringMap a b) where
toJSON = toJSON . Object . H.fromList . map (\(a,b) -> pack (toString a) .= b) . unMap
instance (IsString a, FromJSON b) => FromJSON (StringMap a b) where
parseJSON = withObject "StringMap" (fmap StringMap . mapM (\(k,v) -> (fromString . unpack $ k,) <$> parseJSON v) . H.toList)
instance (IsString a, ToString a, JSONSchema b) => JSONSchema (StringMap a b) where
schema _ = field "key" False (schema (Proxy :: Proxy b))
fromStringMap :: (Ord a, IsString a, ToString a) => StringMap a b -> Map a b
fromStringMap = M.fromList . unMap
toStringMap :: (Ord a, IsString a, ToString a) => Map a b -> StringMap a b
toStringMap = StringMap . M.toList
data SomeOutput where
SomeOutput :: (XmlPickler o, ToJSON o, JSONSchema o) => o -> SomeOutput
deriving instance Typeable SomeOutput
instance XmlPickler SomeOutput where
xpickle = PU
(\(SomeOutput e) st -> appPickle xpickle e st)
(throwMsg "Cannot unpickle SomeOutput.")
Any
instance ToJSON SomeOutput where toJSON (SomeOutput r) = toJSON r
instance JSONSchema SomeOutput where
schema _ = Choice []