module GI.Code
    ( Code(..)
    , BaseCodeGen
    , CodeGen
    , ExcCodeGen
    , CGError(..)
    , genCode
    , evalCodeGen
    , codeToString
    , loadDependency
    , getDeps
    , recurse
    , recurse'
    , handleCGExc
    , describeCGError
    , notImplementedError
    , badIntroError
    , missingInfoError
    , indent
    , line
    , blank
    , group
    , foreignImport

    , findAPI
    , findAPIByName
    , getAPIs
    , injectAPIs

    , config
    ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad.RWS
import Control.Monad.Except
import Data.Sequence (Seq, ViewL ((:<)), (><), (|>), (<|))
import qualified Data.Map as M
import qualified Data.Sequence as S
import qualified Data.Set as Set

import GI.API (API, Name(..))
import GI.Config (Config(..))
import GI.Type (Type(..))

data Code
    = NoCode
    | Line String
    | Indent Code
    | Sequence (Seq Code)
    | ForeignImport Code
    | Group Code
    deriving (Eq, Show)

instance Monoid Code where
    mempty = NoCode

    NoCode `mappend` NoCode = NoCode
    x `mappend` NoCode = x
    NoCode `mappend` x = x
    (Sequence a) `mappend` (Sequence b) = Sequence (a >< b)
    (Sequence a) `mappend` b = Sequence (a |> b)
    a `mappend` (Sequence b) = Sequence (a <| b)
    a `mappend` b = Sequence (a <| b <| S.empty)

type Deps = Set.Set String
data CodeGenState = CodeGenState {
      moduleDeps :: Deps,
      loadedAPIs :: M.Map Name API }

data CGError = CGErrorNotImplemented String
             | CGErrorBadIntrospectionInfo String
             | CGErrorMissingInfo String
               deriving (Show)

type BaseCodeGen excType a =
    RWST Config Code CodeGenState (ExceptT excType IO) a

-- | The code generator monad, for generators that cannot throw
-- errors. The fact that they cannot throw errors is encoded in the
-- forall, which disallows any operation on the error, except
-- discarding it or passing it along without inspecting. This last
-- operation is useful in order to allow embedding `CodeGen`
-- computations inside `ExcCodeGen` computations, while disallowing
-- the opposite embedding without explicit error handling.
type CodeGen a = forall e. BaseCodeGen e a

-- | Code generators that can throw errors.
type ExcCodeGen a = BaseCodeGen CGError a

-- | Due to the `forall` in the definition of `CodeGen`, if we want to
-- run the monad transformer stack until we get an `IO` action, our
-- only option is ignoring the possible error code from
-- `runExceptT`. This is perfectly safe, since there is no way to
-- construct a computation in the `CodeGen` monad that throws an
-- exception, due to the higher rank type.
unwrapCodeGen :: Config -> CodeGenState -> CodeGen a ->
                 IO (a, CodeGenState, Code)
unwrapCodeGen cfg state cg =
    runExceptT (runRWST cg cfg state) >>= \case
        Left _ -> error "unwrapCodeGen:: The impossible happened!"
        Right (r, s, c) -> return (r, s, c)

-- | Run the given code generator, merging its resulting state into
-- the ambient state, and turning its output into a value.
recurse :: BaseCodeGen e a -> BaseCodeGen e (a, Code)
recurse cg = do
    r <- ask
    oldState <- get
    liftIO (runExceptT $ runRWST cg r oldState) >>= \case
        Left e -> throwError e
        Right (r, st, c) -> put (mergeState oldState st) >> return (r, c)

-- | Try running the given `action`, and if it fails run `fallback`
-- instead.
handleCGExc :: (CGError -> CodeGen a) -> ExcCodeGen a -> CodeGen a
handleCGExc fallback action = do
    r <- ask
    oldState <- get
    liftIO (runExceptT $ runRWST action r oldState) >>= \case
        Left e -> fallback e
        Right (r, s, c) -> do
            put $ mergeState oldState s
            tell c
            return r

emptyState :: CodeGenState
emptyState = CodeGenState {moduleDeps = Set.empty
                          ,loadedAPIs = M.empty }

getDeps :: CodeGen Deps
getDeps = moduleDeps <$> get

getAPIs :: CodeGen (M.Map Name API)
getAPIs = loadedAPIs <$> get

-- | Inject the given APIs into loaded set.
injectAPIs :: [(Name, API)] -> CodeGen()
injectAPIs newAPIs = do
  oldState <- get
  put $ oldState {loadedAPIs =
                      M.union (loadedAPIs oldState) (M.fromList newAPIs)}

-- | Merge two states of a code generator.
mergeState :: CodeGenState -> CodeGenState -> CodeGenState
mergeState oldState newState =
    -- If no dependencies were added we do not need to merge.
    if Set.size (moduleDeps oldState) /= Set.size (moduleDeps newState)
    then let newDeps = Set.union (moduleDeps oldState) (moduleDeps newState)
             newAPIs = M.union (loadedAPIs oldState) (loadedAPIs newState)
         in CodeGenState {moduleDeps = newDeps, loadedAPIs = newAPIs}
    else oldState

-- | Run a code generator, and return the dependencies encountered
-- when generating code.
genCode :: Config -> M.Map Name API -> CodeGen () -> IO (Deps, Code)
genCode cfg apis cg = do
    (_, st, code) <- unwrapCodeGen cfg (emptyState {loadedAPIs = apis}) cg
    return (moduleDeps st, code)

-- | Like `genCode`, but keep the final value and output, discarding
-- the state.
evalCodeGen :: Config -> M.Map Name API -> CodeGen a -> IO (a, Code)
evalCodeGen cfg apis cg = do
  (r, _, code) <- unwrapCodeGen cfg (emptyState {loadedAPIs = apis}) cg
  return (r, code)

-- | Like `recurse`, but for generators returning a unit value, where
-- we can just drop the result.
recurse' :: CodeGen () -> CodeGen Code
recurse' cg = snd <$> recurse cg

-- | Mark the given dependency as used by the module.
loadDependency :: String -> CodeGen ()
loadDependency name = do
    deps <- getDeps
    unless (Set.member name deps) $ do
        let newDeps = Set.insert name deps
        modify' $ \s -> s {moduleDeps = newDeps}

-- | Give a friendly textual description of the error for presenting
-- to the user.
describeCGError :: CGError -> String
describeCGError (CGErrorNotImplemented e) = "Not implemented: " ++ show e
describeCGError (CGErrorBadIntrospectionInfo e) = "Bad introspection data: " ++ show e
describeCGError (CGErrorMissingInfo e) = "Missing info: " ++ show e

notImplementedError :: String -> ExcCodeGen a
notImplementedError s = throwError $ CGErrorNotImplemented s

badIntroError :: String -> ExcCodeGen a
badIntroError s = throwError $ CGErrorBadIntrospectionInfo s

missingInfoError :: String -> ExcCodeGen a
missingInfoError s = throwError $ CGErrorMissingInfo s

findAPI :: Type -> CodeGen (Maybe API)
findAPI TError = Just <$> findAPIByName (Name "GLib" "Error")
findAPI (TInterface ns n) = Just <$> findAPIByName (Name ns n)
findAPI _ = return Nothing

findAPIByName :: Name -> CodeGen API
findAPIByName n@(Name ns _) = do
    apis <- getAPIs
    case M.lookup n apis of
        Just api -> return api
        Nothing ->
            error $ "couldn't find API description for " ++ ns ++ "." ++ name n

config :: CodeGen Config
config = ask

line :: String -> CodeGen ()
line = tell . Line

blank :: CodeGen ()
blank = line ""

indent :: BaseCodeGen e a -> BaseCodeGen e a
indent cg = do
  (x, code) <- recurse cg
  tell $ Indent code
  return x

group :: BaseCodeGen e a -> BaseCodeGen e a
group cg = do
  (x, code) <- recurse cg
  tell $ Group code
  blank
  return x

foreignImport :: BaseCodeGen e a -> BaseCodeGen e a
foreignImport cg = do
  (a, c) <- recurse cg
  tell $ ForeignImport c
  return a

codeToString c = unlines $ str 0 c []
    where str _ NoCode cont = cont
          str n (Line s) cont = (replicate (n * 4) ' ' ++ s) : cont
          str n (Indent c) cont = str (n + 1) c cont
          str n (ForeignImport c) cont = str n c cont
          str n (Sequence s) cont = deseq n (S.viewl s) cont
          -- str n (Sequence s) cont = F.foldr (\code rest -> str n code : rest) cont s
          str n (Group c) cont = str n c cont

          deseq _ S.EmptyL cont = cont
          deseq n (c :< cs) cont = str n c (deseq n (S.viewl cs) cont)