From 007c5e9127ccce4dba09018623a018c13f7c72b0 Mon Sep 17 00:00:00 2001
From: Justus Adam <dev@justus.science>
Date: Wed, 10 Oct 2018 18:17:08 +0200
Subject: [PATCH] [ohua-dev/ohuac#12] Starting with some basic machinery

---
 src/Ohua/Stage.hs | 11 +++++++++++
 src/Ohua/Types.hs | 21 +++++++++++++++------
 2 files changed, 26 insertions(+), 6 deletions(-)
 create mode 100644 src/Ohua/Stage.hs

diff --git a/src/Ohua/Stage.hs b/src/Ohua/Stage.hs
new file mode 100644
index 0000000..a73d3b9
--- /dev/null
+++ b/src/Ohua/Stage.hs
@@ -0,0 +1,11 @@
+module Ohua.Stage (stage) where
+
+import Ohua.Prelude
+
+stage :: (MonadReadEnvironment m, MonadIO m, Show code, Pretty code) => StageName -> code -> m ()
+stage stName code = do
+  stageH <- fromEnv stageHandling
+  let (dumpInstructions, shouldAbort) = stageH stName
+
+
+  when shouldAbort exitSuccess
diff --git a/src/Ohua/Types.hs b/src/Ohua/Types.hs
index a49b71a..f1be9b6 100644
--- a/src/Ohua/Types.hs
+++ b/src/Ohua/Types.hs
@@ -46,9 +46,6 @@ module Ohua.Types
     , NameGenerator
     , simpleNameList
     , takenNames
-    , callEnvExpr
-    , callLocalFunction
-    , transformRecursiveFunctions
     , options
     , Annotated(Annotated)
     , TyExprF(..)
@@ -358,11 +355,20 @@ type instance SourceType (OhuaState envExpr) =
 instance Make (OhuaState envExpr) where
     make (ng, fnid, exprs) = pure $ OhuaState ng fnid exprs
 
+type StageName = Text
+type AbortCompilation = Bool
+data DumpCode
+    = Don'tDump
+    | DumpShow
+    | DumpPretty
+    | DumpOther Text
+type StageHandling = StageName -> (AbortCompilation, DumpCode)
+
 -- | The read only compiler environment
-newtype Environment = Environment Options
+newtype Environment = Environment Options StageHandling
 
 instance Default Environment where
-    def = Environment def
+    def = Environment def (const (Don'tDump, True))
 
 nameGenerator :: Lens' (OhuaState envExpr) NameGenerator
 nameGenerator f (OhuaState gen counter envExprs) =
@@ -404,7 +410,10 @@ transformRecursiveFunctions :: Lens' Options Bool
 transformRecursiveFunctions f (Options c l e) = f e <&> Options c l
 
 options :: Lens' Environment Options
-options f (Environment opts) = Environment <$> f opts
+options f (Environment opts s) = (\a -> Environment a s) <$> f opts
+
+stageHandling :: Lens' Environment Options
+stageHandling f (Environment opts s) = Environment opts <$> f s
 
 -- | Generic way of attaching arbitrary, alterable data to some type.
 --