{-# 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
(Image -> Image -> Bool) -> (Image -> Image -> Bool) -> Eq Image
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
(Int -> Image -> ShowS)
-> (Image -> String) -> ([Image] -> ShowS) -> Show Image
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. Image -> Rep Image x)
-> (forall x. Rep Image x -> Image) -> Generic Image
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
(Image -> Value)
-> (Image -> Encoding)
-> ([Image] -> Value)
-> ([Image] -> Encoding)
-> ToJSON Image
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
(Value -> Parser Image)
-> (Value -> Parser [Image]) -> FromJSON 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
(ExtendedInfo -> ExtendedInfo -> Bool)
-> (ExtendedInfo -> ExtendedInfo -> Bool) -> Eq ExtendedInfo
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
(Int -> ExtendedInfo -> ShowS)
-> (ExtendedInfo -> String)
-> ([ExtendedInfo] -> ShowS)
-> Show ExtendedInfo
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 <- String -> IO Value
forall a. FromJSON a => String -> IO a
decodeFile String
fp
  ExtendedInfo -> IO ExtendedInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExtendedInfo :: Maybe Text -> [Image] -> ExtendedInfo
ExtendedInfo {
    -- TODO: use aeson derived instance?
    projectName :: Maybe Text
projectName = Value
v Value -> Getting (First Text) Value Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"x-arion" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"project" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"name" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String,
    images :: [Image]
images = (Value
v :: Aeson.Value) Value -> Getting (Endo [Image]) Value Image -> [Image]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"x-arion" ((Value -> Const (Endo [Image]) Value)
 -> Value -> Const (Endo [Image]) Value)
-> Getting (Endo [Image]) Value Image
-> Getting (Endo [Image]) Value Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"images" ((Value -> Const (Endo [Image]) Value)
 -> Value -> Const (Endo [Image]) Value)
-> Getting (Endo [Image]) Value Image
-> Getting (Endo [Image]) Value Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (Endo [Image]) (Vector Value))
-> Value -> Const (Endo [Image]) Value
forall t. AsValue t => Prism' t (Vector Value)
_Array ((Vector Value -> Const (Endo [Image]) (Vector Value))
 -> Value -> Const (Endo [Image]) Value)
-> ((Image -> Const (Endo [Image]) Image)
    -> Vector Value -> Const (Endo [Image]) (Vector Value))
-> Getting (Endo [Image]) Value Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [Image]) Value)
-> Vector Value -> Const (Endo [Image]) (Vector Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Value -> Const (Endo [Image]) Value)
 -> Vector Value -> Const (Endo [Image]) (Vector Value))
-> Getting (Endo [Image]) Value Image
-> (Image -> Const (Endo [Image]) Image)
-> Vector Value
-> Const (Endo [Image]) (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Image]) Value Image
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
_JSON
  }