module Data.Yaml
(
Value (..)
, Parser
, Object
, Array
, ParseException(..)
, prettyPrintParseException
, YamlException (..)
, YamlMark (..)
, object
, array
, (.=)
, (.:)
, (.:?)
, (.!=)
, parseMonad
, parseEither
, parseMaybe
, ToJSON (..)
, FromJSON (..)
, encode
, encodeFile
, decode
, decodeFile
, decodeEither
, decodeEither'
, decodeFileEither
, decodeHelper
) where
import qualified Text.Libyaml as Y
import Data.Aeson
( Value (..), ToJSON (..), FromJSON (..), object
, (.=) , (.:) , (.:?) , (.!=)
, Object, Array
)
import Data.Aeson.Types (Pair, parseMaybe, parseEither, Parser)
import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile)
import Data.ByteString (ByteString)
import System.IO.Unsafe (unsafePerformIO)
import Control.Exception
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import qualified Data.Vector as V
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import qualified Data.HashMap.Strict as M
import qualified Data.HashSet as HashSet
#if MIN_VERSION_aeson(0, 7, 0)
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Builder (toLazyText)
import Data.Aeson.Encode (encodeToTextBuilder)
#else
import qualified Data.ByteString.Char8 as S8
#endif
import Control.Monad.Trans.Resource (runResourceT)
import Data.Yaml.Internal
encode :: ToJSON a => a -> ByteString
encode obj = unsafePerformIO $
runResourceT $ CL.sourceList (objToEvents $ toJSON obj)
C.$$ Y.encode
encodeFile :: ToJSON a => FilePath -> a -> IO ()
encodeFile fp obj = runResourceT
$ CL.sourceList (objToEvents $ toJSON obj)
C.$$ Y.encodeFile fp
objToEvents :: Value -> [Y.Event]
objToEvents o = (:) EventStreamStart
. (:) EventDocumentStart
$ objToEvents' o
[ EventDocumentEnd
, EventStreamEnd
]
objToEvents' :: Value -> [Y.Event] -> [Y.Event]
objToEvents' (Array list) rest =
EventSequenceStart Nothing
: foldr ($) (EventSequenceEnd : rest) (map objToEvents' $ V.toList list)
objToEvents' (Object pairs) rest =
EventMappingStart Nothing
: foldr ($) (EventMappingEnd : rest) (map pairToEvents $ M.toList pairs)
objToEvents' (String "") rest = EventScalar "" NoTag SingleQuoted Nothing : rest
objToEvents' (String s) rest =
event : rest
where
event
| s `HashSet.member` specialStrings || isNumeric s = EventScalar (encodeUtf8 s) NoTag SingleQuoted Nothing
| otherwise = EventScalar (encodeUtf8 s) StrTag PlainNoTag Nothing
objToEvents' Null rest = EventScalar "null" NullTag PlainNoTag Nothing : rest
objToEvents' (Bool True) rest = EventScalar "true" BoolTag PlainNoTag Nothing : rest
objToEvents' (Bool False) rest = EventScalar "false" BoolTag PlainNoTag Nothing : rest
#if MIN_VERSION_aeson(0,7,0)
objToEvents' n@Number{} rest = EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder n) IntTag PlainNoTag Nothing : rest
#else
objToEvents' (Number n) rest = EventScalar (S8.pack $ show n) IntTag PlainNoTag Nothing : rest
#endif
pairToEvents :: Pair -> [Y.Event] -> [Y.Event]
pairToEvents (k, v) rest =
EventScalar (encodeUtf8 k) StrTag PlainNoTag Nothing
: objToEvents' v rest
specialStrings :: HashSet.HashSet Text
specialStrings = HashSet.fromList $ T.words
"y Y yes Yes YES n N no No NO true True TRUE false False FALSE on On ON off Off OFF null Null NULL ~"
isNumeric :: Text -> Bool
isNumeric =
T.all isNumeric'
where
isNumeric' c = ('0' <= c && c <= '9')
|| c == 'e'
|| c == 'E'
|| c == '.'
|| c == '-'
decode :: FromJSON a
=> ByteString
-> Maybe a
decode bs = unsafePerformIO
$ fmap (either (const Nothing) id)
$ decodeHelper_ (Y.decode bs)
decodeFile :: FromJSON a
=> FilePath
-> IO (Maybe a)
decodeFile fp = decodeHelper (Y.decodeFile fp) >>= either throwIO (return . either (const Nothing) id)
decodeFileEither
:: FromJSON a
=> FilePath
-> IO (Either ParseException a)
decodeFileEither = decodeHelper_ . Y.decodeFile
decodeEither :: FromJSON a => ByteString -> Either String a
decodeEither bs = unsafePerformIO
$ fmap (either (Left . show) id)
$ decodeHelper (Y.decode bs)
decodeEither' :: FromJSON a => ByteString -> Either ParseException a
decodeEither' = either Left (either (Left . AesonException) Right)
. unsafePerformIO
. decodeHelper
. Y.decode
array :: [Value] -> Value
array = Array . V.fromList
parseMonad :: Monad m => (a -> Parser b) -> a -> m b
parseMonad p = either fail return . parseEither p