module Pipeline.Compile where

import Control.Concurrent (forkIO)
import qualified Control.Concurrent.Chan as Chan
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Lazy.IO as LazyTextIO
import qualified Elm.Compiler as Compiler
import qualified Elm.Compiler.Module as Module
import qualified Elm.Docs as Docs

import qualified BuildManager as BM
import qualified Path
import qualified Report
import qualified Utils.File as File
import qualified TheMasterPlan as TMP
import TheMasterPlan
    ( CanonicalModule(..), Location, Package
    , BuildGraph(BuildGraph), BuildData(..)
    )



-- ENVIRONMENT and STATE


data Env =
  Env
    { numTasks :: Int
    , resultChan :: Chan.Chan Result
    , reportChan :: Chan.Chan Report.Message
    , doneChan :: Chan.Chan (Interfaces, [Docs.Documentation])
    , dependencies :: Map.Map CanonicalModule [CanonicalModule]
    , reverseDependencies :: Map.Map CanonicalModule [CanonicalModule]
    , cachePath :: FilePath
    , exposedModules :: Set.Set CanonicalModule
    , modulesForGeneration :: Set.Set CanonicalModule
    }


data State =
  State
    { numActiveThreads :: Int
    , blockedModules :: Map.Map CanonicalModule BuildData
    , completedInterfaces :: Interfaces
    , documentation :: [Docs.Documentation]
    }


type Interfaces =
  Map.Map CanonicalModule Module.Interface



-- HELPERS for ENV and STATE


initEnv
    :: FilePath
    -> Set.Set CanonicalModule
    -> [CanonicalModule]
    -> Map.Map CanonicalModule [CanonicalModule]
    -> BuildGraph
    -> IO Env
initEnv cachePath exposedModules modulesForGeneration dependencies (BuildGraph blocked _completed) =
  do  resultChan <- Chan.newChan
      reportChan <- Chan.newChan
      doneChan <- Chan.newChan
      return $ Env
        { numTasks = Map.size blocked
        , resultChan = resultChan
        , reportChan = reportChan
        , doneChan = doneChan
        , dependencies = dependencies
        , reverseDependencies = reverseGraph dependencies
        , cachePath = cachePath
        , exposedModules = exposedModules
        , modulesForGeneration = Set.fromList modulesForGeneration
        }


-- reverse dependencies, "who depends on me?"
reverseGraph :: (Ord a) => Map.Map a [a] -> Map.Map a [a]
reverseGraph graph =
    Map.foldrWithKey flipEdges Map.empty graph
  where
    flipEdges name dependencies reversedGraph =
        foldr (insertDependency name) reversedGraph dependencies

    insertDependency name dep reversedGraph =
        Map.insertWith (++) dep [name] reversedGraph


initState :: Env -> BuildGraph -> IO State
initState env (BuildGraph blocked completed) =
  let
    categorize name buildData@(BuildData blocking location) =
      case blocking of
        [] ->
          Left (name, location)

        _  ->
          Right buildData

    (readyModules, blockedModules) =
      Map.mapEitherWithKey categorize blocked

    readyList =
      Map.elems readyModules
  in
    do  mapM (forkIO . buildModule env completed) readyList
        return $
          State
            { numActiveThreads = length readyList
            , blockedModules = blockedModules
            , completedInterfaces = completed
            , documentation = []
            }



-- PARALLEL BUILDS!!!


build
    :: BM.Config
    -> Package
    -> Set.Set CanonicalModule
    -> [CanonicalModule]
    -> Map.Map CanonicalModule [CanonicalModule]
    -> BuildGraph
    -> IO (Interfaces, [Docs.Documentation])
build config rootPkg exposedModules modulesForGeneration dependencies summary =
  do  env <- initEnv (BM._artifactDirectory config) exposedModules modulesForGeneration dependencies summary
      forkIO (buildManager env =<< initState env summary)
      Report.thread (BM._reportType config) (BM._warn config) (reportChan env) rootPkg (numTasks env)
      Chan.readChan (doneChan env)


buildManager :: Env -> State -> IO ()
buildManager env state =
  if numActiveThreads state == 0 then

    do  Chan.writeChan (reportChan env) Report.Close
        Chan.writeChan (doneChan env) (completedInterfaces state, documentation state)

  else

    do  (Result source path modul localizer warnings result) <-
          Chan.readChan (resultChan env)

        case result of
          Right (Compiler.Result maybeDocs interface js) ->
            do  -- Write build artifacts to disk
                let cache = cachePath env
                File.writeBinary (Path.toInterface cache modul) interface
                LazyTextIO.writeFile (Path.toObjectFile cache modul) js

                -- Report results to user
                Chan.writeChan (reportChan env) (Report.Complete modul localizer path source warnings)

                -- Loop
                newState <- registerSuccess env state modul interface maybeDocs
                buildManager env newState

          Left errors ->
            do  -- Report results to user
                Chan.writeChan (reportChan env) (Report.Error modul localizer path source warnings errors)

                -- Loop
                buildManager env (state { numActiveThreads = numActiveThreads state - 1 })



  WAIT - REGISTER RESULTS


registerSuccess
    :: Env
    -> State
    -> CanonicalModule
    -> Module.Interface
    -> Maybe Docs.Documentation
    -> IO State
registerSuccess env state name interface maybeDocs =
  let
    (updatedBlockedModules, readyModules) =
      List.mapAccumR
        (updateBlockedModules name)
        (blockedModules state)
        (Maybe.fromMaybe [] (Map.lookup name (reverseDependencies env)))

    readyList =
      Maybe.catMaybes readyModules

    newCompletedInterfaces =
      Map.insert name interface (completedInterfaces state)
  in
    do  mapM (forkIO . buildModule env newCompletedInterfaces) readyList

        return $
          state
            { numActiveThreads = numActiveThreads state - 1 + length readyList
            , blockedModules = updatedBlockedModules
            , completedInterfaces = newCompletedInterfaces
            , documentation = maybe id (:) maybeDocs (documentation state)
            }


updateBlockedModules
    :: CanonicalModule
    -> Map.Map CanonicalModule BuildData
    -> CanonicalModule
    -> (Map.Map CanonicalModule BuildData, Maybe (CanonicalModule, Location))
updateBlockedModules modul blockedModules potentiallyFreedModule =
  case Map.lookup potentiallyFreedModule blockedModules of
    Nothing ->
        (blockedModules, Nothing)

    Just (BuildData blocking location) ->
        case filter (/= modul) blocking of
          [] ->
              ( Map.delete potentiallyFreedModule blockedModules
              , Just (potentiallyFreedModule, location)
              )

          newBlocking ->
              ( Map.insert
                  potentiallyFreedModule
                  (BuildData newBlocking location)
                  blockedModules
              , Nothing
              )



-- UPDATE - BUILD SOME MODULES


buildModule :: Env -> Interfaces -> (CanonicalModule, Location) -> IO ()
buildModule env interfaces (modul, location) =
  let
    packageName = fst (TMP.package modul)
    path = Path.toSource location
    ifaces = Map.mapKeys TMP.simplifyModuleName interfaces
    isExposed = Set.member modul (exposedModules env)

    deps =
        map TMP.simplifyModuleName ((Map.!) (dependencies env) modul)

    context =
        Compiler.Context packageName isExposed deps
  in
  do  source <- Text.readFile path

      let (localizer, warnings, rawResult) =
            Compiler.compile context source ifaces

      let result =
            Result source path modul localizer warnings rawResult

      Chan.writeChan (resultChan env) result


data Result =
  Result
    { _source :: Text.Text
    , _path :: FilePath
    , _moduleID :: CanonicalModule
    , _localizer :: Compiler.Localizer
    , _warnings :: [Compiler.Warning]
    , _result :: Either [Compiler.Error] Compiler.Result
    }

 ENVIRONMENT and STATE
 HELPERS for ENV and STATE
 reverse dependencies, "who depends on me?"
 PARALLEL BUILDS!!!
 Write build artifacts to disk
 Report results to user
 Loop
 Report results to user
 Loop
 UPDATE - BUILD SOME MODULES
module Pipeline.Compile where

import Control.Concurrent (forkIO)
import qualified Control.Concurrent.Chan as Chan
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Lazy.IO as LazyTextIO
import qualified Elm.Compiler as Compiler
import qualified Elm.Compiler.Module as Module
import qualified Elm.Docs as Docs

import qualified BuildManager as BM
import qualified Path
import qualified Report
import qualified Utils.File as File
import qualified TheMasterPlan as TMP
import TheMasterPlan
    ( CanonicalModule(..), Location, Package
    , BuildGraph(BuildGraph), BuildData(..)
    )





data Env =
  Env
    { numTasks :: Int
    , resultChan :: Chan.Chan Result
    , reportChan :: Chan.Chan Report.Message
    , doneChan :: Chan.Chan (Interfaces, [Docs.Documentation])
    , dependencies :: Map.Map CanonicalModule [CanonicalModule]
    , reverseDependencies :: Map.Map CanonicalModule [CanonicalModule]
    , cachePath :: FilePath
    , exposedModules :: Set.Set CanonicalModule
    , modulesForGeneration :: Set.Set CanonicalModule
    }


data State =
  State
    { numActiveThreads :: Int
    , blockedModules :: Map.Map CanonicalModule BuildData
    , completedInterfaces :: Interfaces
    , documentation :: [Docs.Documentation]
    }


type Interfaces =
  Map.Map CanonicalModule Module.Interface





initEnv
    :: FilePath
    -> Set.Set CanonicalModule
    -> [CanonicalModule]
    -> Map.Map CanonicalModule [CanonicalModule]
    -> BuildGraph
    -> IO Env
initEnv cachePath exposedModules modulesForGeneration dependencies (BuildGraph blocked _completed) =
  do  resultChan <- Chan.newChan
      reportChan <- Chan.newChan
      doneChan <- Chan.newChan
      return $ Env
        { numTasks = Map.size blocked
        , resultChan = resultChan
        , reportChan = reportChan
        , doneChan = doneChan
        , dependencies = dependencies
        , reverseDependencies = reverseGraph dependencies
        , cachePath = cachePath
        , exposedModules = exposedModules
        , modulesForGeneration = Set.fromList modulesForGeneration
        }


reverseGraph :: (Ord a) => Map.Map a [a] -> Map.Map a [a]
reverseGraph graph =
    Map.foldrWithKey flipEdges Map.empty graph
  where
    flipEdges name dependencies reversedGraph =
        foldr (insertDependency name) reversedGraph dependencies

    insertDependency name dep reversedGraph =
        Map.insertWith (++) dep [name] reversedGraph


initState :: Env -> BuildGraph -> IO State
initState env (BuildGraph blocked completed) =
  let
    categorize name buildData@(BuildData blocking location) =
      case blocking of
        [] ->
          Left (name, location)

        _  ->
          Right buildData

    (readyModules, blockedModules) =
      Map.mapEitherWithKey categorize blocked

    readyList =
      Map.elems readyModules
  in
    do  mapM (forkIO . buildModule env completed) readyList
        return $
          State
            { numActiveThreads = length readyList
            , blockedModules = blockedModules
            , completedInterfaces = completed
            , documentation = []
            }





build
    :: BM.Config
    -> Package
    -> Set.Set CanonicalModule
    -> [CanonicalModule]
    -> Map.Map CanonicalModule [CanonicalModule]
    -> BuildGraph
    -> IO (Interfaces, [Docs.Documentation])
build config rootPkg exposedModules modulesForGeneration dependencies summary =
  do  env <- initEnv (BM._artifactDirectory config) exposedModules modulesForGeneration dependencies summary
      forkIO (buildManager env =<< initState env summary)
      Report.thread (BM._reportType config) (BM._warn config) (reportChan env) rootPkg (numTasks env)
      Chan.readChan (doneChan env)


buildManager :: Env -> State -> IO ()
buildManager env state =
  if numActiveThreads state == 0 then

    do  Chan.writeChan (reportChan env) Report.Close
        Chan.writeChan (doneChan env) (completedInterfaces state, documentation state)

  else

    do  (Result source path modul localizer warnings result) <-
          Chan.readChan (resultChan env)

        case result of
          Right (Compiler.Result maybeDocs interface js) ->
                let cache = cachePath env
                File.writeBinary (Path.toInterface cache modul) interface
                LazyTextIO.writeFile (Path.toObjectFile cache modul) js

                Chan.writeChan (reportChan env) (Report.Complete modul localizer path source warnings)

                newState <- registerSuccess env state modul interface maybeDocs
                buildManager env newState

          Left errors ->
                Chan.writeChan (reportChan env) (Report.Error modul localizer path source warnings errors)

                buildManager env (state { numActiveThreads = numActiveThreads state - 1 })



  WAIT - REGISTER RESULTS


registerSuccess
    :: Env
    -> State
    -> CanonicalModule
    -> Module.Interface
    -> Maybe Docs.Documentation
    -> IO State
registerSuccess env state name interface maybeDocs =
  let
    (updatedBlockedModules, readyModules) =
      List.mapAccumR
        (updateBlockedModules name)
        (blockedModules state)
        (Maybe.fromMaybe [] (Map.lookup name (reverseDependencies env)))

    readyList =
      Maybe.catMaybes readyModules

    newCompletedInterfaces =
      Map.insert name interface (completedInterfaces state)
  in
    do  mapM (forkIO . buildModule env newCompletedInterfaces) readyList

        return $
          state
            { numActiveThreads = numActiveThreads state - 1 + length readyList
            , blockedModules = updatedBlockedModules
            , completedInterfaces = newCompletedInterfaces
            , documentation = maybe id (:) maybeDocs (documentation state)
            }


updateBlockedModules
    :: CanonicalModule
    -> Map.Map CanonicalModule BuildData
    -> CanonicalModule
    -> (Map.Map CanonicalModule BuildData, Maybe (CanonicalModule, Location))
updateBlockedModules modul blockedModules potentiallyFreedModule =
  case Map.lookup potentiallyFreedModule blockedModules of
    Nothing ->
        (blockedModules, Nothing)

    Just (BuildData blocking location) ->
        case filter (/= modul) blocking of
          [] ->
              ( Map.delete potentiallyFreedModule blockedModules
              , Just (potentiallyFreedModule, location)
              )

          newBlocking ->
              ( Map.insert
                  potentiallyFreedModule
                  (BuildData newBlocking location)
                  blockedModules
              , Nothing
              )





buildModule :: Env -> Interfaces -> (CanonicalModule, Location) -> IO ()
buildModule env interfaces (modul, location) =
  let
    packageName = fst (TMP.package modul)
    path = Path.toSource location
    ifaces = Map.mapKeys TMP.simplifyModuleName interfaces
    isExposed = Set.member modul (exposedModules env)

    deps =
        map TMP.simplifyModuleName ((Map.!) (dependencies env) modul)

    context =
        Compiler.Context packageName isExposed deps
  in
  do  source <- Text.readFile path

      let (localizer, warnings, rawResult) =
            Compiler.compile context source ifaces

      let result =
            Result source path modul localizer warnings rawResult

      Chan.writeChan (resultChan env) result


data Result =
  Result
    { _source :: Text.Text
    , _path :: FilePath
    , _moduleID :: CanonicalModule
    , _localizer :: Compiler.Localizer
    , _warnings :: [Compiler.Warning]
    , _result :: Either [Compiler.Error] Compiler.Result
    }
