module Buffet.Assemble.ScheduleParallelInstructions
  ( get
  ) where

import qualified Buffet.Assemble.JoinConsecutiveRunInstructions as JoinConsecutiveRunInstructions
import qualified Buffet.Ir.Ir as Ir
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as T
import qualified Language.Docker as Docker
import Prelude
  ( Bool(False, True)
  , Maybe(Just, Nothing)
  , ($)
  , (.)
  , (/=)
  , (<>)
  , (==)
  , all
  , concatMap
  , dropWhile
  , filter
  , fmap
  , mconcat
  , minimum
  , null
  , span
  , splitAt
  , take
  , unzip
  )

type ScheduleStep
   = [Ir.DockerfilePart] -> (Ir.DockerfilePart, [Ir.DockerfilePart])

get :: [Ir.DockerfilePart] -> [Ir.DockerfilePart]
get :: [DockerfilePart] -> [DockerfilePart]
get = DockerfilePart -> [DockerfilePart]
forall a. [a] -> [[a]]
wrap (DockerfilePart -> [DockerfilePart])
-> ([DockerfilePart] -> DockerfilePart)
-> [DockerfilePart]
-> [DockerfilePart]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DockerfilePart -> [DockerfilePart] -> DockerfilePart
schedule []
  where
    wrap :: [a] -> [[a]]
wrap [] = []
    wrap [a]
timetable = [[a]
timetable]
    schedule :: DockerfilePart -> [DockerfilePart] -> DockerfilePart
schedule DockerfilePart
timetable [DockerfilePart]
queues =
      if (DockerfilePart -> Bool) -> [DockerfilePart] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all DockerfilePart -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DockerfilePart]
queues
        then DockerfilePart
timetable
        else DockerfilePart -> [DockerfilePart] -> DockerfilePart
schedule DockerfilePart
timetable' [DockerfilePart]
queues'
      where
        timetable' :: DockerfilePart
timetable' = DockerfilePart
timetable DockerfilePart -> DockerfilePart -> DockerfilePart
forall a. Semigroup a => a -> a -> a
<> DockerfilePart
step
        (DockerfilePart
step, [DockerfilePart]
queues') = ScheduleStep
scheduleStep [DockerfilePart]
queues

scheduleStep :: ScheduleStep
scheduleStep :: ScheduleStep
scheduleStep [DockerfilePart]
queues =
  case ((DockerfilePart, [DockerfilePart]) -> Bool)
-> [(DockerfilePart, [DockerfilePart])]
-> [(DockerfilePart, [DockerfilePart])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(DockerfilePart
_, [DockerfilePart]
queues') -> [DockerfilePart]
queues' [DockerfilePart] -> [DockerfilePart] -> Bool
forall a. Eq a => a -> a -> Bool
/= [DockerfilePart]
queues) [(DockerfilePart, [DockerfilePart])]
results of
    [] -> ([], [DockerfilePart]
queues)
    (DockerfilePart, [DockerfilePart])
result:[(DockerfilePart, [DockerfilePart])]
_ -> (DockerfilePart, [DockerfilePart])
result
  where
    results :: [(DockerfilePart, [DockerfilePart])]
results = (ScheduleStep -> (DockerfilePart, [DockerfilePart]))
-> [ScheduleStep] -> [(DockerfilePart, [DockerfilePart])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScheduleStep -> ScheduleStep
forall a b. (a -> b) -> a -> b
$ [DockerfilePart]
queues) [ScheduleStep]
strategies
    strategies :: [ScheduleStep]
strategies =
      [ ScheduleStep
scheduleFromInstructions
      , ScheduleStep
scheduleArgInstructions
      , ScheduleStep
scheduleShellInstructions
      , ScheduleStep
scheduleCopyInstructions
      , ScheduleStep
scheduleRunInstructions
      , ScheduleStep
scheduleWorkdirInstructions
      , ScheduleStep
scheduleCommentInstructions
      , ScheduleStep
scheduleNextInstructionEach
      ]

scheduleFromInstructions :: ScheduleStep
scheduleFromInstructions :: ScheduleStep
scheduleFromInstructions = (Instruction Text -> Bool) -> ScheduleStep
unifyInstructions Instruction Text -> Bool
forall args. Instruction args -> Bool
isFrom
  where
    isFrom :: Instruction args -> Bool
isFrom (Docker.From BaseImage
_) = Bool
True
    isFrom Instruction args
_ = Bool
False

unifyInstructions :: (Docker.Instruction T.Text -> Bool) -> ScheduleStep
unifyInstructions :: (Instruction Text -> Bool) -> ScheduleStep
unifyInstructions Instruction Text -> Bool
isRelevant [DockerfilePart]
queues =
  case Maybe (Instruction Text)
minimumInstruction of
    Maybe (Instruction Text)
Nothing -> ([], [DockerfilePart]
queues)
    Just Instruction Text
instruction ->
      ([Instruction Text
instruction], (DockerfilePart -> DockerfilePart)
-> [DockerfilePart] -> [DockerfilePart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Instruction Text -> Bool) -> DockerfilePart -> DockerfilePart
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Instruction Text -> Instruction Text -> Bool
forall a. Eq a => a -> a -> Bool
== Instruction Text
instruction)) [DockerfilePart]
queues)
  where
    minimumInstruction :: Maybe (Instruction Text)
minimumInstruction =
      (NonEmpty (Instruction Text) -> Instruction Text)
-> Maybe (NonEmpty (Instruction Text)) -> Maybe (Instruction Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (Instruction Text) -> Instruction Text
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (Maybe (NonEmpty (Instruction Text)) -> Maybe (Instruction Text))
-> (DockerfilePart -> Maybe (NonEmpty (Instruction Text)))
-> DockerfilePart
-> Maybe (Instruction Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DockerfilePart -> Maybe (NonEmpty (Instruction Text))
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty (DockerfilePart -> Maybe (Instruction Text))
-> DockerfilePart -> Maybe (Instruction Text)
forall a b. (a -> b) -> a -> b
$ DockerfilePart
nextInstructionsIfRelevant
    nextInstructionsIfRelevant :: DockerfilePart
nextInstructionsIfRelevant = (DockerfilePart -> DockerfilePart)
-> [DockerfilePart] -> DockerfilePart
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Instruction Text -> Bool) -> DockerfilePart -> DockerfilePart
forall a. (a -> Bool) -> [a] -> [a]
filter Instruction Text -> Bool
isRelevant (DockerfilePart -> DockerfilePart)
-> (DockerfilePart -> DockerfilePart)
-> DockerfilePart
-> DockerfilePart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> DockerfilePart -> DockerfilePart
forall a. Int -> [a] -> [a]
take Int
1) [DockerfilePart]
queues

scheduleArgInstructions :: ScheduleStep
scheduleArgInstructions :: ScheduleStep
scheduleArgInstructions = (Instruction Text -> Bool) -> ScheduleStep
unifyInstructions Instruction Text -> Bool
forall args. Instruction args -> Bool
isArg
  where
    isArg :: Instruction args -> Bool
isArg (Docker.Arg Text
_ Maybe Text
_) = Bool
True
    isArg Instruction args
_ = Bool
False

scheduleShellInstructions :: ScheduleStep
scheduleShellInstructions :: ScheduleStep
scheduleShellInstructions = (Instruction Text -> Bool) -> ScheduleStep
unifyInstructions Instruction Text -> Bool
forall args. Instruction args -> Bool
isShell
  where
    isShell :: Instruction args -> Bool
isShell (Docker.Shell Arguments args
_) = Bool
True
    isShell Instruction args
_ = Bool
False

scheduleCopyInstructions :: ScheduleStep
scheduleCopyInstructions :: ScheduleStep
scheduleCopyInstructions = (Instruction Text -> Bool) -> ScheduleStep
spanInstructions Instruction Text -> Bool
forall args. Instruction args -> Bool
isCopy
  where
    isCopy :: Instruction args -> Bool
isCopy (Docker.Copy CopyArgs
_) = Bool
True
    isCopy Instruction args
_ = Bool
False

spanInstructions :: (Docker.Instruction T.Text -> Bool) -> ScheduleStep
spanInstructions :: (Instruction Text -> Bool) -> ScheduleStep
spanInstructions Instruction Text -> Bool
isRelevant [DockerfilePart]
queues = ([DockerfilePart] -> DockerfilePart
forall a. Monoid a => [a] -> a
mconcat [DockerfilePart]
spans, [DockerfilePart]
queues')
  where
    ([DockerfilePart]
spans, [DockerfilePart]
queues') = [(DockerfilePart, DockerfilePart)]
-> ([DockerfilePart], [DockerfilePart])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(DockerfilePart, DockerfilePart)]
 -> ([DockerfilePart], [DockerfilePart]))
-> [(DockerfilePart, DockerfilePart)]
-> ([DockerfilePart], [DockerfilePart])
forall a b. (a -> b) -> a -> b
$ (DockerfilePart -> (DockerfilePart, DockerfilePart))
-> [DockerfilePart] -> [(DockerfilePart, DockerfilePart)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Instruction Text -> Bool)
-> DockerfilePart -> (DockerfilePart, DockerfilePart)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Instruction Text -> Bool
isRelevant) [DockerfilePart]
queues

scheduleRunInstructions :: ScheduleStep
scheduleRunInstructions :: ScheduleStep
scheduleRunInstructions [DockerfilePart]
queues =
  (DockerfilePart -> DockerfilePart
JoinConsecutiveRunInstructions.get DockerfilePart
runs, [DockerfilePart]
queues')
  where
    (DockerfilePart
runs, [DockerfilePart]
queues') = (Instruction Text -> Bool) -> ScheduleStep
spanInstructions Instruction Text -> Bool
forall args. Instruction args -> Bool
isRun [DockerfilePart]
queues
    isRun :: Instruction args -> Bool
isRun (Docker.Run RunArgs args
_) = Bool
True
    isRun Instruction args
_ = Bool
False

scheduleWorkdirInstructions :: ScheduleStep
scheduleWorkdirInstructions :: ScheduleStep
scheduleWorkdirInstructions = (Instruction Text -> Bool) -> ScheduleStep
unifyInstructions Instruction Text -> Bool
forall args. Instruction args -> Bool
isWorkdir
  where
    isWorkdir :: Instruction args -> Bool
isWorkdir (Docker.Workdir Text
_) = Bool
True
    isWorkdir Instruction args
_ = Bool
False

scheduleCommentInstructions :: ScheduleStep
scheduleCommentInstructions :: ScheduleStep
scheduleCommentInstructions = (Instruction Text -> Bool) -> ScheduleStep
unifyInstructions Instruction Text -> Bool
forall args. Instruction args -> Bool
isComment
  where
    isComment :: Instruction args -> Bool
isComment (Docker.Comment Text
_) = Bool
True
    isComment Instruction args
_ = Bool
False

scheduleNextInstructionEach :: ScheduleStep
scheduleNextInstructionEach :: ScheduleStep
scheduleNextInstructionEach [DockerfilePart]
queues = ([DockerfilePart] -> DockerfilePart
forall a. Monoid a => [a] -> a
mconcat [DockerfilePart]
nexts, [DockerfilePart]
queues')
  where
    ([DockerfilePart]
nexts, [DockerfilePart]
queues') = [(DockerfilePart, DockerfilePart)]
-> ([DockerfilePart], [DockerfilePart])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(DockerfilePart, DockerfilePart)]
 -> ([DockerfilePart], [DockerfilePart]))
-> [(DockerfilePart, DockerfilePart)]
-> ([DockerfilePart], [DockerfilePart])
forall a b. (a -> b) -> a -> b
$ (DockerfilePart -> (DockerfilePart, DockerfilePart))
-> [DockerfilePart] -> [(DockerfilePart, DockerfilePart)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> DockerfilePart -> (DockerfilePart, DockerfilePart)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1) [DockerfilePart]
queues