module Stack.Types.Image where
import Data.Aeson.Extended
import Data.Monoid
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (maybeToList)
import Data.Text (Text)
import GHC.Generics (Generic)
import Generics.Deriving.Monoid (mappenddefault, memptydefault)
import Path
import 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"