module Main where

import           Bespoke                        ( assignBespokeModules )
import           Bespoke.MarshalParams
import           Data.Text.Extra                ( (<+>) )
import           Data.Version
import           Documentation.All
import           Error
import           Khronos.AssignModules
import           Khronos.Render
import           Marshal
import           Polysemy
import           Polysemy.Fixpoint
import           Polysemy.Input
import           Polysemy.State
import           Relude                  hiding ( Handle
                                                , State
                                                , Type
                                                , evalState
                                                , uncons
                                                )
import           Render.Aggregate
import           Render.Element.Write
import           Render.Names
import           Render.SpecInfo
import           Render.State                   ( initialRenderState )
import           Say
import           Spec.Parse
import           System.TimeIt
import           XR.Bracket
import           XR.RenderParams

main :: IO ()
main =
  (runFinal . embedToFinal @IO . fixpointToFinal @IO . runErr $ go) >>= \case
    Left es -> do
      traverse_ sayErr es
      sayErr (show (length es) <+> "errors")
      exitFailure
    Right () -> pure ()
 where
  go :: Sem '[Err , Fixpoint , Embed IO , Final IO] ()
  go = do
    specText <- timeItNamed "Reading spec"
      $ readFileBS "./OpenXR-Docs/specification/registry/xr.xml"

    (spec@Spec {..}, getSize) <- timeItNamed "Parsing spec"
      $ parseSpec @SpecXr specText

    let allExtensionNames =
          toList (exName <$> specExtensions)
            <> [ "XR_VERSION_" <> show major <> "_" <> show minor
               | Feature {..}      <- toList specFeatures
               , major : minor : _ <- pure $ versionBranch fVersion
               ]
        doLoadDocs = True
    getDocumentation <- if doLoadDocs
      then liftIO $ loadAllDocumentation SpecXr
                                         allExtensionNames
                                         "./OpenXR-Docs/specification"
                                         "./OpenXR-Docs/specification/man"
      else pure (const Nothing)

    runInputConst (renderParams specHandles)
      . withRenderedNames spec
      . withSpecInfo spec getSize
      . withTypeInfo spec
      $ do

          mps          <- marshalParams spec

          (ss, us, cs) <- runInputConst mps $ do
            ss <- timeItNamed "Marshaling structs"
              $ traverseV marshalStruct specStructs
            us <- timeItNamed "Marshaling unions"
              $ traverseV marshalStruct specUnions
            cs <- timeItNamed "Marshaling commands"
              $ traverseV marshalCommand specCommands
              -- TODO: Don't use all commands here, just those commands referenced by
              -- features and extensions. Similarly for specs
            pure (ss, us, cs)

          renderElements <-
            timeItNamed "Rendering" $ traverse evaluateWHNF =<< evalStateIO
              initialRenderState
              (renderSpec spec getDocumentation brackets ss us cs)

          groups <-
            timeItNamed "Segmenting"
            $   assignModules spec
            =<< assignBespokeModules renderElements

          timeItNamed "writing"
            $   renderSegments getDocumentation "out-xr"
            =<< mergeElements groups

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

evalStateIO :: Member (Embed IO) r => s -> Sem (State s ': r) a -> Sem r a
evalStateIO i = fmap snd . stateToIO i

