{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-

Parses the x-arion field in the generated compose file.

-}
module Arion.ExtendedInfo where

import Prelude()
import Protolude
import Data.Aeson as Aeson
import Arion.Aeson
import Control.Lens
import Data.Aeson.Lens

data Image = Image
  { Image -> Maybe Text
image :: Maybe Text -- ^ image tar.gz file path
  , Image -> Maybe Text
imageExe :: Maybe Text -- ^ path to exe producing image tar
  , Image -> Text
imageName :: Text
  , Image -> Text
imageTag :: Text
  } deriving (Image -> Image -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: Image -> Image -> Bool
Eq, Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Show, forall x. Rep Image x -> Image
forall x. Image -> Rep Image x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Image x -> Image
$cfrom :: forall x. Image -> Rep Image x
Generic, [Image] -> Encoding
[Image] -> Value
Image -> Encoding
Image -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Image] -> Encoding
$ctoEncodingList :: [Image] -> Encoding
toJSONList :: [Image] -> Value
$ctoJSONList :: [Image] -> Value
toEncoding :: Image -> Encoding
$ctoEncoding :: Image -> Encoding
toJSON :: Image -> Value
$ctoJSON :: Image -> Value
Aeson.ToJSON, Value -> Parser [Image]
Value -> Parser Image
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Image]
$cparseJSONList :: Value -> Parser [Image]
parseJSON :: Value -> Parser Image
$cparseJSON :: Value -> Parser Image
Aeson.FromJSON)

data ExtendedInfo = ExtendedInfo {
    ExtendedInfo -> Maybe Text
projectName :: Maybe Text,
    ExtendedInfo -> [Image]
images :: [Image]
  } deriving (ExtendedInfo -> ExtendedInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtendedInfo -> ExtendedInfo -> Bool
$c/= :: ExtendedInfo -> ExtendedInfo -> Bool
== :: ExtendedInfo -> ExtendedInfo -> Bool
$c== :: ExtendedInfo -> ExtendedInfo -> Bool
Eq, Int -> ExtendedInfo -> ShowS
[ExtendedInfo] -> ShowS
ExtendedInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtendedInfo] -> ShowS
$cshowList :: [ExtendedInfo] -> ShowS
show :: ExtendedInfo -> String
$cshow :: ExtendedInfo -> String
showsPrec :: Int -> ExtendedInfo -> ShowS
$cshowsPrec :: Int -> ExtendedInfo -> ShowS
Show)

loadExtendedInfoFromPath :: FilePath -> IO ExtendedInfo
loadExtendedInfoFromPath :: String -> IO ExtendedInfo
loadExtendedInfoFromPath String
fp = do
  Value
v <- forall a. FromJSON a => String -> IO a
decodeFile String
fp
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ExtendedInfo {
    -- TODO: use aeson derived instance?
    projectName :: Maybe Text
projectName = Value
v forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"x-arion" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
"project" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
"name" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String,
    images :: [Image]
images = (Value
v :: Aeson.Value) forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. forall t. AsValue t => Key -> Traversal' t Value
key Key
"x-arion" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
"images" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t (Vector Value)
_Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
_JSON
  }