{-# LANGUAGE RecordWildCards #-}
-- | Building-block methods to build a command-line tool able to inspect and
-- turnup/turndown DevOps.
module Devops.Cli (
    Method (..), Concurrency (..)
  , applyMethod
  -- * Building main programs
  , simpleMain
  , SelfPath
  , ForestOptimization
  , App (..)
  , appMain
  , appMethod
  , methodArg
  -- * Utilities
  , getDependenciesOnly
  , graphize
  , opClosureFromB64
  , opClosureToB64
  ) where

import           Control.Distributed.Closure (Closure, unclosure)
import           Control.Monad.Identity      (runIdentity)
import qualified Data.Binary                 as Binary
import qualified Data.ByteString.Base64.Lazy as B64
import           Data.ByteString.Lazy        (ByteString)
import           Data.Tree                   (Forest)
import           Data.Typeable               (Typeable)
import           DepTrack                    (GraphData, buildGraph, evalDepForest1)
import           Prelude                     hiding (readFile)
import           System.Environment          (getArgs, getExecutablePath)

import           Devops.Actions              (checkStatuses, concurrentTurndown, concurrentTurnup, concurrentUpkeep, defaultDotify,
                                              display, dotifyWithStatuses, listUniqNodes, sequentialTurnDown, sequentialTurnup)
import           Devops.Base                 (DevOp, OpUniqueId, PreOp, preOpUniqueId, getDependenciesOnly)

--------------------------------------------------------------------

data Method =
    TurnUp Concurrency
  | TurnDown Concurrency
  | Upkeep
  | Print
  | Dot
  | CheckDot
  | List

data Concurrency = Concurrently | Sequentially

--------------------------------------------------------------------
applyMethod :: [(Forest PreOp -> Forest PreOp)]
            -> Forest PreOp
            -> Method
            -> IO ()
applyMethod transformations originalForest meth = do
  let forest = foldl (.) id transformations originalForest
  let graph = graphize forest

  case meth of
    TurnUp Concurrently   -> concurrentTurnup graph
    TurnUp Sequentially   -> sequentialTurnup graph
    TurnDown Concurrently -> concurrentTurndown graph
    TurnDown Sequentially -> sequentialTurnDown graph
    Upkeep                -> concurrentUpkeep graph
    Print                 -> display forest
    Dot                   -> putStrLn . defaultDotify $ graph
    CheckDot              -> putStrLn . dotifyWithStatuses graph =<< checkStatuses graph
    List                  -> listUniqNodes forest

--------------------------------------------------------------------

-- | Simple main function for a single operation.
--
-- You should use this 'simpleMain' for simple configuration binaries, more
-- involved architectures shoul almost need a 'App' or 'appMain'.
simpleMain :: DevOp env a
           -- ^ an operation
           -> [(Forest PreOp -> Forest PreOp)]
           -- ^ forest transformations to optimize the resulting graph
           -> [String]
           -- ^ args
           -> env
           -- ^ environment
           -> IO ()
simpleMain devop optimizations args env = go args
  where
    forest = getDependenciesOnly env devop
    call m = applyMethod optimizations forest m
    go ("up":_)        = call $ TurnUp Concurrently
    go ("up-seq":_)    = call $ TurnUp Sequentially
    go ("down":_)      = call $ TurnDown Concurrently
    go ("down-seq":_)  = call $ TurnDown Sequentially
    go ("upkeep":_)    = call Upkeep
    go ("print":_)     = call Print
    go ("dot":_)       = call Dot
    go ("check-dot":_) = call CheckDot
    go ("list":_)      = call List
    go _               = putStrLn usage
    usage = unlines [ "deptrack-devops default main:"
                    , "  Available arguments:"
                    , "    up, down, upkeep, print, dot, check-dot, list"
                    ]

--------------------------------------------------------------------

-- | A FilePath corresponding to the file with the currently-executing binary.
type SelfPath = FilePath

-- | An optimization on PreOp forests.
type ForestOptimization = Forest PreOp -> Forest PreOp

-- | A builder for app that can be useful for defining an infrastructure as a
-- recursive structure where the "main entry point" of the recursion is the
-- binary itself.
data App env node = App {
    _parseArgs :: [String] -> (node, Method)
  -- ^ Parses arguments, returns a parsed architecture and a set of args for
  -- the real defaulMain.
  , _revParse  :: node -> Method -> [String]
  -- ^ Reverse parse arguments, for instance when building a callback.
  , _target    :: node -> SelfPath -> (node -> Method -> [String]) -> DevOp env ()
  -- ^ Generates a target from the argument and the selfPath
  , _opts      :: [ForestOptimization]
  -- ^ Optimizations to run.
  , _retrieveEnv  :: node -> IO env
  -- ^ IO to retrieve the current environment.
  }

-- | DefaultMain for 'App'.
appMain :: App env a -> IO ()
appMain App{..} = do
    self <- getExecutablePath
    args <- getArgs
    let (node, meth) = _parseArgs args
    env  <- _retrieveEnv node
    let forest = getDependenciesOnly env $ _target node self _revParse
    applyMethod _opts forest meth

-- | Unsafely parse a 'Method' from what could be a command line argument.
--
-- (NB. unsafe means this function is partial, you should use this function in
-- conjunction with 'methodArg' for the reverse parse and you will be fine).
appMethod :: String -> Method
appMethod "up"        = TurnUp Concurrently
appMethod "up-seq"    = TurnUp Sequentially
appMethod "down"      = TurnDown Concurrently
appMethod "down-seq"  = TurnDown Sequentially
appMethod "upkeep"    = Upkeep
appMethod "print"     = Print
appMethod "dot"       = Dot
appMethod "check-dot" = CheckDot
appMethod "list"      = List
appMethod str         = error $ "unparsed appMethod: " ++ str

-- | Serializes a 'Method' to what should be a command-line argument later
-- parsed via 'appMethod'.
methodArg :: Method -> String
methodArg (TurnUp Concurrently)   = "up"
methodArg (TurnUp Sequentially)   = "up-seq"
methodArg (TurnDown Concurrently) = "down"
methodArg (TurnDown Sequentially) = "down-seq"
methodArg Upkeep                  = "upkeep"
methodArg Print                   = "print"
methodArg Dot                     = "dot"
methodArg CheckDot                = "check-dot"
methodArg List                    = "list"

--------------------------------------------------------------------

-- | Builds a Graph from dependencies represented as a Forest.
--
-- Nodes with a same hash in the Forest will correspond to the same node in the
-- graph, hence, it's possible to create cycles by mistake if two nodes have a
-- same hash by mistake (this is possible if the hash does not depend on all
-- arguments to a DevOp).
graphize :: Forest PreOp -> GraphData PreOp OpUniqueId
graphize forest = buildGraph preOpUniqueId forest

-- | Helper to deal with App when you want to use Closures as a
-- serialization/deserialization mechanism.
--
-- You will likely add 'opClosureFromB64' in the '_parseArgs' field of your
-- 'App' and 'opClosureToB64' in the '_revParse' field.
opClosureFromB64 :: (Typeable env, Typeable a) => ByteString -> Closure (DevOp env a)
opClosureFromB64 b64 = do
    let bstr = B64.decode b64
    let encodedClosure = either (error "invalid base64") id bstr
    Binary.decode encodedClosure

-- | Dual to 'opClosureFromB64'.
opClosureToB64 :: (Typeable env, Typeable a) => Closure (DevOp env a) -> ByteString
opClosureToB64 clo =
    B64.encode $ Binary.encode clo