{-# LANGUAGE OverloadedStrings #-}
module Data.Yaml.Util( encodeYaml, encodeYamlFile
, decodeYaml, decodeYamlFile
, printYaml
, parseVersioned
, Versioned(Versioned), unversioned
) where
import Control.Applicative
import Data.Aeson
import Data.Aeson.Types (typeMismatch)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import Data.Version
import Data.Yaml
import qualified Data.Yaml.Pretty as YamlP
import GHC.Generics (Generic)
import Text.ParserCombinators.ReadP (readP_to_S)
encodeYaml :: ToJSON a => a -> ByteString
encodeYaml = YamlP.encodePretty YamlP.defConfig
printYaml :: ToJSON a => a -> IO ()
printYaml = B.putStrLn . encodeYaml
decodeYaml :: FromJSON a => ByteString -> Either ParseException a
decodeYaml = decodeEither'
decodeYamlFile :: FromJSON a => FilePath -> IO (Either ParseException a)
decodeYamlFile = decodeFileEither
encodeYamlFile :: ToJSON a => FilePath -> a -> IO ()
encodeYamlFile fp = B.writeFile fp . encodeYaml
data Versioned a = Versioned { version :: Version
, content :: a
} deriving (Show,Read,Generic,Eq,Functor,Foldable,Traversable)
unversioned :: Versioned a -> a
unversioned = content
instance ToJSON a => ToJSON (Versioned a) where
toJSON (Versioned v x) = object [ "version" .= showVersion v, "content" .= x]
toEncoding (Versioned v x) = pairs ("version" .= showVersion v <> "content" .= x)
parseVersioned :: [(Version -> Bool,Value -> Parser a)]
-> Value -> Parser (Versioned a)
parseVersioned ps (Object o) = do V v <- o .: "version"
co <- o .: "content"
let ps' = map (\(_,p) -> Versioned v <$> p co)
. filter (($ v) . fst) $ ps
err = fail $ "no matching version found for version "
<> showVersion v
foldr (<|>) err ps'
parseVersioned _ invalid = typeMismatch "Versioned" invalid
newtype V = V Version
instance FromJSON V where
parseJSON (String t) = case filter (null . snd) (readP_to_S parseVersion $ T.unpack t) of
((v,""):_) -> pure $ V v
_ -> fail $ "parsing " <> show t <> " into a version failed"
parseJSON invalid = typeMismatch "Version" invalid