{-# LANGUAGE FlexibleInstances #-} --------------------------------------------------------- -- -- Module : Data.Object.Instances -- Copyright : Michael Snoyman -- License : BSD3 -- -- Maintainer : Michael Snoyman -- Stability : Stable -- Portability : portable -- -- Instances for converting various types of data into Data.Object.Object. -- --------------------------------------------------------- module Data.Object.Instances ( Json (..) , Yaml (..) , Html (..) , SafeFromObject (..) ) where import Data.Object import qualified Data.ByteString.Lazy as B import Data.ByteString.Class import Web.Encodings (encodeJson) import Text.Yaml (encode) class SafeFromObject a where safeFromObject :: Object -> a newtype Json = Json { unJson :: B.ByteString } instance SafeFromObject Json where safeFromObject = Json . helper where helper :: Object -> B.ByteString helper (Scalar s) = B.concat [ toLazyByteString "\"" , encodeJson $ fromLazyByteString s , toLazyByteString "\"" ] helper (Sequence s) = B.concat [ toLazyByteString "[" , B.intercalate (toLazyByteString ",") $ map helper s , toLazyByteString "]" ] helper (Mapping m) = B.concat [ toLazyByteString "{" , B.intercalate (toLazyByteString ",") $ map helper2 m , toLazyByteString "}" ] helper2 :: (B.ByteString, Object) -> B.ByteString helper2 (k, v) = B.concat [ toLazyByteString "\"" , encodeJson $ fromLazyByteString k , toLazyByteString "\":" , helper v ] newtype Yaml = Yaml { unYaml :: B.ByteString } instance SafeFromObject Yaml where safeFromObject = Yaml . encode -- | Represents as an entire HTML 5 document by using the following: -- -- * A scalar is a paragraph. -- * A sequence is an unordered list. -- * A mapping is a definition list. newtype Html = Html { unHtml :: B.ByteString } instance SafeFromObject Html where safeFromObject o = Html $ B.concat [ toLazyByteString "\n" -- FIXME full doc or just fragment? , helper o , toLazyByteString "" ] where helper :: Object -> B.ByteString helper (Scalar s) = B.concat [ toLazyByteString "

" , toLazyByteString s , toLazyByteString "

" ] helper (Sequence []) = toLazyByteString "

" helper (Sequence s) = B.concat [ toLazyByteString "

" , B.intercalate (toLazyByteString "
") $ map helper s , toLazyByteString "

" ] helper (Mapping m) = B.concat $ toLazyByteString "

" : map helper2 m ++ [ toLazyByteString "" ] helper2 :: (B.ByteString, Object) -> B.ByteString helper2 (k, v) = B.concat $ [ toLazyByteString "

" , toLazyByteString k , toLazyByteString "

" , helper v , toLazyByteString "

" ]