Add framework for more easily editing files.

This introduces the FilesM monad, which allows for monadic and
fragmented writing to files in a filesystem. This provides an
abstraction over writing to different "fragments" of files so
implementation, headers and declarations can all be written using just
one pass of the compiler.

5 files changed, 490 insertions, 167 deletions

diff --git a/src/Language/Fiddle/Compiler/Backend.hs b/src/Language/Fiddle/Compiler/Backend.hs
index eda3ede..dff8e47 100644
--- a/src/Language/Fiddle/Compiler/Backend.hs
+++ b/src/Language/Fiddle/Compiler/Backend.hs
@@ -62,7 +62,7 @@ backendToParserFunction
 
 processTranspileResult :: TranspileResult -> IO ()
 processTranspileResult (TranspileResult mp) =
-  forM_ (Map.toList mp) $ \(file, text) ->
+  forM_ (Map.toList mp) $ \(file, text) -> do
     Data.Text.IO.writeFile file text
 
 nullBackend :: Backend
diff --git a/src/Language/Fiddle/Compiler/Backend/C.hs b/src/Language/Fiddle/Compiler/Backend/C.hs
index 9dbbec6..dd79bac 100644
--- a/src/Language/Fiddle/Compiler/Backend/C.hs
+++ b/src/Language/Fiddle/Compiler/Backend/C.hs
@@ -9,7 +9,7 @@ module Language.Fiddle.Compiler.Backend.C (cBackend) where
 import Control.Arrow
 import Control.Monad (unless)
 import Control.Monad.RWS
-import Control.Monad.State (State)
+import Control.Monad.State
 import Control.Monad.Trans.Writer (Writer, execWriter)
 import Data.Char (isSpace)
 import Data.Data (Typeable, cast)
@@ -26,6 +26,9 @@ import Data.Text (Text)
 import qualified Data.Text as Text
 import Language.Fiddle.Ast
 import Language.Fiddle.Compiler.Backend
+import qualified Language.Fiddle.Compiler.Backend.Internal.FragTree as FragTree
+import Language.Fiddle.Compiler.Backend.Internal.FormattedWriter
+import Language.Fiddle.Compiler.Backend.Internal.Writer
 import Language.Fiddle.Internal.UnitInterface
 import Language.Fiddle.Internal.UnitNumbers
 import Language.Fiddle.Types
@@ -41,147 +44,47 @@ data CBackendFlags = CBackendFlags
 
 type StructName = Text
 
-newtype Fragment = Fragment Int
-  deriving (Eq, Ord)
-
 -- | Header fragment. The top. Starts which include guards and has include
 -- statements.
-hF :: Fragment
-hF = Fragment 0
+hF :: FileFragment
+hF = ("HEADER", FragTree.above FragTree.center)
 
 -- | Structures fragment. The text fragment where structures are defined.
-sF :: Fragment
-sF = Fragment 25
+sF :: FileFragment
+sF = ("HEADER", FragTree.below (snd hF))
 
 -- | Implementation fragment. This is where function implementations go.
-iF :: Fragment
-iF = Fragment 75
+iF :: FileFragment
+iF = ("HEADER", FragTree.above (snd fF))
 
 -- | Assert fragment. This is where static asserts go.
-aF :: Fragment
-aF = Fragment 50
+aF :: FileFragment
+aF = ("HEADER", FragTree.below (snd sF))
 
 -- | Footer fragment. This is wehre the file include endif goes.
-fF :: Fragment
-fF = Fragment 100
-
-tellLn :: (MonadWriter Text m) => Text -> m ()
-tellLn s = tell s >> tell "\n"
+fF :: FileFragment
+fF = ("HEADER", FragTree.below FragTree.center)
 
 type A = Commented SourceSpan
 
 type I = Identity
 
-data St = St
-
--- | Current local state information while traversing the tree.
-data Fmt = Fmt
-  { indentLevel :: Int,
-    pendingLine :: Text
-  }
-
-newtype M a = M {unM :: RWS () () (St, Files) a}
-  deriving newtype (Functor, Applicative, Monad, MonadState (St, Files))
-
-newtype FormattedWriter a = FormattedWriter (RWS () Text Fmt a)
-  deriving newtype (Functor, Applicative, Monad, MonadState Fmt)
-
-indented :: FileM a -> FileM a
-indented fn = do
-  textM (modify (\(Fmt id p) -> Fmt (id + 1) p))
-  fn <* textM (modify (\(Fmt id p) -> Fmt (id - 1) p))
-
-execFormattedWriter :: FormattedWriter a -> Text
-execFormattedWriter ((>> flush) -> FormattedWriter rws) = snd $ execRWS rws () (Fmt 0 "")
-
-flush :: FormattedWriter ()
-flush = do
-  p <- gets pendingLine
-  modify $ \s -> s {pendingLine = ""}
-  tell p
-
-newtype FileFragments = FileFragments (Map Fragment (FormattedWriter ()))
-
-instance Semigroup FileFragments where
-  (FileFragments m1) <> (FileFragments m2) = FileFragments (Map.unionWith (>>) m1 m2)
-
-instance Monoid FileFragments where
-  mempty = FileFragments mempty
+type M a = FilesM () FormattedWriter CFileState a
 
 newtype CFileState = CFileState
   { includedFiles :: Set String
   }
 
-newtype FileM a = FileM {unFileM :: RWS Fragment FileFragments CFileState a}
-  deriving newtype (Functor, Applicative, Monad, MonadWriter FileFragments, MonadReader Fragment, MonadState CFileState)
-
-execFileM :: FileM a -> Text
-execFileM fm =
-  let (_, FileFragments mp) = execRWS (unFileM fm) hF (CFileState mempty)
-   in ( execFormattedWriter
-          . sequence_
-          . Map.elems
-      )
-        mp
-
-requireInclude :: String -> FileM ()
+requireInclude :: String -> M ()
 requireInclude file = do
   b <- (Set.member file) <$> gets includedFiles
   unless b $ do
-    under hF $
+    checkout hF $
       text $
         Text.pack $
           printf "#include <%s>\n" file
     modify $ \s -> s {includedFiles = Set.insert file (includedFiles s)}
 
--- | Writes text to the current fragment context
-text :: Text -> FileM ()
-text t = flip tellF_ t =<< ask
-
--- | Writes text to the current fragment context
-textM :: FormattedWriter () -> FileM ()
-textM t = flip tellFM_ t =<< ask
-
--- | Executes a file monad within a different fragment.
-under :: Fragment -> FileM () -> FileM ()
-under fr = local (const fr)
-
-tellF_ :: Fragment -> Text -> FileM ()
-tellF_ fp txt = tell $ FileFragments $ Map.singleton fp (tell txt)
-
-tellFM_ :: Fragment -> FormattedWriter () -> FileM ()
-tellFM_ fp txtM = tell $ FileFragments $ Map.singleton fp txtM
-
-newtype Files = Files
-  { filepaths :: Map FilePath (FileM ())
-  }
-
-withFile :: FilePath -> FileM () -> M ()
-withFile fp fn = do
-  modify
-    ( second $ \(Files {filepaths = fps}) ->
-        Files
-          { filepaths = Map.alter (Just . (>> fn) . fromMaybe (return ())) fp fps
-          }
-    )
-
-instance MonadWriter Text FormattedWriter where
-  tell txt = FormattedWriter $ do
-    indent <- (`Text.replicate` "  ") <$> gets indentLevel
-    let lines = Text.splitOn "\n" txt
-    forM_ (init lines) $ \line -> do
-      pending <- gets pendingLine
-      modify $ \s -> s {pendingLine = ""}
-      tell indent
-      tell pending
-      tell line
-      tell "\n"
-    modify $ \s -> s {pendingLine = pendingLine s <> last lines}
-
-  listen (FormattedWriter fn) = FormattedWriter $ listen fn
-
-  pass (FormattedWriter fn) = FormattedWriter $ pass fn
-
 cBackend :: Backend
 cBackend =
   Backend
@@ -211,10 +114,6 @@ cBackend =
       backendTranspile = transpile
     }
 
-toTranspileResult :: Files -> TranspileResult
-toTranspileResult Files {filepaths = fps} =
-  TranspileResult $ fmap execFileM fps
-
 transpile ::
   CBackendFlags ->
   () ->
@@ -226,28 +125,37 @@ transpile
       cSourceOut = sourceFile
     }
   ()
-  fiddleUnit = toTranspileResult . snd . fst $ execRWS (unM run) () (St, Files mempty)
+  fiddleUnit = toTranspileResult $ fst $ runFilesM execFormattedWriter () (CFileState mempty) hF run
     where
-      run :: M ()
+      toTranspileResult :: Map FilePath Text -> TranspileResult
+      toTranspileResult mp =
+        TranspileResult $
+          Map.mapKeys
+            ( \case
+                "SOURCE" | Right sourceFile' <- sourceFile -> sourceFile'
+                "HEADER" -> headerFile
+                k -> k
+            )
+            mp
+
       run = do
-        withFile headerFile $ do
+        checkout hF $
           textM $ do
             tell $ "#ifndef " <> headerGuard <> "\n"
             tell $ "#define " <> headerGuard <> "\n\n"
             tell "#include <stdint.h>\n"
 
-          -- Pad out the implementation
-          under iF $ text "\n"
+        -- Pad out the implementation
+        checkout iF $ text "\n"
 
         walk (transpileWalk sourceFile headerFile) fiddleUnit ()
 
-        withFile headerFile $ do
-          under hF $
-            textM $ do
-              tell "\nstatic_assert(true); // https://github.com/clangd/clangd/issues/1167\n"
+        checkout hF $
+          textM $ do
+            tell "\nstatic_assert(true); // https://github.com/clangd/clangd/issues/1167\n"
 
-          under fF $
-            text headerFinal
+        checkout fF $
+          text headerFinal
 
       headerFinal = "\n#endif /* " <> headerGuard <> " */\n"
 
@@ -269,20 +177,10 @@ instance IsText Text where
 qualifiedPathToIdentifier :: (Foldable f, IsText t) => f t -> Text
 qualifiedPathToIdentifier = Text.intercalate "_" . map toText . toList
 
-ensureNL :: FormattedWriter ()
-ensureNL = do
-  p <- gets pendingLine
-  if Text.null p
-    then return ()
-    else do
-      modify $ \s -> s {pendingLine = ""}
-      tell p
-      tell "\n"
-
-pad :: FileM () -> FileM ()
+pad :: M () -> M ()
 pad f = text "\n" *> f <* text "\n"
 
-writeStaticAssert :: Text -> String -> N Bytes -> FileM ()
+writeStaticAssert :: Text -> String -> N Bytes -> M ()
 writeStaticAssert structName regname off = do
   requireInclude "stddef.h"
   text $
@@ -309,7 +207,7 @@ selectByModifier mod (getter, setter) =
     (ModifierKeyword Wo _) -> [setter]
     (ModifierKeyword Pr _) -> []
 
-writeRegGet :: StructName -> QRegMetadata True -> FileM ()
+writeRegGet :: StructName -> QRegMetadata True -> M ()
 writeRegGet
   structType
   ( QRegMetadata
@@ -347,7 +245,7 @@ writeRegGet
             tell $ Text.pack $ printf "  out[%d] = o->%s[%d];\n" i fieldName i
           tell "}\n\n"
 
-writeRegSet :: StructName -> QRegMetadata True -> FileM ()
+writeRegSet :: StructName -> QRegMetadata True -> M ()
 writeRegSet
   structType
   ( QRegMetadata
@@ -401,10 +299,10 @@ pattern DefinedBitsP bitsName bitsFullPath offset <-
       }
     )
 
-writeRegisterBody :: StructName -> QRegMetadata True -> RegisterBody Checked I A -> FileM ()
+writeRegisterBody :: StructName -> QRegMetadata True -> RegisterBody Checked I A -> M ()
 writeRegisterBody structName regmeta = walk_ registerWalk
   where
-    registerWalk :: forall t. (Walk t, Typeable t) => t I A -> FileM ()
+    registerWalk :: forall t. (Walk t, Typeable t) => t I A -> M ()
     registerWalk t = case () of
       ()
         | (Just (DefinedBitsP bitsName fullPath offset)) <- castTS t ->
@@ -433,7 +331,7 @@ writeImplementation ::
   QRegMetadata True ->
   Modifier f a ->
   Maybe (RegisterBody Checked I A) ->
-  FileM ()
+  M ()
 
 -- | Register is just padding, don't emit anything
 writeImplementation _ (regIsPadding -> True) _ _ = return ()
@@ -444,7 +342,7 @@ writeImplementation structName qMeta mod bod = do
 
   mapM_ (writeRegisterBody structName qMeta) bod
 
-structBody :: StructName -> ObjTypeBody Checked I A -> FileM ()
+structBody :: StructName -> ObjTypeBody Checked I A -> M ()
 structBody structName (ObjTypeBody _ decls _) = do
   forM_ decls $ \(Directed _ decl _) ->
     case decl of
@@ -462,10 +360,10 @@ structBody structName (ObjTypeBody _ decls _) = do
             tell (sizeToField i sz)
             tell ";\n"
 
-          under aF $
+          checkout aF $
             writeStaticAssert structName i off
 
-          under iF $
+          checkout iF $
             writeImplementation structName regMetadata mod bod
       TypeSubStructure
         { subStructureBody = Identity bod,
@@ -491,7 +389,7 @@ structBody structName (ObjTypeBody _ decls _) = do
       8 -> "volatile uint64_t " <> f
       n -> "volatile uint8_t " <> f <> "[" <> Text.pack (show n) <> "]"
 
-union :: Text -> FileM () -> FileM ()
+union :: Text -> M () -> M ()
 union identifier fn = do
   text "#pragma pack(push, 1)\n"
   text $ "union " <> identifier <> " "
@@ -499,7 +397,7 @@ union identifier fn = do
   text ";\n"
   text "#pragma pack(pop)\n"
 
-struct :: Text -> FileM () -> FileM ()
+struct :: Text -> M () -> M ()
 struct identifier fn = do
   text "#pragma pack(push, 1)\n"
   text $ "struct " <> identifier <> " "
@@ -507,8 +405,11 @@ struct identifier fn = do
   text ";\n"
   text "#pragma pack(pop)\n"
 
-body :: FileM a -> FileM a
-body f = text "{\n" *> indented f <* textM (ensureNL >> tell "}")
+body :: M a -> M a
+body f = text "{\n" *> withIndent f <* textM (ensureNL >> tell "}")
+
+withIndent :: M a -> M a
+withIndent = block incIndent decIndent
 
 identifierFor :: (ExportableDecl d) => d -> Text
 identifierFor = qualifiedPathToIdentifier . metadataFullyQualifiedPath . getMetadata
@@ -536,7 +437,10 @@ emitDocComments (Commented comments _) = do
         then Text.tail t
         else t
 
-transpileWalk :: Either ImplementationInHeader FilePath -> FilePath -> (forall t. (Walk t, Typeable t) => t I A -> () -> M (WalkContinuation ()))
+transpileWalk ::
+  Either ImplementationInHeader FilePath ->
+  FilePath ->
+  (forall t. (Walk t, Typeable t) => t I A -> () -> M (WalkContinuation ()))
 transpileWalk _ headerFile t _ = case () of
   ()
     | Just
@@ -551,21 +455,19 @@ transpileWalk _ headerFile t _ = case () of
               Union {} -> union
               Struct {} -> struct
 
-        withFile headerFile $ do
-          under sF $ do
-            pad $ do
-              textM $ emitDocComments a
-              let structName = identifierFor (unwrap metadata)
-              structureType structName $ do
-                structBody structName objTypeBody
+        checkout sF $ do
+          pad $ do
+            textM $ emitDocComments a
+            let structName = identifierFor (unwrap metadata)
+            structureType structName $ do
+              structBody structName objTypeBody
         return Stop
   () | Just (getExportedObjectDecl -> Just e) <- castTS t -> do
     let qname = qualifiedPathToIdentifier (metadataFullyQualifiedPath (getMetadata e))
-    withFile headerFile $
-      under fF $ do
-        text "#define "
-        text qname
-        text $ Text.pack $ printf " ((%s*)0x%08x)\n" (toLiteralTypeName (exportedObjectDeclType e)) (exportedObjectDeclLocation e)
+    checkout fF $ do
+      text "#define "
+      text qname
+      text $ Text.pack $ printf " ((%s*)0x%08x)\n" (toLiteralTypeName (exportedObjectDeclType e)) (exportedObjectDeclLocation e)
 
     return Stop
   _ -> return (Continue ())
diff --git a/src/Language/Fiddle/Compiler/Backend/Internal/FormattedWriter.hs b/src/Language/Fiddle/Compiler/Backend/Internal/FormattedWriter.hs
new file mode 100644
index 0000000..bde9ebe
--- /dev/null
+++ b/src/Language/Fiddle/Compiler/Backend/Internal/FormattedWriter.hs
@@ -0,0 +1,113 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | This module provides the 'FormattedWriter' monad, which extends a basic
+-- "Writer" over 'Text' by allowing formatting features like indentation, line 
+-- breaks, and ensuring the output is well-structured for readability. 
+-- 
+-- The 'FormattedWriter' is useful for generating pretty-printed output, such as
+-- source code generation, where indentation and newline management are essential.
+module Language.Fiddle.Compiler.Backend.Internal.FormattedWriter
+  ( -- * Types
+    FormattedWriter,       -- | The main writer monad with formatting features.
+    -- * Core Operations
+    ensureNL,              -- | Ensures that there is a newline at the end of the current line.
+    flush,                 -- | Flushes any pending text (writes the pending line).
+    incIndent,             -- | Increases the indentation level.
+    decIndent,             -- | Decreases the indentation level.
+    indented,              -- | Performs an action with increased indentation.
+    execFormattedWriter,   -- | Runs the 'FormattedWriter' and produces the final formatted 'Text'.
+  )
+where
+
+import Control.Monad (forM_)
+import Control.Monad.RWS.Strict
+import Data.Text (Text)
+import qualified Data.Text as Text
+
+-- | Internal state for the 'FormattedWriter' monad.
+-- 
+-- * 'indentLevel': The current level of indentation.
+-- * 'pendingLine': The current line that is being built but not yet written.
+data Fmt = Fmt
+  { indentLevel :: Int,    -- ^ Current indentation level.
+    pendingLine :: Text    -- ^ Text that has been added but not yet written to the output.
+  }
+
+-- | The 'FormattedWriter' is a monad that provides functionality for writing
+-- formatted text, with control over indentation and newlines.
+newtype FormattedWriter a = FormattedWriter (RWS () Text Fmt a)
+  deriving newtype (Functor, Applicative, Monad, MonadState Fmt)
+
+-- | 'MonadWriter' instance for 'FormattedWriter', which allows writing text
+-- while maintaining proper indentation and ensuring that newlines are handled
+-- correctly. Each line is prefixed with the correct indentation level.
+instance MonadWriter Text FormattedWriter where
+  tell txt = FormattedWriter $ do
+    -- Get the current indentation level and prepare the indentation prefix.
+    indent <- (`Text.replicate` "  ") <$> gets indentLevel
+    -- Split the text into lines.
+    let lines = Text.splitOn "\n" txt
+    -- For each line, write the indent, the pending line, and then the line itself.
+    forM_ (Prelude.init lines) $ \line -> do
+      pending <- gets pendingLine
+      modify $ \s -> s {pendingLine = ""}  -- Reset pending line
+      tell indent  -- Add indentation
+      tell pending -- Write any pending text
+      tell line    -- Write the actual line
+      tell "\n"    -- Add a newline after the line
+    -- The last fragment is kept as the new pending line, to be written later.
+    modify $ \s -> s {pendingLine = pendingLine s <> Prelude.last lines}
+
+  -- Allow listening to the written text within the 'FormattedWriter' context.
+  listen (FormattedWriter fn) = FormattedWriter $ listen fn
+
+  -- Allow transformation of the written text via a pass operation.
+  pass (FormattedWriter fn) = FormattedWriter $ pass fn
+
+-- | Ensures that a newline is written if there is any pending text. This is
+-- useful for ensuring that the output ends on a clean line.
+ensureNL :: FormattedWriter ()
+ensureNL = do
+  p <- gets pendingLine
+  if Text.null p
+    then return ()
+    else do
+      modify $ \s -> s {pendingLine = ""}
+      tell p
+      tell "\n"
+
+-- | Flushes the pending line by writing it to the output and clearing the
+-- pending state. This is useful when you want to force the current line to
+-- be written immediately.
+flush :: FormattedWriter ()
+flush = do
+  p <- gets pendingLine
+  modify $ \s -> s {pendingLine = ""}
+  tell p
+
+-- | Increases the indentation level by one. This will affect all subsequent
+-- lines written within the 'FormattedWriter' monad.
+incIndent :: FormattedWriter ()
+incIndent = modify (\(Fmt id p) -> Fmt (id + 1) p)
+
+-- | Decreases the indentation level by one. This will affect all subsequent
+-- lines written within the 'FormattedWriter' monad.
+decIndent :: FormattedWriter ()
+decIndent = modify (\(Fmt id p) -> Fmt (id - 1) p)
+
+-- | Runs the given 'FormattedWriter' action with an additional indentation level.
+-- Once the action completes, the indentation level is decreased.
+indented :: FormattedWriter () -> FormattedWriter ()
+indented fn = do
+  incIndent  -- Increase indentation level
+  fn         -- Run the action with the increased indentation
+  decIndent  -- Restore the original indentation level
+
+-- | Runs a 'FormattedWriter' and returns the final formatted 'Text' output.
+-- It ensures that any pending lines are flushed before returning the result.
+execFormattedWriter :: FormattedWriter a -> Text
+execFormattedWriter ((>> flush) -> FormattedWriter rws) =
+  snd $ execRWS rws () (Fmt 0 "")  -- Execute the RWS monad, starting with no indentation and no pending line.
+
diff --git a/src/Language/Fiddle/Compiler/Backend/Internal/FragTree.hs b/src/Language/Fiddle/Compiler/Backend/Internal/FragTree.hs
new file mode 100644
index 0000000..bc55c5a
--- /dev/null
+++ b/src/Language/Fiddle/Compiler/Backend/Internal/FragTree.hs
@@ -0,0 +1,159 @@
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveTraversable #-}
+
+-- | Module for a 'FragTree' data structure. This data structure represents
+-- "fragments" of a file, which are logical points in a file or buffer.
+--
+-- A fragment represents an indexed position in a file, but the position
+-- is not necessarily discrete. Instead, fragments can be positioned
+-- relative to each other (e.g., above or below other fragments),
+-- allowing for arbitrary resolution within the file.
+module Language.Fiddle.Compiler.Backend.Internal.FragTree
+  ( -- * Types
+    Fragment,
+    FragTree,
+
+    -- * Fragment Constructors
+    center,
+    -- | A fragment at the center of the file.
+    above,
+    -- | A fragment above a given fragment.
+    below,
+    -- | A fragment below a given fragment.
+    -- * FragTree Operations
+    updateWithReturn,
+    -- | Update a fragment in the tree and return a custom value.
+    Language.Fiddle.Compiler.Backend.Internal.FragTree.lookup,
+    -- | Lookup a value by fragment.
+    update,
+    -- | Update or insert a value into the tree.
+    insertOrReplace,
+    -- | Insert a value at a fragment, replacing any existing value.
+    insertAppend,
+    -- | Insert a value by appending (using 'Monoid') if a value already exists.
+    insertWith,
+    -- | Insert a value, combining it with an existing value using a custom function.
+    delete,
+    -- | Delete a value from the tree at a specific fragment.
+    singleton,
+    -- | Create a tree with a single fragment and value.
+  )
+where
+
+-- | Direction of a fragment relative to another fragment.
+data Loc = Above | Below
+
+-- | A 'Fragment' is a position in a file or buffer that can be relative
+-- to other fragments (above or below).
+newtype Fragment = Fragment [Loc]
+
+-- | Fragment that represents the center of the file.
+center :: Fragment
+center = Fragment []
+
+-- | Create a fragment above the given fragment.
+above :: Fragment -> Fragment
+above (Fragment l) = Fragment $ Above : l
+
+-- | Create a fragment below the given fragment.
+below :: Fragment -> Fragment
+below (Fragment l) = Fragment $ Below : l
+
+-- | A 'FragTree' represents a binary tree where each node holds a fragment's value.
+-- Each tree node has two children, representing the fragments above and below
+-- the current fragment. Leaves represent empty nodes.
+data FragTree a
+  = FragTree (FragTree a) (FragTree a) (Maybe a)
+  | FragLeaf
+  deriving (Functor)
+
+instance Foldable FragTree where
+  foldMap _ FragLeaf = mempty
+  foldMap fn (FragTree up down t) =
+    foldMap fn up <> foldMap fn t <> foldMap fn down
+
+instance Traversable FragTree where
+  traverse _ FragLeaf = pure FragLeaf
+  traverse fn (FragTree up down t) = do
+    (\a b c -> FragTree a c b)
+      <$> traverse fn up
+      <*> traverse fn t
+      <*> traverse fn down
+
+-- | 'Semigroup' instance for 'FragTree', merging two trees by combining values
+-- from corresponding fragments, using the 'Semigroup' instance of the contained values.
+instance (Semigroup a) => Semigroup (FragTree a) where
+  (<>) (FragTree ab1 be1 v1) (FragTree ab2 be2 v2) =
+    FragTree (ab1 <> ab2) (be1 <> be2) (v1 <> v2)
+  (<>) FragLeaf f = f
+  (<>) f FragLeaf = f
+
+-- | 'Monoid' instance for 'FragTree'. The empty tree is represented by 'FragLeaf'.
+instance (Semigroup a) => Monoid (FragTree a) where
+  mempty = FragLeaf
+
+-- | 'updateWithReturn' updates a 'FragTree' at the specified 'Fragment',
+-- returning both a custom value and the updated tree.
+-- If the fragment doesn't exist, it is created.
+updateWithReturn :: (Maybe a -> (b, Maybe a)) -> Fragment -> FragTree a -> (b, FragTree a)
+updateWithReturn fn (Fragment (reverse -> loc)) = update' fn loc
+  where
+    -- Helper function for traversing and updating the tree.
+    update' fn [] FragLeaf = clean . FragTree FragLeaf FragLeaf <$> fn Nothing
+    update' fn [] (FragTree a b v) = clean . FragTree a b <$> fn v
+    update' fn (Above : ls) (FragTree a b v) =
+      fmap clean $
+        (\a' -> FragTree a' b v) <$> update' fn ls a
+    update' fn (Below : ls) (FragTree a b v) =
+      fmap clean $
+        (\b' -> FragTree a b' v) <$> update' fn ls b
+    update' fn (Above : ls) FragLeaf =
+      fmap clean $
+        (\a' -> FragTree a' FragLeaf Nothing) <$> update' fn ls FragLeaf
+    update' fn (Below : ls) FragLeaf =
+      fmap clean $
+        (\b' -> FragTree FragLeaf b' Nothing) <$> update' fn ls FragLeaf
+
+-- | Create a 'FragTree' with a single 'Fragment' and associated value.
+singleton :: Fragment -> a -> FragTree a
+singleton f a = insertOrReplace f a FragLeaf
+
+-- | Lookup a value in the 'FragTree' by its 'Fragment'. Returns 'Nothing'
+-- if the fragment does not exist.
+lookup :: Fragment -> FragTree a -> Maybe a
+lookup l = fst . updateWithReturn (\a -> (a, a)) l
+
+-- | Update a 'FragTree' at the given 'Fragment'. If the fragment does not exist,
+-- it is created. The function is applied to the existing value (or 'Nothing' if no value).
+update :: (Maybe a -> Maybe a) -> Fragment -> FragTree a -> FragTree a
+update fn fr = snd . updateWithReturn (\ma -> ((), fn ma)) fr
+
+-- | Insert a value into the 'FragTree', replacing any existing value at the given fragment.
+insertOrReplace :: Fragment -> a -> FragTree a -> FragTree a
+insertOrReplace l a = update (const $ Just a) l
+
+-- | Delete a fragment from the 'FragTree', setting its value to 'Nothing'.
+delete :: Fragment -> FragTree a -> FragTree a
+delete = update (const Nothing)
+
+-- | Insert a value by appending (using the 'Monoid' instance) to an existing value
+-- at the given fragment. If no value exists, the provided value is inserted.
+insertAppend :: (Monoid a) => Fragment -> a -> FragTree a -> FragTree a
+insertAppend l a = update (<> Just a) l
+
+-- | Insert a value using a custom function to combine it with an existing value
+-- at the given fragment. If no val
+insertWith :: (a -> a -> a) -> Fragment -> a -> FragTree a -> FragTree a
+insertWith fn fr v =
+  update
+    ( \case
+        Nothing -> Just v
+        Just a -> Just (fn a v)
+    )
+    fr
+
+-- | Internal function for cleaning up a 'FragTree' by collapsing empty nodes
+-- (i.e., 'FragTree' nodes with no values and no children) into 'FragLeaf'.
+clean :: FragTree a -> FragTree a
+clean (FragTree FragLeaf FragLeaf Nothing) = FragLeaf
+clean x = x
diff --git a/src/Language/Fiddle/Compiler/Backend/Internal/Writer.hs b/src/Language/Fiddle/Compiler/Backend/Internal/Writer.hs
new file mode 100644
index 0000000..83f6e27
--- /dev/null
+++ b/src/Language/Fiddle/Compiler/Backend/Internal/Writer.hs
@@ -0,0 +1,149 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | This module contains the 'FilesM' monad, which allows for incremental,
+-- fragmented, and monadic editing of "files" in a "filesystem" (represented as a
+-- 'Map' from 'FilePath' to 'Text').
+--
+-- The 'FilesM' monad provides operations for "checking out" file fragments, writing
+-- text to them, and managing file modifications in a monadic fashion.
+-- The final result, produced by 'runFilesM', is a map of file paths to text,
+-- representing the contents that should be written to each file.
+module Language.Fiddle.Compiler.Backend.Internal.Writer
+  ( -- * Types
+    FileFragment,
+
+    -- * FilesM Operations
+
+    -- | Run the 'FilesM' monad and produce the final map of files and their contents.
+    runFilesM,
+    -- | A variant of 'runFilesM' that runs with a 'Writer'.
+    runFileMWriter,
+    -- | Write plain text to the current file fragment.
+    text,
+    -- | Write a monadic action that produces text to the current file fragment.
+    textM,
+    -- | The 'FilesM' monad for file-based operations.
+    FilesM,
+    -- | Checkout a specific file fragment for writing.
+    checkout,
+    -- | Write a line of text (with a newline) to the current file fragment.
+    tellLn,
+    -- | Surround a block of file operations with a start and end marker.
+    block,
+  )
+where
+
+import Control.Arrow
+import Control.Monad.RWS.Strict
+import Control.Monad.Trans.Writer (Writer, execWriter)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Monoid
+import Data.Text (Text)
+import Language.Fiddle.Compiler.Backend.Internal.FragTree (FragTree, Fragment)
+import qualified Language.Fiddle.Compiler.Backend.Internal.FragTree as FragTree
+
+-- | 'FileMap' represents the mapping between 'FilePath' and file content.
+-- The content of each file is stored as a 'FragTree', which can hold fragments
+-- of text.
+newtype FileMap a = FileMap (Map FilePath a)
+  deriving newtype (Functor, Show, Foldable)
+
+-- | 'Semigroup' instance for 'FileMap'. When merging two 'FileMap's, the content
+-- of each file is combined using the 'Semigroup' instance of the file content type.
+instance (Semigroup a) => Semigroup (FileMap a) where
+  (<>) (FileMap m1) (FileMap m2) = FileMap $ Map.unionWith (<>) m1 m2
+
+-- | 'Monoid' instance for 'FileMap'. The empty file map is represented by an empty map.
+instance (Semigroup a) => Monoid (FileMap a) where
+  mempty = FileMap mempty
+
+-- | The 'FilesM' monad provides a context for managing file fragments and writing
+-- content to them in a monadic style. It is parameterized over:
+--
+-- * @r@: The environment shared across file writes (e.g., metadata or global settings).
+-- * @w@: The writer monad used to accumulate file content ('Text' or some other type).
+-- * @s@: The state type for managing any local state during the file writes.
+-- * @a@: The return type of the computation.
+newtype FilesM r w s a
+  = FilesM
+      ( RWS
+          (r, FileFragment) -- Reader context containing global settings and current file fragment.
+          (FileMap (FragTree (Ap w ()))) -- Writer accumulating the file content as a 'FragTree'.
+          (s, w ()) -- State holding user-provided state 's' and the current writer accumulator.
+          a -- Result of the computation.
+      )
+  deriving newtype (Functor, Applicative, Monad)
+
+-- | 'MonadState' instance for 'FilesM'. Allows manipulation of state within the 'FilesM' monad.
+instance (Applicative w) => MonadState s (FilesM r w s) where
+  get = FilesM $ fst <$> get
+  put v = FilesM $ modify $ first (const v)
+
+-- | 'MonadReader' instance for 'FilesM'. Allows access to reader environment.
+instance (Applicative w) => MonadReader r (FilesM r w s) where
+  ask = FilesM $ fst <$> ask
+  local fn (FilesM a) = FilesM $ local (first fn) a
+
+-- | A 'FileFragment' represents a specific section of a file. It is a tuple of a 'FilePath'
+-- and a 'Fragment', which denotes a position in the file where modifications are made.
+type FileFragment = (FilePath, Fragment)
+
+-- | Checkout a specific file fragment for writing. After checking out a fragment,
+-- subsequent file operations will affect that fragment until another fragment is checked out.
+checkout :: (Monad w) => FileFragment -> FilesM r w s a -> FilesM r w s a
+checkout (fileName, newFrag) (FilesM fn) =
+  FilesM $ do
+    flush -- Flush any existing writes before switching fragments
+    -- Change the current fragment being worked on
+    local (\(r, _) -> (r, (fileName, newFrag))) $ fn <* flush
+  where
+    (FilesM flush) = flushFilesM
+
+-- | Internal helper function that flushes the current state of the 'FilesM' monad
+-- by committing any pending writes to the current file fragment.
+flushFilesM :: (Monad w) => FilesM r w s ()
+flushFilesM = FilesM $ do
+  (fileName, frag) <- asks snd -- Get the current file and fragment being written to
+  writer <- gets snd -- Get the current text to write
+  modify $ \(s, _) -> (s, return ()) -- Clear the writer
+  tell $ FileMap $ Map.singleton fileName $ FragTree.singleton frag (Ap writer)
+
+-- | Write plain text to the current file fragment.
+text :: (MonadWriter t w) => t -> FilesM r w s ()
+text txt = FilesM $ modify (second (>> tell txt))
+
+-- | Write a monadic action that produces text to the current file fragment.
+textM :: (Monad w) => w () -> FilesM r w s ()
+textM fn = FilesM $ modify (second (>> fn))
+
+-- | Run the 'FilesM' monad and produce the final file map along with any additional state.
+-- The result is a 'Map' from 'FilePath' to some textual representation, as well as
+-- the final state of the monad.
+runFilesM ::
+  (Monad w) =>
+  (forall x. w x -> t) -> -- Function to extract text from the writer monad
+  r -> -- Reader environment
+  s -> -- Initial state
+  FileFragment -> -- Initial file fragment to write to
+  FilesM r w s a -> -- FilesM monadic action to run
+  (Map FilePath t, (a, s)) -- Final map of files and their contents, and final result and state
+runFilesM exec rr ss initFrag ((<* flushFilesM) -> FilesM rws) =
+  let (a, (s, _), FileMap filesMap) = runRWS rws (rr, initFrag) (ss, return ())
+   in (fmap (exec . mapM_ getAp) filesMap, (a, s))
+
+-- | A helper function to run 'FilesM' with a 'Writer' monad, where each file's contents
+-- is represented as a monoid (such as 'Text').
+runFileMWriter :: (Monoid t) => r -> s -> FileFragment -> FilesM r (Writer t) s a -> Map FilePath t
+runFileMWriter r s initFrag f = fst $ runFilesM execWriter r s initFrag f
+
+-- | Write a line of text (appends a newline) to the current file fragment.
+tellLn :: (MonadWriter Text m) => Text -> m ()
+tellLn s = tell s >> tell "\n"
+
+-- | Surround a block of file operations with a start and end marker.
+-- This is useful for inserting things like function or block delimiters.
+block :: (Monad w) => w () -> w () -> FilesM r w s a -> FilesM r w s a
+block s e f = textM s *> f <* textM e