{-# LANGUAGE FlexibleContexts #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE CPP #-}{-# LANGUAGE DeriveDataTypeable #-}{-# LANGUAGE MultiParamTypeClasses #-}{-# LANGUAGE PatternGuards #-}{-# LANGUAGE ScopedTypeVariables #-}{-# LANGUAGE OverloadedStrings #-}-- | Provides a high-level interface for processing YAML files.---- This module reuses most of the infrastructure from the @aeson@ package.-- This means that you can use all of the existing tools for JSON-- processing for processing YAML files. As a result, much of the-- documentation below mentions JSON; do not let that confuse you, it's-- intentional.---- For the most part, YAML content translates directly into JSON, and-- therefore there is very little data loss. If you need to deal with YAML-- more directly (e.g., directly deal with aliases), you should use the-- "Text.Libyaml" module instead.---- For documentation on the @aeson@ types, functions, classes, and-- operators, please see the @Data.Aeson@ module of the @aeson@ package.moduleData.Yaml(-- * TypesValue(..),Parser,Object,Array,ParseException(..),YamlException(..),YamlMark(..)-- * Constructors and accessors,object,array,(.=),(.:),(.:?),(.!=)-- * Parsing,parseMonad,parseEither,parseMaybe-- * Classes,ToJSON(..),FromJSON(..)-- * Encoding/decoding,encode,encodeFile,decode,decodeFile-- ** Better error information,decodeEither,decodeEither',decodeFileEither-- ** More control over decoding,decodeHelper)whereimportqualifiedText.LibyamlasYimportData.Aeson(Value(..),ToJSON(..),FromJSON(..),object,(.=),(.:),(.:?),(.!=),Object,Array)importData.Aeson.Types(Pair,parseMaybe,parseEither,Parser)importText.Libyamlhiding(encode,decode,encodeFile,decodeFile)importData.ByteString(ByteString)importqualifiedData.ByteString.Char8asS8importqualifiedData.MapasMapimportSystem.IO.Unsafe(unsafePerformIO)importControl.Exception(try,throwIO,fromException,Exception,SomeException,AsyncException)importControl.Monad.Trans.StateimportqualifiedData.ConduitasCimportqualifiedData.Conduit.ListasCLimportControl.Monad.Trans.Class(MonadTrans,lift)importControl.Monad.IO.Class(MonadIO,liftIO)importControl.Monad(liftM)importData.Char(toUpper)importqualifiedData.VectorasVimportData.Text(Text,pack)importqualifiedData.TextasTimportData.Text.Read(signed,decimal,double)importData.Text.Encoding(encodeUtf8,decodeUtf8With)importData.Text.Encoding.Error(lenientDecode)importqualifiedData.HashMap.StrictasMimportData.TypeableimportData.Attoparsec.NumberimportqualifiedData.HashSetasHashSetencode::ToJSONa=>a->ByteStringencodeobj=unsafePerformIO$C.runResourceT$CL.sourceList(objToEvents$toJSONobj)C.$$Y.encodeencodeFile::ToJSONa=>FilePath->a->IO()encodeFilefpobj=C.runResourceT$CL.sourceList(objToEvents$toJSONobj)C.$$Y.encodeFilefpobjToEvents::Value->[Y.Event]objToEventso=(:)EventStreamStart.(:)EventDocumentStart$objToEvents'o[EventDocumentEnd,EventStreamEnd]{- FIXME
scalarToEvent :: YamlScalar -> Event
scalarToEvent (YamlScalar v t s) = EventScalar v t s Nothing
-}objToEvents'::Value->[Y.Event]->[Y.Event]--objToEvents' (Scalar s) rest = scalarToEvent s : restobjToEvents'(Arraylist)rest=EventSequenceStartNothing:foldr($)(EventSequenceEnd:rest)(mapobjToEvents'$V.toListlist)objToEvents'(Objectpairs)rest=EventMappingStartNothing:foldr($)(EventMappingEnd:rest)(mappairToEvents$M.toListpairs)-- Empty strings need special handling to ensure they get quoted. This avoids:-- https://github.com/snoyberg/yaml/issues/24objToEvents'(String"")rest=EventScalar""NoTagSingleQuotedNothing:restobjToEvents'(Strings)rest=event:restwhereevent-- Make sure that special strings are encoded as strings properly.-- See: https://github.com/snoyberg/yaml/issues/31|s`HashSet.member`specialStrings=EventScalar(encodeUtf8s)NoTagSingleQuotedNothing|otherwise=EventScalar(encodeUtf8s)StrTagPlainNoTagNothingobjToEvents'Nullrest=EventScalar"null"NullTagPlainNoTagNothing:restobjToEvents'(BoolTrue)rest=EventScalar"true"BoolTagPlainNoTagNothing:restobjToEvents'(BoolFalse)rest=EventScalar"false"BoolTagPlainNoTagNothing:restobjToEvents'(Numbern)rest=EventScalar(S8.pack$shown)IntTagPlainNoTagNothing:restpairToEvents::Pair->[Y.Event]->[Y.Event]pairToEvents(k,v)rest=EventScalar(encodeUtf8k)StrTagPlainNoTagNothing:objToEvents'vrest-- | Strings which must be escaped so as not to be treated as non-string scalars.specialStrings::HashSet.HashSetTextspecialStrings=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 ~"-- ParsingdataParseException=NonScalarKey|UnknownAlias{_anchorName::Y.AnchorName}|UnexpectedEvent{_received::MaybeEvent,_expected::MaybeEvent}|InvalidYaml(MaybeYamlException)|AesonExceptionString|OtherParseExceptionSomeExceptionderiving(Show,Typeable)instanceExceptionParseExceptionnewtypePErrorTma=PErrorT{runPErrorT::m(EitherParseExceptiona)}instanceMonadm=>Monad(PErrorTm)wherereturn=PErrorT.return.Right(PErrorTm)>>=f=PErrorT$doe<-mcaseeofLefte'->return$Lefte'Righta->runPErrorT$fainstanceMonadTransPErrorTwherelift=PErrorT.liftMRightinstanceMonadIOm=>MonadIO(PErrorTm)whereliftIO=lift.liftIOtypeParse=StateT(Map.MapStringValue)(C.ResourceTIO)requireEvent::Event->C.SinkEventParse()requireEvente=dof<-CL.headiff==Justethenreturn()elseliftIO$throwIO$UnexpectedEventf$Justeparse::C.SinkEventParseValueparse=dorequireEventEventStreamStartrequireEventEventDocumentStartres<-parseOrequireEventEventDocumentEndrequireEventEventStreamEndreturnresparseScalar::ByteString->Anchor->Style->Tag->C.SinkEventParseTextparseScalarvastyletag=doletres=decodeUtf8WithlenientDecodevcaseaofNothing->returnresJustan->dolift$modify(Map.insertan$textToValuestyletagres)returnrestextToValue::Style->Tag->Text->ValuetextToValueSingleQuoted_t=StringttextToValueDoubleQuoted_t=StringttextToValue_StrTagt=StringttextToValueFolded_t=StringttextToValue__t|t`elem`["null","Null","NULL","~",""]=Null|any(t`isLike`)["y","yes","on","true"]=BoolTrue|any(t`isLike`)["n","no","off","false"]=BoolFalse|Right(x,"")<-signeddecimalt=Number$Ix|Right(x,"")<-doublet=Number$Dx|otherwise=Stringtwherex`isLike`ref=x`elem`[ref,T.toUpperref,titleCased]wheretitleCased=toUpper(T.headref)`T.cons`T.tailrefparseO::C.SinkEventParseValueparseO=dome<-CL.headcasemeofJust(EventScalarvtagstylea)->fmap(textToValuestyletag)$parseScalarvastyletagJust(EventSequenceStarta)->parseSaidJust(EventMappingStarta)->parseMaM.emptyJust(EventAliasan)->dom<-liftgetcaseMap.lookupanmofNothing->liftIO$throwIO$UnknownAliasanJustv->returnv_->liftIO$throwIO$UnexpectedEventmeNothingparseS::Y.Anchor->([Value]->[Value])->C.SinkEventParseValueparseSafront=dome<-CL.peekcasemeofJustEventSequenceEnd->doCL.drop1letres=Array$V.fromList$front[]caseaofNothing->returnresJustan->dolift$modify$Map.insertanresreturnres_->doo<-parseOparseSa$front.(:)oparseM::Y.Anchor->M.HashMapTextValue->C.SinkEventParseValueparseMafront=dome<-CL.peekcasemeofJustEventMappingEnd->doCL.drop1letres=ObjectfrontcaseaofNothing->returnresJustan->dolift$modify$Map.insertanresreturnres_->doCL.drop1s<-casemeofJust(EventScalarvtagstylea')->parseScalarva'styletag_->liftIO$throwIO$UnexpectedEventmeNothingo<-parseOletal=M.insertsofrontal'=ifs==pack"<<"thencaseoofObjectl->M.unionfrontlArrayl->M.unionfront$foldlmerge'M.empty$V.toListl_->alelsealparseMaal'wheremerge'al(Objectom)=M.unionalommerge'al_=aldecode::FromJSONa=>ByteString->Maybeadecodebs=unsafePerformIO$fmap(either(constNothing)(either(constNothing)Just))$decodeHelper(Y.decodebs)decodeFile::FromJSONa=>FilePath->IO(Maybea)decodeFilefp=decodeHelper(Y.decodeFilefp)>>=eitherthrowIO(return.either(constNothing)id)-- | A version of 'decodeFile' which should not throw runtime exceptions.---- Since 0.8.4decodeFileEither::FromJSONa=>FilePath->IO(EitherParseExceptiona)decodeFileEitherfp=dox<-try$C.runResourceT$flipevalStateTMap.empty$Y.decodeFilefpC.$$parsecasexofLefte|Justpe<-fromExceptione->return$Leftpe|Justye<-fromExceptione->return$Left$InvalidYaml$Just(ye::YamlException)|shouldBeCaughte->return$Left$OtherParseExceptione|otherwise->throwIOeRighty->return$caseparseEitherparseJSONyofLefts->Left$AesonExceptionsRightv->Rightvwhere-- FIXME this function needs more thoughtshouldBeCaughte|Just(_::AsyncException)<-fromExceptione=False-- Would be nice... | Just (_ :: Timeout) <- fromException e = False|otherwise=TruedecodeEither::FromJSONa=>ByteString->EitherStringadecodeEitherbs=unsafePerformIO$fmap(either(Left.show)id)$decodeHelper(Y.decodebs)-- | More helpful version of 'decodeEither' which returns the 'YamlException'.---- Since 0.8.3decodeEither'::FromJSONa=>ByteString->EitherParseExceptionadecodeEither'=eitherLeft(either(Left.AesonException)Right).unsafePerformIO.decodeHelper.Y.decodedecodeHelper::FromJSONa=>C.SourceParseY.Event->IO(EitherParseException(EitherStringa))decodeHelpersrc=dox<-try$C.runResourceT$flipevalStateTMap.empty$srcC.$$parsecasexofLefte|Justpe<-fromExceptione->return$Leftpe|Justye<-fromExceptione->return$Left$InvalidYaml$Just(ye::YamlException)|otherwise->throwIOeRighty->return$Right$parseEitherparseJSONyarray::[Value]->Valuearray=Array.V.fromListparseMonad::Monadm=>(a->Parserb)->a->mbparseMonadp=eitherfailreturn.parseEitherp