module Buffet.Parse.ParseMetadata
  ( get
  ) where

import qualified Buffet.Ir.Ir as Ir
import qualified Buffet.Toolbox.TextTools as TextTools
import qualified Data.Csv as Csv
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Vector as Vector
import qualified Language.Docker as Docker
import Prelude
  ( Maybe(Just, Nothing)
  , ($)
  , (.)
  , concatMap
  , const
  , either
  , fmap
  , maybe
  , mconcat
  , mempty
  )

get :: Docker.Dockerfile -> Ir.Metadata
get :: Dockerfile -> Metadata
get Dockerfile
stage =
  Metadata :: Text -> Text -> Map TagKey [TagValue] -> Metadata
Ir.Metadata
    { title :: Text
Ir.title = Text -> Text -> Map Text Text -> Text
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Text
forall a. Monoid a => a
mempty Text
titleKey Map Text Text
labels
    , url :: Text
Ir.url = Text -> Text -> Map Text Text -> Text
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Text
forall a. Monoid a => a
mempty Text
urlKey Map Text Text
labels
    , tags :: Map TagKey [TagValue]
Ir.tags = Map Text Text -> Map TagKey [TagValue]
parseTags Map Text Text
tagLabels
    }
  where
    titleKey :: Text
titleKey = String -> Text
T.pack String
"org.opencontainers.image.title"
    labels :: Map Text Text
labels = Dockerfile -> Map Text Text
parseLabels Dockerfile
stage
    urlKey :: Text
urlKey = String -> Text
T.pack String
"org.opencontainers.image.url"
    tagLabels :: Map Text Text
tagLabels = Map Text Text -> Set Text -> Map Text Text
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys Map Text Text
labels (Set Text -> Map Text Text) -> Set Text -> Map Text Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [Text
titleKey, Text
urlKey]

parseLabels :: Docker.Dockerfile -> Map.Map T.Text T.Text
parseLabels :: Dockerfile -> Map Text Text
parseLabels = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> Map Text Text)
-> (Dockerfile -> [(Text, Text)]) -> Dockerfile -> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstructionPos Text -> [(Text, Text)])
-> Dockerfile -> [(Text, Text)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InstructionPos Text -> [(Text, Text)]
forall args. InstructionPos args -> [(Text, Text)]
labelBindings
  where
    labelBindings :: InstructionPos args -> [(Text, Text)]
labelBindings (Docker.InstructionPos (Docker.Label [(Text, Text)]
pairs) Text
_ Linenumber
_) = [(Text, Text)]
pairs
    labelBindings InstructionPos args
_ = []

parseTags :: Map.Map T.Text T.Text -> Map.Map Ir.TagKey [Ir.TagValue]
parseTags :: Map Text Text -> Map TagKey [TagValue]
parseTags = (Text -> [TagValue]) -> Map TagKey Text -> Map TagKey [TagValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [TagValue]
parseTagValues (Map TagKey Text -> Map TagKey [TagValue])
-> (Map Text Text -> Map TagKey Text)
-> Map Text Text
-> Map TagKey [TagValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> TagKey) -> Map Text Text -> Map TagKey Text
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Text -> TagKey
Ir.TagKey

parseTagValues :: T.Text -> [Ir.TagValue]
parseTagValues :: Text -> [TagValue]
parseTagValues Text
raw = (Text -> TagValue) -> [Text] -> [TagValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TagValue
Ir.TagValue ([Text] -> [TagValue])
-> (Maybe [[Text]] -> [Text]) -> Maybe [[Text]] -> [TagValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> ([[Text]] -> [Text]) -> Maybe [[Text]] -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text
raw] [[Text]] -> [Text]
forall a. Monoid a => [a] -> a
mconcat (Maybe [[Text]] -> [TagValue]) -> Maybe [[Text]] -> [TagValue]
forall a b. (a -> b) -> a -> b
$ Text -> Maybe [[Text]]
parseCsv Text
raw

parseCsv :: T.Text -> Maybe [[T.Text]]
parseCsv :: Text -> Maybe [[Text]]
parseCsv =
  (String -> Maybe [[Text]])
-> (Vector [Text] -> Maybe [[Text]])
-> Either String (Vector [Text])
-> Maybe [[Text]]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe [[Text]] -> String -> Maybe [[Text]]
forall a b. a -> b -> a
const Maybe [[Text]]
forall a. Maybe a
Nothing) ([[Text]] -> Maybe [[Text]]
forall a. a -> Maybe a
Just ([[Text]] -> Maybe [[Text]])
-> (Vector [Text] -> [[Text]]) -> Vector [Text] -> Maybe [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector [Text] -> [[Text]]
forall a. Vector a -> [a]
Vector.toList) (Either String (Vector [Text]) -> Maybe [[Text]])
-> (Text -> Either String (Vector [Text]))
-> Text
-> Maybe [[Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  HasHeader -> ByteString -> Either String (Vector [Text])
forall a.
FromRecord a =>
HasHeader -> ByteString -> Either String (Vector a)
Csv.decode HasHeader
Csv.NoHeader (ByteString -> Either String (Vector [Text]))
-> (Text -> ByteString) -> Text -> Either String (Vector [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TextTools.encodeUtf8