{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}

module Language.Docker.Predef where

import Control.Monad
import Control.Monad.Free.Class
import Control.Monad.IO.Class
import Data.Aeson (Value(..))
import qualified Data.HashMap.Strict as HashMap
import Data.List.NonEmpty (fromList)
import Data.Maybe
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Yaml as Yaml
import System.Directory
import System.FilePath
import qualified System.FilePath.Glob as Glob

import Language.Docker
import Language.Docker.EDSL.Types

appendLnIfMissing :: FilePath -> Text -> IO ()
appendLnIfMissing fp cts = do
    e <- doesFileExist fp
    unless e (Text.writeFile fp "")
    txt <- Text.lines <$> Text.readFile fp
    unless (cts `elem` txt) $ Text.writeFile fp (Text.unlines (txt <> [cts]))

dockerIgnore :: Text -> IO ()
dockerIgnore = appendLnIfMissing ".dockerignore"

addGlob :: (MonadIO m, MonadFree EInstruction m) => String -> TargetPath -> m ()
addGlob pattern dest = do
    fs <-
        liftIO $ do
            fs <- Glob.glob pattern
            cwd <- getCurrentDirectory
            let fs' = map (makeRelative cwd . normalise) fs
            forM fs' $ \f -> do
                isdir <- doesDirectoryExist f
                return $
                    if isdir
                        then (SourcePath $ f <> "/")
                        else (SourcePath f)
    case fs of
      [] -> return ()
      _ -> add (fromList fs) dest

copyGlob :: (MonadIO m, MonadFree EInstruction m) => String -> TargetPath -> m ()
copyGlob = addGlob

stackBuild :: (Monad m, MonadIO m, MonadFree EInstruction m) => m ()
stackBuild = do
    sts <- liftIO getStackYamlResolver
    stackBuild' sts (return ())
  where
    getStackYamlResolver = do
        mhm <- Yaml.decodeFile "./stack.yaml" :: IO (Maybe Value)
        return $
            fromMaybe "latest" $ do
                hm <- mhm
                o <-
                    case hm of
                        Object o -> return o
                        _ -> Nothing
                rs <- HashMap.lookup "resolver" o
                toString rs
      where
        toString (String m) = Just (Text.unpack m)
        toString _ = Nothing

stackBuild' :: (Monad m, MonadIO m, MonadFree EInstruction m) => String -> m () -> m ()
stackBuild' tag extra = do
    liftIO $ dockerIgnore ".stack-work"
    liftIO $ dockerIgnore ".cabal-sandbox"
    from ("fpco" `tagged` tag)
    extra
    add ["./package.yaml"] "/app/package.yaml"
    addGlob "./*.cabal" "/app/"
    add ["./stack.yaml"] "/app/stack.yaml"
    workdir "/app/"
    run "stack build --only-dependencies"
    add ["."] "/app/stack.yaml"
    run "stack build"

nodejs :: (Monad m, MonadIO m, MonadFree EInstruction m) => m ()
nodejs = nodejs' "6" (return ())

nodejs' :: (Monad m, MonadIO m, MonadFree EInstruction m) => String -> m () -> m ()
nodejs' tag extra = do
    liftIO $ dockerIgnore "node_modules"
    liftIO $ dockerIgnore "bower_components"
    from ("node" `tagged` tag)
    extra
    add ["./package.json"] "/app/package.json"
    workdir "/app/"
    run "npm install"
    add ["."] "/app/"
    cmd "npm start"