module Language.Dockerfile.EDSL
where
import Control.Monad.Free
import Control.Monad.Free.TH
import Control.Monad.Identity (Identity)
import Control.Monad.Trans.Free (FreeT, iterTM, runFreeT)
import Control.Monad.Writer
import Data.ByteString (ByteString)
import qualified Language.Dockerfile.PrettyPrint as PrettyPrint
import qualified Language.Dockerfile.Syntax as Syntax
import Language.Dockerfile.EDSL.Types
type EInstructionM = Free EInstruction
type EInstructionTM = FreeT EInstruction
makeFree ''EInstruction
runDockerWriter
:: (MonadWriter [Syntax.Instruction] m)
=> EInstructionM a -> m a
runDockerWriter = iterM runD
runDockerWriterIO ::
( Monad m
, MonadTrans t
, Monad (t m)
, MonadWriter [Syntax.Instruction] (t m)
, MonadIO (t m)
) => EInstructionTM m a -> t m a
runDockerWriterIO = iterTM runD
runDef :: MonadWriter [t] m => (t1 -> t) -> t1 -> m b -> m b
runDef f a n = tell [ f a ] >> n
runDef2 :: MonadWriter [t] m => (t1 -> t2 -> t) -> t1 -> t2 -> m b -> m b
runDef2 f a b n = tell [ f a b ] >> n
runD :: MonadWriter [Syntax.Instruction] m => EInstruction (m b) -> m b
runD (From bi n) = case bi of
EUntaggedImage bi' -> runDef Syntax.From (Syntax.UntaggedImage bi') n
ETaggedImage bi' tg -> runDef Syntax.From (Syntax.TaggedImage bi' tg) n
EDigestedImage bi' d -> runDef Syntax.From (Syntax.DigestedImage bi' d) n
runD (CmdArgs as n) = runDef Syntax.Cmd as n
runD (Add s d n) = runDef2 Syntax.Add s d n
runD (User u n) = runDef Syntax.User u n
runD (Label ps n) = runDef Syntax.Label ps n
runD (StopSignal s n) = runDef Syntax.Stopsignal s n
runD (Copy s d n) = runDef2 Syntax.Copy s d n
runD (RunArgs as n) = runDef Syntax.Run as n
runD (Workdir d n) = runDef Syntax.Workdir d n
runD (Expose ps n) = runDef Syntax.Expose ps n
runD (Volume v n) = runDef Syntax.Volume v n
runD (EntrypointArgs e n) = runDef Syntax.Entrypoint e n
runD (Maintainer m n) = runDef Syntax.Maintainer m n
runD (Env ps n) = runDef Syntax.Env ps n
runD (Arg s n) = runDef Syntax.Arg s n
runD (Comment c n) = runDef Syntax.Comment c n
runD (OnBuildRaw i n) = runDef Syntax.OnBuild i n
runD (Embed is n) = do
tell (map Syntax.instruction is)
n
instructionPos :: Syntax.Instruction -> Syntax.InstructionPos
instructionPos i = Syntax.InstructionPos i "" 0
toDockerfile :: EInstructionM a -> Syntax.Dockerfile
toDockerfile e =
let (_, w) = runWriter (runDockerWriter e)
in map instructionPos w
toDockerfileStr :: EInstructionM a -> String
toDockerfileStr = PrettyPrint.prettyPrint . toDockerfile
untagged :: String -> EBaseImage
untagged = EUntaggedImage
tagged :: String -> String -> EBaseImage
tagged = ETaggedImage
digested :: String -> ByteString -> EBaseImage
digested = EDigestedImage
run :: MonadFree EInstruction m => String -> m ()
run = runArgs . words
entrypoint :: MonadFree EInstruction m => String -> m ()
entrypoint = entrypointArgs . words
cmd :: MonadFree EInstruction m => String -> m ()
cmd = cmdArgs . words
onBuild
:: MonadFree EInstruction m
=> EInstructionM a
-> m ()
onBuild b = mapM_ (onBuildRaw . Syntax.instruction) (toDockerfile b)
toDockerfileIO :: MonadIO m => EInstructionTM m t -> m Syntax.Dockerfile
toDockerfileIO e = liftM snd (runDockerfileIO e)
toDockerfileStrIO :: MonadIO m => EInstructionTM m t -> m String
toDockerfileStrIO e = liftM snd (runDockerfileStrIO e)
runDockerfileIO :: MonadIO m => EInstructionTM m t -> m (t, Syntax.Dockerfile)
runDockerfileIO e = do
(r, w) <- runWriterT (runDockerWriterIO e)
return (r, map instructionPos w)
runDockerfileStrIO :: MonadIO m => EInstructionTM m t -> m (t, String)
runDockerfileStrIO e = do
(r, w) <- runDockerfileIO e
return (r, PrettyPrint.prettyPrint w)