{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.YAML
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
-- Description :  Helper functions for working with yaml
--
--------------------------------------------------------------------------------
module HGeometry.YAML
  ( encodeYAML, encodeYAMLFile
  , decodeYAML, decodeYAMLFile
  , printYAML
  , Versioned(Versioned), unversioned
  ) where

import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as Char8
import qualified Data.Text as Text
import           Data.Version
import           Data.YAML
import           GHC.Generics (Generic)
import qualified System.File.OsPath as File
import           System.OsPath
import           Text.ParserCombinators.ReadP (readP_to_S)

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

-- | Write the output to yaml
encodeYAML :: ToYAML a => a -> ByteString
encodeYAML :: forall a. ToYAML a => a -> ByteString
encodeYAML = a -> ByteString
forall a. ToYAML a => a -> ByteString
encode1Strict

-- | Prints the yaml
printYAML :: ToYAML a => a -> IO ()
printYAML :: forall a. ToYAML a => a -> IO ()
printYAML = ByteString -> IO ()
Char8.putStrLn (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToYAML a => a -> ByteString
encodeYAML

-- | alias for decodeEither' from the YAML Package
decodeYAML :: FromYAML a => ByteString -> Either (Pos, String) a
decodeYAML :: forall a. FromYAML a => ByteString -> Either (Pos, [Char]) a
decodeYAML = ByteString -> Either (Pos, [Char]) a
forall a. FromYAML a => ByteString -> Either (Pos, [Char]) a
decode1Strict

-- | alias for reading a yaml file
decodeYAMLFile :: FromYAML a => OsPath -> IO (Either (Pos, String) a)
decodeYAMLFile :: forall a. FromYAML a => OsPath -> IO (Either (Pos, [Char]) a)
decodeYAMLFile = (ByteString -> Either (Pos, [Char]) a)
-> IO ByteString -> IO (Either (Pos, [Char]) a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Either (Pos, [Char]) a
forall a. FromYAML a => ByteString -> Either (Pos, [Char]) a
decodeYAML (IO ByteString -> IO (Either (Pos, [Char]) a))
-> (OsPath -> IO ByteString)
-> OsPath
-> IO (Either (Pos, [Char]) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO ByteString
File.readFile'

-- | Encode a yaml file
encodeYAMLFile    :: ToYAML a => OsPath -> a -> IO ()
encodeYAMLFile :: forall a. ToYAML a => OsPath -> a -> IO ()
encodeYAMLFile OsPath
fp = OsPath -> ByteString -> IO ()
File.writeFile' OsPath
fp (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToYAML a => a -> ByteString
encodeYAML

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

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

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

instance ToYAML a => ToYAML (Versioned a) where
  toYAML :: Versioned a -> Node ()
toYAML (Versioned Version
v a
x) = [Pair] -> Node ()
mapping [ Text
"version" Text -> Text -> Pair
forall a. ToYAML a => Text -> a -> Pair
.= [Char] -> Text
Text.pack (Version -> [Char]
showVersion Version
v)
                                   , Text
"content" Text -> a -> Pair
forall a. ToYAML a => Text -> a -> Pair
.= a
x
                                   ]

instance FromYAML a => FromYAML (Versioned a) where
  parseYAML :: Node Pos -> Parser (Versioned a)
parseYAML = [Char]
-> (Mapping Pos -> Parser (Versioned a))
-> Node Pos
-> Parser (Versioned a)
forall a.
[Char] -> (Mapping Pos -> Parser a) -> Node Pos -> Parser a
withMap [Char]
"Versioned" ((Mapping Pos -> Parser (Versioned a))
 -> Node Pos -> Parser (Versioned a))
-> (Mapping Pos -> Parser (Versioned a))
-> Node Pos
-> Parser (Versioned a)
forall a b. (a -> b) -> a -> b
$ \Mapping Pos
m -> Version -> a -> Versioned a
forall a. Version -> a -> Versioned a
Versioned (Version -> a -> Versioned a)
-> Parser Version -> Parser (a -> Versioned a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (V -> Version
unV (V -> Version) -> Parser V -> Parser Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mapping Pos
m Mapping Pos -> Text -> Parser V
forall a. FromYAML a => Mapping Pos -> Text -> Parser a
.: Text
"version")
                                                    Parser (a -> Versioned a) -> Parser a -> Parser (Versioned a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mapping Pos
m Mapping Pos -> Text -> Parser a
forall a. FromYAML a => Mapping Pos -> Text -> Parser a
.: Text
"content"


-- -- | Given a list of candidate parsers, select the right one
-- 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 { V -> Version
unV :: Version }

parseVersion'   :: Text.Text -> Parser V
parseVersion' :: Text -> Parser V
parseVersion' Text
t = case ((Version, [Char]) -> Bool)
-> [(Version, [Char])] -> [(Version, [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Char] -> Bool)
-> ((Version, [Char]) -> [Char]) -> (Version, [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version, [Char]) -> [Char]
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 -> [Char]
Text.unpack Text
t) of
                    ((Version
v,[Char]
""):[(Version, [Char])]
_) -> V -> Parser V
forall a. a -> Parser a
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, [Char])]
_          -> [Char] -> Parser V
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser V) -> [Char] -> Parser V
forall a b. (a -> b) -> a -> b
$ [Char]
"parsing " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
t [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" into a version failed"

instance FromYAML V where
  parseYAML :: Node Pos -> Parser V
parseYAML = [Char] -> (Text -> Parser V) -> Node Pos -> Parser V
forall a. [Char] -> (Text -> Parser a) -> Node Pos -> Parser a
withStr [Char]
"version" Text -> Parser V
parseVersion'


-- instance FromYAML V where
--   parseYAML (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"
--   parseYAML invalid    = typeMismatch "Version" invalid