module Stack.Types.Image where
import Data.Aeson.Extended
import qualified Data.Map as Map
import Generics.Deriving.Monoid (mappenddefault, memptydefault)
import Path
import Stack.Prelude
newtype ImageOpts = ImageOpts
{ imgDockers :: [ImageDockerOpts]
} deriving (Show)
data ImageDockerOpts = ImageDockerOpts
{ imgDockerBase :: !(Maybe String)
, imgDockerEntrypoints :: !(Maybe [String])
, imgDockerAdd :: !(Map FilePath (Path Abs Dir))
, imgDockerImageName :: !(Maybe String)
, imgDockerExecutables :: !(Maybe [Path Rel File])
} deriving (Show)
newtype ImageOptsMonoid = ImageOptsMonoid
{ imgMonoidDockers :: [ImageDockerOpts]
} deriving (Show, Generic)
instance FromJSON (WithJSONWarnings ImageOptsMonoid) where
parseJSON = withObjectWarnings
"ImageOptsMonoid"
(\o ->
do (oldDocker :: Maybe ImageDockerOpts) <- jsonSubWarningsT (o ..:? imgDockerOldArgName)
(dockers :: [ImageDockerOpts]) <- jsonSubWarningsT (o ..:? imgDockersArgName ..!= [])
let imgMonoidDockers = dockers ++ maybeToList oldDocker
return
ImageOptsMonoid
{ ..
})
instance Monoid ImageOptsMonoid where
mempty = memptydefault
mappend = mappenddefault
instance FromJSON (WithJSONWarnings ImageDockerOpts) where
parseJSON = withObjectWarnings
"ImageDockerOpts"
(\o ->
do imgDockerBase <- o ..:? imgDockerBaseArgName
imgDockerEntrypoints <- o ..:? imgDockerEntrypointsArgName
imgDockerAdd <- o ..:? imgDockerAddArgName ..!= Map.empty
imgDockerImageName <- o ..:? imgDockerImageNameArgName
imgDockerExecutables <- o ..:? imgDockerExecutablesArgName
return
ImageDockerOpts
{ ..
})
imgArgName :: Text
imgArgName = "image"
imgDockerOldArgName :: Text
imgDockerOldArgName = "container"
imgDockersArgName :: Text
imgDockersArgName = "containers"
imgDockerBaseArgName :: Text
imgDockerBaseArgName = "base"
imgDockerAddArgName :: Text
imgDockerAddArgName = "add"
imgDockerEntrypointsArgName :: Text
imgDockerEntrypointsArgName = "entrypoints"
imgDockerImageNameArgName :: Text
imgDockerImageNameArgName = "name"
imgDockerExecutablesArgName :: Text
imgDockerExecutablesArgName = "executables"