{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Yaml.Util
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
-- Description :  Helper functions for working with yaml
--
--------------------------------------------------------------------------------
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)

--------------------------------------------------------------------------------

-- | Write the output to yaml
encodeYaml :: ToJSON a => a -> ByteString
encodeYaml :: a -> ByteString
encodeYaml = Config -> a -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
YamlP.encodePretty Config
encoderConfig

-- | Prints the yaml
printYaml :: ToJSON a => a -> IO ()
printYaml :: a -> IO ()
printYaml = ByteString -> IO ()
B.putStrLn (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encodeYaml

-- | alias for decodeEither' from the Yaml Package
decodeYaml :: FromJSON a => ByteString -> Either ParseException a
decodeYaml :: ByteString -> Either ParseException a
decodeYaml = ByteString -> Either ParseException a
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither'

-- | alias for reading a yaml file
decodeYamlFile :: FromJSON a => FilePath -> IO (Either ParseException a)
decodeYamlFile :: FilePath -> IO (Either ParseException a)
decodeYamlFile = FilePath -> IO (Either ParseException a)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
decodeFileEither

-- | Encode a yaml file
encodeYamlFile    :: ToJSON a => FilePath -> a -> IO ()
encodeYamlFile :: FilePath -> a -> IO ()
encodeYamlFile FilePath
fp = FilePath -> ByteString -> IO ()
B.writeFile FilePath
fp (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encodeYaml



--------------------------------------------------------------------------------

-- | Encoder Configuration that we want to use.
encoderConfig :: YamlP.Config
encoderConfig :: Config
encoderConfig = (Text -> Text -> Ordering) -> Config -> Config
YamlP.setConfCompare Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Config
YamlP.defConfig
                -- sort fields alphabetically

--------------------------------------------------------------------------------


-- | Data type for things that have a version
data Versioned a = Versioned { Versioned a -> Version
version :: Version
                             , Versioned a -> a
content :: a
                             } deriving (Int -> Versioned a -> ShowS
[Versioned a] -> ShowS
Versioned a -> FilePath
(Int -> Versioned a -> ShowS)
-> (Versioned a -> FilePath)
-> ([Versioned a] -> ShowS)
-> Show (Versioned a)
forall a. Show a => Int -> Versioned a -> ShowS
forall a. Show a => [Versioned a] -> ShowS
forall a. Show a => Versioned a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Versioned a] -> ShowS
$cshowList :: forall a. Show a => [Versioned a] -> ShowS
show :: Versioned a -> FilePath
$cshow :: forall a. Show a => Versioned a -> FilePath
showsPrec :: Int -> Versioned a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Versioned a -> ShowS
Show,ReadPrec [Versioned a]
ReadPrec (Versioned a)
Int -> ReadS (Versioned a)
ReadS [Versioned a]
(Int -> ReadS (Versioned a))
-> ReadS [Versioned a]
-> ReadPrec (Versioned a)
-> ReadPrec [Versioned a]
-> Read (Versioned a)
forall a. Read a => ReadPrec [Versioned a]
forall a. Read a => ReadPrec (Versioned a)
forall a. Read a => Int -> ReadS (Versioned a)
forall a. Read a => ReadS [Versioned a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Versioned a]
$creadListPrec :: forall a. Read a => ReadPrec [Versioned a]
readPrec :: ReadPrec (Versioned a)
$creadPrec :: forall a. Read a => ReadPrec (Versioned a)
readList :: ReadS [Versioned a]
$creadList :: forall a. Read a => ReadS [Versioned a]
readsPrec :: Int -> ReadS (Versioned a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Versioned a)
Read,(forall x. Versioned a -> Rep (Versioned a) x)
-> (forall x. Rep (Versioned a) x -> Versioned a)
-> Generic (Versioned a)
forall x. Rep (Versioned a) x -> Versioned a
forall x. Versioned a -> Rep (Versioned a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Versioned a) x -> Versioned a
forall a x. Versioned a -> Rep (Versioned a) x
$cto :: forall a x. Rep (Versioned a) x -> Versioned a
$cfrom :: forall a x. Versioned a -> Rep (Versioned a) x
Generic,Versioned a -> Versioned a -> Bool
(Versioned a -> Versioned a -> Bool)
-> (Versioned a -> Versioned a -> Bool) -> Eq (Versioned a)
forall a. Eq a => Versioned a -> Versioned a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Versioned a -> Versioned a -> Bool
$c/= :: forall a. Eq a => Versioned a -> Versioned a -> Bool
== :: Versioned a -> Versioned a -> Bool
$c== :: forall a. Eq a => Versioned a -> Versioned a -> Bool
Eq,a -> Versioned b -> Versioned a
(a -> b) -> Versioned a -> Versioned b
(forall a b. (a -> b) -> Versioned a -> Versioned b)
-> (forall a b. a -> Versioned b -> Versioned a)
-> Functor Versioned
forall a b. a -> Versioned b -> Versioned a
forall a b. (a -> b) -> Versioned a -> Versioned b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Versioned b -> Versioned a
$c<$ :: forall a b. a -> Versioned b -> Versioned a
fmap :: (a -> b) -> Versioned a -> Versioned b
$cfmap :: forall a b. (a -> b) -> Versioned a -> Versioned b
Functor,Versioned a -> Bool
(a -> m) -> Versioned a -> m
(a -> b -> b) -> b -> Versioned a -> b
(forall m. Monoid m => Versioned m -> m)
-> (forall m a. Monoid m => (a -> m) -> Versioned a -> m)
-> (forall m a. Monoid m => (a -> m) -> Versioned a -> m)
-> (forall a b. (a -> b -> b) -> b -> Versioned a -> b)
-> (forall a b. (a -> b -> b) -> b -> Versioned a -> b)
-> (forall b a. (b -> a -> b) -> b -> Versioned a -> b)
-> (forall b a. (b -> a -> b) -> b -> Versioned a -> b)
-> (forall a. (a -> a -> a) -> Versioned a -> a)
-> (forall a. (a -> a -> a) -> Versioned a -> a)
-> (forall a. Versioned a -> [a])
-> (forall a. Versioned a -> Bool)
-> (forall a. Versioned a -> Int)
-> (forall a. Eq a => a -> Versioned a -> Bool)
-> (forall a. Ord a => Versioned a -> a)
-> (forall a. Ord a => Versioned a -> a)
-> (forall a. Num a => Versioned a -> a)
-> (forall a. Num a => Versioned a -> a)
-> Foldable Versioned
forall a. Eq a => a -> Versioned a -> Bool
forall a. Num a => Versioned a -> a
forall a. Ord a => Versioned a -> a
forall m. Monoid m => Versioned m -> m
forall a. Versioned a -> Bool
forall a. Versioned a -> Int
forall a. Versioned a -> [a]
forall a. (a -> a -> a) -> Versioned a -> a
forall m a. Monoid m => (a -> m) -> Versioned a -> m
forall b a. (b -> a -> b) -> b -> Versioned a -> b
forall a b. (a -> b -> b) -> b -> Versioned a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Versioned a -> a
$cproduct :: forall a. Num a => Versioned a -> a
sum :: Versioned a -> a
$csum :: forall a. Num a => Versioned a -> a
minimum :: Versioned a -> a
$cminimum :: forall a. Ord a => Versioned a -> a
maximum :: Versioned a -> a
$cmaximum :: forall a. Ord a => Versioned a -> a
elem :: a -> Versioned a -> Bool
$celem :: forall a. Eq a => a -> Versioned a -> Bool
length :: Versioned a -> Int
$clength :: forall a. Versioned a -> Int
null :: Versioned a -> Bool
$cnull :: forall a. Versioned a -> Bool
toList :: Versioned a -> [a]
$ctoList :: forall a. Versioned a -> [a]
foldl1 :: (a -> a -> a) -> Versioned a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Versioned a -> a
foldr1 :: (a -> a -> a) -> Versioned a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Versioned a -> a
foldl' :: (b -> a -> b) -> b -> Versioned a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Versioned a -> b
foldl :: (b -> a -> b) -> b -> Versioned a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Versioned a -> b
foldr' :: (a -> b -> b) -> b -> Versioned a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Versioned a -> b
foldr :: (a -> b -> b) -> b -> Versioned a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Versioned a -> b
foldMap' :: (a -> m) -> Versioned a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Versioned a -> m
foldMap :: (a -> m) -> Versioned a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Versioned a -> m
fold :: Versioned m -> m
$cfold :: forall m. Monoid m => Versioned m -> m
Foldable,Functor Versioned
Foldable Versioned
Functor Versioned
-> Foldable Versioned
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Versioned a -> f (Versioned b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Versioned (f a) -> f (Versioned a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Versioned a -> m (Versioned b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Versioned (m a) -> m (Versioned a))
-> Traversable Versioned
(a -> f b) -> Versioned a -> f (Versioned b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Versioned (m a) -> m (Versioned a)
forall (f :: * -> *) a.
Applicative f =>
Versioned (f a) -> f (Versioned a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Versioned a -> m (Versioned b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Versioned a -> f (Versioned b)
sequence :: Versioned (m a) -> m (Versioned a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Versioned (m a) -> m (Versioned a)
mapM :: (a -> m b) -> Versioned a -> m (Versioned b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Versioned a -> m (Versioned b)
sequenceA :: Versioned (f a) -> f (Versioned a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Versioned (f a) -> f (Versioned a)
traverse :: (a -> f b) -> Versioned a -> f (Versioned b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Versioned a -> f (Versioned b)
$cp2Traversable :: Foldable Versioned
$cp1Traversable :: Functor Versioned
Traversable)

-- | Unpack versioned data type.
unversioned :: Versioned a -> a
unversioned :: Versioned a -> a
unversioned = Versioned a -> a
forall a. Versioned a -> a
content

instance ToJSON a => ToJSON (Versioned a) where
  toJSON :: Versioned a -> Value
toJSON     (Versioned Version
v a
x) = [Pair] -> Value
object [ Text
"version" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Version -> FilePath
showVersion Version
v, Text
"content" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
x]
  toEncoding :: Versioned a -> Encoding
toEncoding (Versioned Version
v a
x) = Series -> Encoding
pairs (Text
"version" Text -> FilePath -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Version -> FilePath
showVersion Version
v Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"content" Text -> a -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
x)


-- | Given a list of candidate parsers, select the right one
parseVersioned               :: [(Version -> Bool,Value -> Parser a)]
                             -> Value -> Parser (Versioned a)
parseVersioned :: [(Version -> Bool, Value -> Parser a)]
-> Value -> Parser (Versioned a)
parseVersioned [(Version -> Bool, Value -> Parser a)]
ps (Object Object
o) = do V Version
v <- Object
o Object -> Text -> Parser V
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"version"
                                  Value
co  <- Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"content"
                                  let ps' :: [Parser (Versioned a)]
ps' = ((Version -> Bool, Value -> Parser a) -> Parser (Versioned a))
-> [(Version -> Bool, Value -> Parser a)] -> [Parser (Versioned a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Version -> Bool
_,Value -> Parser a
p) -> Version -> a -> Versioned a
forall a. Version -> a -> Versioned a
Versioned Version
v (a -> Versioned a) -> Parser a -> Parser (Versioned a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
p Value
co)
                                          ([(Version -> Bool, Value -> Parser a)] -> [Parser (Versioned a)])
-> ([(Version -> Bool, Value -> Parser a)]
    -> [(Version -> Bool, Value -> Parser a)])
-> [(Version -> Bool, Value -> Parser a)]
-> [Parser (Versioned a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Version -> Bool, Value -> Parser a) -> Bool)
-> [(Version -> Bool, Value -> Parser a)]
-> [(Version -> Bool, Value -> Parser a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (((Version -> Bool) -> Version -> Bool
forall a b. (a -> b) -> a -> b
$ Version
v) ((Version -> Bool) -> Bool)
-> ((Version -> Bool, Value -> Parser a) -> Version -> Bool)
-> (Version -> Bool, Value -> Parser a)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> Bool, Value -> Parser a) -> Version -> Bool
forall a b. (a, b) -> a
fst) ([(Version -> Bool, Value -> Parser a)] -> [Parser (Versioned a)])
-> [(Version -> Bool, Value -> Parser a)] -> [Parser (Versioned a)]
forall a b. (a -> b) -> a -> b
$ [(Version -> Bool, Value -> Parser a)]
ps
                                      err :: Parser (Versioned a)
err = FilePath -> Parser (Versioned a)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Parser (Versioned a))
-> FilePath -> Parser (Versioned a)
forall a b. (a -> b) -> a -> b
$ FilePath
"no matching version found for version "
                                                   FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Version -> FilePath
showVersion Version
v
                                  (Parser (Versioned a)
 -> Parser (Versioned a) -> Parser (Versioned a))
-> Parser (Versioned a)
-> [Parser (Versioned a)]
-> Parser (Versioned a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Parser (Versioned a)
-> Parser (Versioned a) -> Parser (Versioned a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Parser (Versioned a)
err [Parser (Versioned a)]
ps'
parseVersioned [(Version -> Bool, Value -> Parser a)]
_ Value
invalid     = FilePath -> Value -> Parser (Versioned a)
forall a. FilePath -> Value -> Parser a
typeMismatch FilePath
"Versioned" Value
invalid

-- instance (FromJSON a) => FromJSON (Versioned a) where
--   parseJSON (Object v) = Versioned <$> (unV <$> v .: "version")
--                                    <*> v .: "content"
--   parseJSON invalid    = typeMismatch "Versioned" invalid

newtype V = V Version

instance FromJSON V where
  parseJSON :: Value -> Parser V
parseJSON (String Text
t) = case ((Version, FilePath) -> Bool)
-> [(Version, FilePath)] -> [(Version, FilePath)]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> Bool)
-> ((Version, FilePath) -> FilePath) -> (Version, FilePath) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version, FilePath) -> FilePath
forall a b. (a, b) -> b
snd) (ReadP Version -> ReadS Version
forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion ReadS Version -> ReadS Version
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
t) of
     ((Version
v,FilePath
""):[(Version, FilePath)]
_) -> V -> Parser V
forall (f :: * -> *) a. Applicative f => a -> f a
pure (V -> Parser V) -> V -> Parser V
forall a b. (a -> b) -> a -> b
$ Version -> V
V Version
v
     [(Version, FilePath)]
_          -> FilePath -> Parser V
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Parser V) -> FilePath -> Parser V
forall a b. (a -> b) -> a -> b
$ FilePath
"parsing " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a. Show a => a -> FilePath
show Text
t FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" into a version failed"
  parseJSON Value
invalid    = FilePath -> Value -> Parser V
forall a. FilePath -> Value -> Parser a
typeMismatch FilePath
"Version" Value
invalid