Add backend support and start implementing a C backend.o

1 files changed, 81 insertions, 0 deletions

diff --git a/src/Language/Fiddle/Compiler/Backend.hs b/src/Language/Fiddle/Compiler/Backend.hs
new file mode 100644
index 0000000..ddb32c6
--- /dev/null
+++ b/src/Language/Fiddle/Compiler/Backend.hs
@@ -0,0 +1,81 @@
+module Language.Fiddle.Compiler.Backend where
+
+import Control.Monad (forM_)
+import Control.Monad.Identity (Identity)
+import Control.Monad.Writer
+import Data.Map (Map)
+import qualified Data.Text.IO
+import qualified Data.Map as Map
+import Data.Text (Text)
+import Language.Fiddle.Ast
+import Language.Fiddle.Types (Commented, SourceSpan)
+import Options.Applicative
+
+-- | Data representing the result of transpilation.
+data TranspileResult where
+  TranspileResult ::
+    { newFileContents :: Map FilePath Text
+    } ->
+    TranspileResult
+
+instance Semigroup TranspileResult where
+  (<>) (TranspileResult c1) (TranspileResult c2) =
+    TranspileResult $ Map.unionWith (<>) c1 c2
+
+instance Monoid TranspileResult where
+  mempty = TranspileResult mempty
+
+-- | "Opens" a file in the broader context of a TransplieResult, and writes the
+-- resulting bytestring to it
+withFile ::
+  (MonadWriter TranspileResult m) => FilePath -> Writer Text () -> m ()
+withFile path bsWriter =
+  tell (TranspileResult $ Map.singleton path $ execWriter bsWriter)
+
+-- | A backend for the FiddleCompiler. Takes a Checked FiddleUnit and emits
+-- generated code for that fiddle unit.
+data Backend where
+  Backend ::
+    forall privateFlags privateState.
+    { backendName :: String,
+      backendOptionsParser :: Parser privateFlags,
+      backendIOMakeState :: privateFlags -> IO privateState,
+      backendTranspile ::
+        privateFlags ->
+        privateState ->
+        FiddleUnit Checked Identity (Commented SourceSpan) ->
+        TranspileResult
+    } ->
+    Backend
+
+backendToParserFunction ::
+  Backend ->
+  Parser
+    ( FiddleUnit Checked Identity (Commented SourceSpan) -> IO TranspileResult
+    )
+backendToParserFunction
+  Backend
+    { backendOptionsParser = optionsParser,
+      backendIOMakeState = ioMakeState,
+      backendTranspile = transpile
+    } =
+    ( \opts ->
+        let ioState = ioMakeState opts
+         in \fiddleUnit -> do
+              state <- ioState
+              return $ transpile opts state fiddleUnit
+    )
+      <$> optionsParser
+
+processTranspileResult :: TranspileResult -> IO ()
+processTranspileResult (TranspileResult mp) =
+  forM_ (Map.toList mp) $ \(file, text) ->
+    Data.Text.IO.writeFile file text
+
+nullBackend :: Backend
+nullBackend = Backend {
+  backendName = "null",
+  backendOptionsParser = pure (),
+  backendIOMakeState = const $ return (),
+  backendTranspile = \_ _ _ -> mempty 
+}