{-# LANGUAGE OverloadedStrings #-}

-- | Helper functions for working with Docker images
module Docker.API.Client.Images
  ( updateImageName,
    updateImageDigest,
    updateImageTag,
    tagImageIfMissing,
  )
where

import Data.Maybe
import qualified Data.Text as T

-- | (name, tag, digest)
type ImageParts = (T.Text, Maybe T.Text, Maybe T.Text)

-- | Split an image name into its individual components
parseImage :: T.Text -> ImageParts
parseImage :: Text -> ImageParts
parseImage Text
img =
  let -- (image:..., @digest)
      (Text
nameTag, Text
digest) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
"@" Text
img
      (Text
name, Text
tag) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
":" Text
nameTag
      -- Need to remove the prefix symbol if it exists
      formatOptional :: Text -> Maybe Text
formatOptional Text
part = if Text -> Bool
T.null Text
part then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text
Text -> Text
T.tail Text
part
   in (Text
name, Text -> Maybe Text
formatOptional Text
tag, Text -> Maybe Text
formatOptional Text
digest)

-- | Adds a character to the head of a text, returns an empty text otherwise
maybeWithSymbol :: T.Text -> (Maybe T.Text -> T.Text)
maybeWithSymbol :: Text -> Maybe Text -> Text
maybeWithSymbol Text
symbol = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text
symbol Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

partsToImage :: ImageParts -> T.Text
partsToImage :: ImageParts -> Text
partsToImage (Text
name, Maybe Text
tag, Maybe Text
digest) =
  Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
maybeWithSymbol Text
":" Maybe Text
tag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
maybeWithSymbol Text
"@" Maybe Text
digest

-- | Adds a `latest` tag to a Docker image if it does not already have
-- a tag or digest specified, otherwise it returns the input image.
tagImageIfMissing :: T.Text -> T.Text
tagImageIfMissing :: Text -> Text
tagImageIfMissing Text
img =
  let (Text
name, Maybe Text
tag, Maybe Text
digest) = Text -> ImageParts
parseImage Text
img
   in if Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
tag Bool -> Bool -> Bool
&& Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
digest
        then ImageParts -> Text
partsToImage (Text
name, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"latest", Maybe Text
digest)
        else Text
img

-- | Update the name of a docker image, keeping all other fields.
-- For example, you can convert `python:latest` to `perl:latest`.
updateImageName :: T.Text -> T.Text -> T.Text
updateImageName :: Text -> Text -> Text
updateImageName Text
img Text
name =
  let (Text
_, Maybe Text
tag, Maybe Text
digest) = Text -> ImageParts
parseImage Text
img
   in ImageParts -> Text
partsToImage (Text
name, Maybe Text
tag, Maybe Text
digest)

-- | Update the tag of a docker image, keeping all other fields.
-- For example, you can convert `python:latest` to `python:3.7`.
-- Pass a `Nothing` to remove the tag field.
updateImageTag :: T.Text -> Maybe T.Text -> T.Text
updateImageTag :: Text -> Maybe Text -> Text
updateImageTag Text
img Maybe Text
tag =
  let (Text
name, Maybe Text
_, Maybe Text
digest) = Text -> ImageParts
parseImage Text
img
   in ImageParts -> Text
partsToImage (Text
name, Maybe Text
tag, Maybe Text
digest)

-- | Update the tag of a docker image, keeping all other fields.
-- For example, you can convert `python:3.7\@sha256:11111` to `python:3.7\@sha256:22222`.
-- Pass a `Nothing` to remove the digest field.
updateImageDigest :: T.Text -> Maybe T.Text -> T.Text
updateImageDigest :: Text -> Maybe Text -> Text
updateImageDigest Text
img Maybe Text
digest =
  let (Text
name, Maybe Text
tag, Maybe Text
_) = Text -> ImageParts
parseImage Text
img
   in ImageParts -> Text
partsToImage (Text
name, Maybe Text
tag, Maybe Text
digest)