dojang 0.2.0 → 0.2.1

raw patch · 11 files changed

+567/−92 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGES.md +28/−0
• dojang.cabal +3/−2
• src/Dojang/Commands/Hook.hs +27/−1
• src/Dojang/Commands/Init.hs +4/−1
• src/Dojang/Commands/Reflect.hs +41/−18
• src/Dojang/Syntax/Manifest/Writer.hs +108/−45
• test/Dojang/Commands/HookSpec.hs +121/−5
• test/Dojang/Commands/ReflectSpec.hs +95/−0
• test/Dojang/Syntax/Manifest/WriterSpec.hs +98/−6
• test/Dojang/Types/Environment/CurrentSpec.hs +1/−1
• test/Dojang/Types/Gen.hs +41/−13

@@ -1,6 +1,34 @@ Dojang changelog ================ +Version 0.2.1+-------------++Released on July 12, 2026.++ -  Fixed a bug where `dojang reflect` crashed after deleting the intermediate+    copy when a managed file had been removed at its destination.+    Destination-side deletions are now reflected to the source and can also be+    selected by naming the deleted destination path explicitly.  [[#24]]++ -  Fixed hook commands discarding the parent process environment.  Hooks now+    inherit variables such as `PATH` and `HOME`, while the `DOJANG_*` variables+    supplied by Dojang override any existing values.  This allows hook commands+    and programs invoked by hook scripts to be found through `PATH` as+    documented.  [[#25]]++ -  Fixed `writeManifest` silently dropping file route predicates that could+    not be represented by a moniker or that collided after moniker resolution.+    It now returns a `WriteError`, and `writeManifestFile` raises an I/O error,+    instead of writing an incomplete manifest.  When multiple monikers+    represent the same predicate, the writer now selects the first name in a+    deterministic order.  [[#26]]++[#24]: https://github.com/dahlia/dojang/issues/24+[#25]: https://github.com/dahlia/dojang/issues/25+[#26]: https://github.com/dahlia/dojang/issues/26++ Version 0.2.0 ------------- 

@@ -1,11 +1,11 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.39.1.+-- This file has been generated from package.yaml by hpack version 0.39.6. -- -- see: https://github.com/sol/hpack  name:           dojang-version:        0.2.0+version:        0.2.1 synopsis:       A cross-platform dotfiles manager description:    See also the README.md file. category:       Configuration@@ -147,6 +147,7 @@       Dojang.Commands.DisambiguationSpec       Dojang.Commands.EditSpec       Dojang.Commands.HookSpec+      Dojang.Commands.ReflectSpec       Dojang.Gen       Dojang.MonadFileSystemSpec       Dojang.Syntax.EnvironmentPredicate.ParserSpec

@@ -6,16 +6,20 @@ module Dojang.Commands.Hook   ( HookEnv (..)   , executeHooks+  , mergeHookEnvironment   , shouldRunHook   ) where  import Control.Monad (forM_, unless) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Reader (asks)+import System.Environment (getEnvironment) import System.Exit (ExitCode (..))+import System.Info (os) import Prelude hiding (readFile)  import Control.Monad.Logger (logDebug, logError, logInfo)+import Data.CaseInsensitive (mk) import Data.Map.Strict (lookup) import Data.Text (Text, pack, unpack) import System.Directory.OsPath (makeAbsolute)@@ -66,6 +70,27 @@   in result  +-- | Overlay the variables supplied by Dojang on the parent environment.+mergeHookEnvironment+  :: String+  -- ^ The host platform identifier from 'System.Info.os'.+  -> [(String, String)]+  -- ^ The variables supplied by Dojang.+  -> [(String, String)]+  -- ^ The parent process environment.+  -> [(String, String)]+  -- ^ The combined hook environment.+mergeHookEnvironment platform envVars parentEnv =+  envVars+    ++ filter+      (\(name, _) -> all (not . sameName name . fst) envVars)+      parentEnv+ where+  sameName left right+    | platform == "mingw32" = mk left == mk right+    | otherwise = left == right++ -- | Execute all hooks of a given type. executeHooks   :: (MonadFileSystem i, MonadIO i)@@ -135,11 +160,12 @@             , ("DOJANG_OS", unpack hookEnv.currentOS)             , ("DOJANG_ARCH", unpack hookEnv.currentArch)             ]+      parentEnv <- liftIO getEnvironment        let createProc =             (proc cmdPath argsStr)               { cwd = workDir-              , env = Just envVars+              , env = Just $ mergeHookEnvironment os envVars parentEnv               , delegate_ctlc = True               } 

@@ -13,6 +13,7 @@   ) where  import Control.Monad (forM_, when)+import Control.Monad.Except (MonadError (throwError)) import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Function ((&)) import Data.List (maximumBy, sortOn)@@ -357,7 +358,9 @@   debug' <- asks (.debug)   dryRun' <- asks (.dryRun)   when (debug' || dryRun') $ do-    let manifestText = indent $ writeManifest manifest+    manifestText <- case writeManifest manifest of+      Left err -> throwError $ userError $ show err+      Right toml -> pure $ indent toml     printStderr' Note $       "The manifest file looks like below:\n\n"         <> manifestText

@@ -244,13 +244,17 @@           liftIO $ exitWith userCancelledError reflect force allFlag _includeUnregistered explicitSource paths = do   ctx <- ensureContext-  nonExistents <- filterM (fmap not . exists) paths   pathStyle <- pathStyleFor stderr-  unless (null nonExistents) $ do-    dieWithErrors-      fileNotFoundError-      ["No such file: " <> pathStyle p <> "." | p <- nonExistents]   absPaths <- liftIO $ mapM makeAbsolute paths+  nonExistents <- filterM (fmap not . exists) absPaths+  let rejectUntrackedMissingPath path (correspond :: FileCorrespondence) =+        when+          ( path `elem` nonExistents+              && correspond.intermediate.stat == Missing+          )+          $ die'+            fileNotFoundError+            ("No such file: " <> pathStyle path <> ".")   $(logDebugSH) (absPaths :: [OsPath])   sourcePath' <- liftIO $ makeAbsolute ctx.repository.sourcePath   let sourcePathPrefix = splitDirectories sourcePath'@@ -287,15 +291,21 @@     (state, ws) <- getRouteState ctx absPath     case state of       NotRouted -> do-        manifestFile' <- asks (.manifestFile)-        printWarnings ws-        printStderr'-          Error-          ("File " <> pathStyle absPath <> " is not routed.")-        printStderr'-          Hint-          ("Add a route for it in " <> pathStyle manifestFile' <> ".")-        liftIO $ exitWith fileNotRoutedError+        if absPath `elem` nonExistents+          then+            die'+              fileNotFoundError+              ("No such file: " <> pathStyle absPath <> ".")+          else do+            manifestFile' <- asks (.manifestFile)+            printWarnings ws+            printStderr'+              Error+              ("File " <> pathStyle absPath <> " is not routed.")+            printStderr'+              Hint+              ("Add a route for it in " <> pathStyle manifestFile' <> ".")+            liftIO $ exitWith fileNotRoutedError       Routed _ -> do         return ws       Ignored name pattern -> do@@ -342,6 +352,7 @@         die' fileNotRoutedError ("File " <> pathStyle p <> " is not routed.")       SingleMatch route -> do         correspond <- makeCorrespondForRoute ctx p route+        rejectUntrackedMissingPath p correspond         return correspond       AmbiguousMatch candidates -> do         maybeRoute <- disambiguateRoutes autoSelectMode explicitSource candidates@@ -367,6 +378,7 @@             liftIO $ exitWith ambiguousRouteError           Just route -> do             correspond <- makeCorrespondForRoute ctx p route+            rejectUntrackedMissingPath p correspond             return correspond   -- Combine directory files and individual file correspondences   let allCorrespondences = dirFiles ++ fileCorrespondences@@ -477,10 +489,15 @@             <> " to "             <> pathStyle c.source.path             <> "..."-        cleanup c.intermediate-        copy c.destination c.intermediate-        cleanup c.source-        copy c.intermediate c.source+        if c.destinationDelta == Removed+          then do+            cleanupExisting c.source+            cleanupExisting c.intermediate+          else do+            cleanup c.intermediate+            copy c.destination c.intermediate+            cleanup c.source+            copy c.intermediate c.source   -- | Create a 'FileCorrespondence' from a route result and destination path.@@ -526,6 +543,12 @@     _ -> do       $(logDebug) $ "Remove file: " <> pack path       removeFile fileEntry.path+++cleanupExisting :: (MonadFileSystem i, MonadIO i) => FileEntry -> App i ()+cleanupExisting fileEntry = do+  pathExists <- (||) <$> exists fileEntry.path <*> isSymlink fileEntry.path+  when pathExists $ cleanup fileEntry   copy :: (MonadFileSystem i, MonadIO i) => FileEntry -> FileEntry -> App i ()

@@ -3,14 +3,16 @@ {-# LANGUAGE NoFieldSelectors #-}  module Dojang.Syntax.Manifest.Writer-  ( writeManifest+  ( WriteError (..)+  , writeManifest   , writeManifestFile   ) where -import Data.Bifunctor (Bifunctor (bimap, second))-import Data.List (partition)+import Control.Monad.Except (MonadError (throwError))+import Data.Bifunctor (Bifunctor (second))+import Data.List (group, partition, sort) import Data.List.NonEmpty (NonEmpty ((:|)), length, toList)-import Data.Maybe (catMaybes, fromMaybe, listToMaybe)+import Data.Maybe (fromMaybe, listToMaybe) import GHC.IsList (IsList (fromList)) import System.IO.Unsafe (unsafePerformIO) import Prelude hiding (all, any, writeFile)@@ -24,7 +26,6 @@ import TextShow (FromStringShow (FromStringShow), TextShow (showt)) import Toml.Pretty (prettyTomlOrdered) import Toml.ToValue (ToTable (toTable))-import Toml.Value (Table)  import qualified Data.Map.Strict import Dojang.MonadFileSystem@@ -48,7 +49,7 @@   ( EnvironmentPredicate (..)   , normalizePredicate   )-import Dojang.Types.FilePathExpression (toPathText)+import Dojang.Types.FilePathExpression (FilePathExpression, toPathText) import Dojang.Types.FileRoute (FileRoute (..)) import Dojang.Types.FileRouteMap (FileRouteMap) import Dojang.Types.Hook (Hook (..), HookMap, HookType (..))@@ -61,18 +62,56 @@ schema = "https://schema.dojang.dev/2023-11/manifest.schema.json"  +-- | An error that can occur while encoding a 'Manifest'.+data WriteError+  = -- | A route contains an environment predicate that cannot be represented+    -- by any moniker in the manifest.+    UnrepresentableRoutePredicate+      OsPath+      -- ^ The source path of the route.+      EnvironmentPredicate+      -- ^ The predicate that cannot be represented.+  | -- | Multiple route predicates resolve to the same moniker and therefore+    -- cannot be represented as distinct entries in the manifest.+    DuplicateRouteMoniker+      OsPath+      -- ^ The source path of the route.+      MonikerName+      -- ^ The moniker shared by multiple route predicates.+  deriving (Eq)+++instance Show WriteError where+  show (UnrepresentableRoutePredicate path predicate) =+    "Route predicate "+      <> show predicate+      <> " for path "+      <> show (decodePath path)+      <> " cannot be represented by any moniker."+  show (DuplicateRouteMoniker path moniker) =+    "Multiple route predicates for path "+      <> show (decodePath path)+      <> " resolve to moniker "+      <> show moniker+      <> "."++ -- | Encodes a 'Manifest' into a TOML document.-writeManifest :: Manifest -> Text-writeManifest manifest =-  "#:schema "-    <> schema-    <> "\n\n"-    <> (showt $ FromStringShow $ prettyTomlOrdered order tbl)+writeManifest+  :: Manifest+  -- ^ The 'Manifest' to encode.+  -> Either WriteError Text+  -- ^ The encoded TOML document, or an error if the manifest contains route+  -- predicates that the TOML format cannot represent without data loss.+writeManifest manifest = do+  manifest' <- mapManifest' manifest+  let tbl = toTable manifest'+  pure $+    "#:schema "+      <> schema+      <> "\n\n"+      <> (showt $ FromStringShow $ prettyTomlOrdered order tbl)  where-  manifest' :: Manifest'-  manifest' = mapManifest' manifest-  tbl :: Table-  tbl = toTable manifest'   order :: [String] -> String -> Either Int String   order [] field = case field of     "dirs" -> Left 1@@ -83,8 +122,8 @@   order _ field = Right field  --- | Writes a 'Manifest' file to the given path.  Throw an 'IOError' if the--- an occurs while writing the file.+-- | Writes a 'Manifest' file to the given path.  Throws an 'IOError' if the+-- manifest cannot be encoded or an error occurs while writing the file. writeManifestFile   :: (MonadFileSystem m)   => Manifest@@ -93,16 +132,16 @@   -- ^ The path to write the 'Manifest' to.   -> m () writeManifestFile manifest filePath =-  writeFile filePath $ encodeUtf8 $ writeManifest manifest+  case writeManifest manifest of+    Left err -> throwError $ userError $ show err+    Right toml -> writeFile filePath $ encodeUtf8 toml  -mapManifest' :: Manifest -> Manifest'-mapManifest' manifest =-  Manifest' monikers' dirs files ignores hooks'+mapManifest' :: Manifest -> Either WriteError Manifest'+mapManifest' manifest = do+  (dirs, files) <- mapFiles manifest.fileRoutes manifest.monikers+  pure $ Manifest' monikers' dirs files ignores hooks'  where-  dirs :: FileRouteMap'-  files :: FileRouteMap'-  (dirs, files) = mapFiles manifest.fileRoutes manifest.monikers   monikers' :: MonikerMap'   monikers' = mapMonikers' manifest.monikers   ignores :: IgnoreMap'@@ -118,12 +157,19 @@       else Just $ mapHooks' manifest.hooks  -mapFiles :: FileRouteMap -> MonikerMap -> (FileRouteMap', FileRouteMap')-mapFiles fileRouteMap monikers =-  ( fromList (bimap decodePath (`mapFileRoute'` monikers) <$> dirs)-  , fromList (bimap decodePath (`mapFileRoute'` monikers) <$> files)-  )+mapFiles+  :: FileRouteMap+  -> MonikerMap+  -> Either WriteError (FileRouteMap', FileRouteMap')+mapFiles fileRouteMap monikers = do+  dirs' <- traverse mapRoute dirs+  files' <- traverse mapRoute files+  pure (fromList dirs', fromList files')  where+  mapRoute :: (OsPath, FileRoute) -> Either WriteError (FilePath, FileRoute')+  mapRoute (path, route) = do+    route' <- mapFileRoute' path route monikers+    pure (decodePath path, route')   dirs :: [(OsPath, FileRoute)]   files :: [(OsPath, FileRoute)]   (dirs, files) =@@ -136,25 +182,42 @@ decodePath = unsafePerformIO . decodeFS  -mapFileRoute' :: FileRoute -> MonikerMap -> FileRoute'-mapFileRoute' fileRoute monikers =-  (fromList . catMaybes)-    [ case (normalizePredicate pred', maybe "" toPathText filePath) of-        (Moniker n, path) -> Just (n, path)-        (pred'', path) -> case lookBack monikers pred'' of-          Just n -> Just (n, path)-          Nothing -> Nothing-    | (pred', filePath) <- fileRoute.predicates-    ]+mapFileRoute'+  :: OsPath -> FileRoute -> MonikerMap -> Either WriteError FileRoute'+mapFileRoute' routePath fileRoute monikers = do+  mappedPredicates <- traverse mapPredicate fileRoute.predicates+  case duplicateMoniker mappedPredicates of+    Nothing -> Right $ fromList mappedPredicates+    Just moniker -> Left $ DuplicateRouteMoniker routePath moniker+ where+  duplicateMoniker :: [(MonikerName, Text)] -> Maybe MonikerName+  duplicateMoniker entries =+    listToMaybe+      [ moniker+      | moniker : _ : _ <- group $ sort $ fst <$> entries+      ]+  mapPredicate+    :: (EnvironmentPredicate, Maybe FilePathExpression)+    -> Either WriteError (MonikerName, Text)+  mapPredicate (predicate, filePath) =+    case normalizePredicate predicate of+      Moniker name -> Right (name, path)+      normalizedPredicate -> case lookBack monikers normalizedPredicate of+        Just name -> Right (name, path)+        Nothing ->+          Left $ UnrepresentableRoutePredicate routePath normalizedPredicate+   where+    path = maybe "" toPathText filePath   lookBack :: MonikerMap -> EnvironmentPredicate -> Maybe MonikerName lookBack monikers predicate =-  listToMaybe-    [ n-    | (n, p) <- Data.HashMap.Strict.toList monikers-    , normalizePredicate p == normalizedPred-    ]+  listToMaybe $+    sort+      [ n+      | (n, p) <- Data.HashMap.Strict.toList monikers+      , normalizePredicate p == normalizedPred+      ]  where   normalizedPred :: EnvironmentPredicate   normalizedPred = normalizePredicate predicate

@@ -3,18 +3,39 @@  module Dojang.Commands.HookSpec (spec) where +import Control.Exception (bracket_)+import Control.Monad (when) import System.IO.Unsafe (unsafePerformIO)  import Data.HashMap.Strict (empty)-import System.OsPath (OsPath, encodeFS)-import Test.Hspec (Spec, describe, it, shouldBe)+import qualified Data.Map.Strict as Map+import Data.Text (Text, pack)+import System.Environment+  ( getArgs+  , getExecutablePath+  , lookupEnv+  , setEnv+  , unsetEnv+  )+import System.OsPath (OsPath, encodeFS, (</>))+import Test.Hspec (Spec, describe, it, sequential, shouldBe) -import Dojang.Commands.Hook (shouldRunHook)+import Dojang.App (AppEnv (..), runAppWithoutLogging)+import Dojang.Commands.Hook+  ( HookEnv (..)+  , executeHooks+  , mergeHookEnvironment+  , shouldRunHook+  )+import Dojang.TestUtils (withTempDir)+import Dojang.Types.Context (Context (..)) import Dojang.Types.Environment (Environment (..), Kernel (..)) import Dojang.Types.EnvironmentPredicate (EnvironmentPredicate (..))-import Dojang.Types.Hook (Hook (..))+import Dojang.Types.Hook (Hook (..), HookType (PreApply))+import Dojang.Types.Manifest (Manifest (..)) import Dojang.Types.MonikerMap (MonikerMap) import Dojang.Types.MonikerName (parseMonikerName)+import Dojang.Types.Repository (Repository (..))   encodePath :: String -> OsPath@@ -22,7 +43,19 @@   spec :: Spec-spec = do+spec = sequential $ do+  describe "mergeHookEnvironment" $ do+    let dojangEnv = [("DOJANG_OS", "linux")]+    let parentEnv = [("Dojang_OS", "stale"), ("PATH", "/bin")]++    it "replaces differently cased variable names on Windows" $ do+      mergeHookEnvironment "mingw32" dojangEnv parentEnv+        `shouldBe` [("DOJANG_OS", "linux"), ("PATH", "/bin")]++    it "preserves differently cased variable names on POSIX" $ do+      mergeHookEnvironment "linux" dojangEnv parentEnv+        `shouldBe` dojangEnv ++ parentEnv+   describe "shouldRunHook" $ do     let env = Environment "linux" "x86_64" $ Kernel "Linux" "6.0.0" @@ -89,3 +122,86 @@               , ignoreFailure = False               }       shouldRunHook monikers env hook `shouldBe` False++  describe "executeHooks" $ do+    it "inherits the parent environment and overrides Dojang variables" $+      withTempDir $ \tmpDir _ -> do+        command <- hookCommand+        manifestFilename <- encodeFS "dojang.toml"+        intermediateDir <- encodeFS ".dojang"+        envFilename <- encodeFS "dojang-env.toml"+        let hook =+              Hook+                { command = fst command+                , args = snd command+                , condition = Always+                , workingDirectory = Nothing+                , ignoreFailure = False+                }+        let manifest' =+              Manifest empty Map.empty Map.empty $ Map.singleton PreApply [hook]+        let repository = Repository tmpDir (tmpDir </> intermediateDir) manifest'+        let environment = Environment "linux" "x86_64" $ Kernel "Linux" "6.0.0"+        let context = Context repository environment (const $ pure Nothing)+        let appEnv =+              AppEnv+                tmpDir+                intermediateDir+                manifestFilename+                envFilename+                False+                False+        let hookEnv =+              HookEnv+                tmpDir+                (tmpDir </> manifestFilename)+                False+                "hook-test-os"+                "x86_64"+        withEnvVars+          [ ("DOJANG_TEST_PARENT", Just "inherited")+          , ("DOJANG_OS", Just "stale")+          ]+          $ runAppWithoutLogging appEnv+          $ executeHooks hookEnv context PreApply++    it "hook environment probe" $ do+      arguments <- getArgs+      when (probePattern `elem` arguments && probeSeed `elem` arguments) $ do+        lookupEnv "DOJANG_TEST_PARENT" >>= (`shouldBe` Just "inherited")+        lookupEnv "DOJANG_OS" >>= (`shouldBe` Just "hook-test-os")+++hookCommand :: IO (OsPath, [Text])+hookCommand = do+  command <- getExecutablePath >>= encodeFS+  pure+    ( command+    ,+      [ "--match"+      , pack probePattern+      , "--seed"+      , pack probeSeed+      ]+    )+++probePattern :: String+probePattern = "/Dojang.Commands.Hook/executeHooks/hook environment probe/"+++probeSeed :: String+probeSeed = "250025"+++withEnvVars :: [(String, Maybe String)] -> IO a -> IO a+withEnvVars [] action = action+withEnvVars ((name, value) : rest) action = do+  oldValue <- lookupEnv name+  bracket_+    (setOrUnset value)+    (setOrUnset oldValue)+    (withEnvVars rest action)+ where+  setOrUnset (Just value') = setEnv name value'+  setOrUnset Nothing = unsetEnv name

@@ -0,0 +1,95 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}++module Dojang.Commands.ReflectSpec (spec) where++import Control.Exception (bracket_)+import Data.HashMap.Strict (singleton)+import qualified Data.Map.Strict as Map+import System.Environment (lookupEnv, setEnv, unsetEnv)+import System.Exit (ExitCode (ExitSuccess))+import System.OsPath (OsPath, encodeFS, (</>))+import Test.Hspec (Spec, describe, it, sequential)+import Test.Hspec.Expectations.Pretty (shouldReturn)+import Prelude hiding (writeFile)++import Dojang.App (AppEnv (..), runAppWithoutLogging)+import Dojang.Commands.Reflect (reflect)+import Dojang.MonadFileSystem (MonadFileSystem (..))+import Dojang.Syntax.Manifest.Writer (writeManifestFile)+import Dojang.TestUtils (withTempDir)+import Dojang.Types.EnvironmentPredicate (EnvironmentPredicate (Always))+import Dojang.Types.FilePathExpression (FilePathExpression (Substitution))+import Dojang.Types.Manifest (manifest)+import Dojang.Types.MonikerName (parseMonikerName)+++spec :: Spec+spec = sequential $ do+  describe "reflect" $ do+    it "reflects a destination-side deletion" $+      withDeletedDestination $+        \appEnv source intermediate _ -> do+          runAppWithoutLogging appEnv (reflect False True False Nothing [])+            `shouldReturn` ExitSuccess+          exists source `shouldReturn` False+          exists intermediate `shouldReturn` False++    it "reflects an explicitly named deleted destination" $+      withDeletedDestination $ \appEnv source intermediate destination -> do+        runAppWithoutLogging+          appEnv+          (reflect False True False Nothing [destination])+          `shouldReturn` ExitSuccess+        exists source `shouldReturn` False+        exists intermediate `shouldReturn` False+++withDeletedDestination :: (AppEnv -> OsPath -> OsPath -> OsPath -> IO a) -> IO a+withDeletedDestination action = withTempDir $ \tmpDir _ -> do+  sourceDir <- encodeFS "source"+  intermediateDir <- encodeFS ".dojang"+  manifestFilename <- encodeFS "dojang.toml"+  envFilename <- encodeFS "dojang-env.toml"+  routeName <- encodeFS "managed-file"+  destination <- encodeFS "destination"+  let repository = tmpDir </> sourceDir+  let intermediate = repository </> intermediateDir </> routeName+  let source = repository </> routeName+  let destinationPath = tmpDir </> destination+  let Right always = parseMonikerName "always"+  let manifest' =+        manifest+          (singleton always Always)+          (Map.singleton routeName [(always, Just $ Substitution "DEST")])+          mempty+          mempty+          mempty+  let appEnv =+        AppEnv+          repository+          intermediateDir+          manifestFilename+          envFilename+          False+          False++  createDirectories $ repository </> intermediateDir+  writeManifestFile manifest' $ repository </> manifestFilename+  writeFile source "managed contents"+  writeFile intermediate "managed contents"++  withEnvVar "DEST" (Just destinationPath) $+    action appEnv source intermediate destinationPath+++withEnvVar :: String -> Maybe OsPath -> IO a -> IO a+withEnvVar name value action = do+  oldValue <- lookupEnv name+  bracket_+    (setOrUnset value)+    (maybe (unsetEnv name) (setEnv name) oldValue)+    action+ where+  setOrUnset Nothing = unsetEnv name+  setOrUnset (Just value') = decodePath value' >>= setEnv name

@@ -1,20 +1,112 @@+{-# LANGUAGE OverloadedStrings #-}+ module Dojang.Syntax.Manifest.WriterSpec (spec) where -import Data.Text (unpack)-import Test.Hspec (Spec, specify)-import Test.Hspec.Hedgehog (annotate, annotateShow, forAll, hedgehog, (===))+import qualified Data.HashMap.Strict as HashMap+import Data.List (sort)+import qualified Data.Map.Strict as Map+import Data.Maybe (listToMaybe)+import Data.Text (isInfixOf, unpack)+import System.OsPath (encodeFS)+import Test.Hspec (Spec, runIO, specify)+import Test.Hspec.Expectations.Pretty (shouldBe, shouldSatisfy)+import Test.Hspec.Hedgehog+  ( annotate+  , annotateShow+  , assert+  , forAll+  , hedgehog+  , (===)+  ) +import Dojang.MonadFileSystem (FileType (File)) import Dojang.Syntax.Manifest.Parser (readManifest)-import Dojang.Syntax.Manifest.Writer (writeManifest)-import Dojang.Types.Gen as Gen (manifest)+import Dojang.Syntax.Manifest.Writer (WriteError (..), writeManifest)+import Dojang.Types.EnvironmentPredicate+  ( EnvironmentPredicate (Moniker, OperatingSystem)+  , normalizePredicate+  )+import Dojang.Types.FileRoute (FileRoute (FileRoute), fileRoute')+import Dojang.Types.Gen as Gen (arbitraryManifest, manifest)+import Dojang.Types.Manifest (Manifest (Manifest))+import Dojang.Types.MonikerName (parseMonikerName)   spec :: Spec spec = do+  path <- runIO $ encodeFS "foo"+  let Right alpha = parseMonikerName "alpha"+      Right zeta = parseMonikerName "zeta"+      linux = OperatingSystem "linux"+   specify "writeManifest" $ hedgehog $ do     manifest' <- forAll Gen.manifest-    let toml = writeManifest manifest'+    let Right toml = writeManifest manifest'     annotate $ unpack toml     let Right (parsed, _) = readManifest toml     annotateShow parsed     parsed === manifest'++  specify "rejects route predicates that cannot be represented" $ do+    let route = fileRoute' (const Nothing) [(linux, Nothing)] File+        manifest' = Manifest HashMap.empty (Map.singleton path route) Map.empty Map.empty+    writeManifest manifest'+      `shouldBe` Left (UnrepresentableRoutePredicate path linux)++  specify "rejects route predicates that map to the same moniker" $ do+    let monikers = HashMap.singleton alpha linux+        route =+          fileRoute'+            (`HashMap.lookup` monikers)+            [(Moniker alpha, Nothing), (linux, Nothing)]+            File+        manifest' = Manifest monikers (Map.singleton path route) Map.empty Map.empty+    writeManifest manifest'+      `shouldBe` Left (DuplicateRouteMoniker path alpha)++  specify "never drops arbitrary route predicates" $ hedgehog $ do+    manifest'@(Manifest monikers routes ignores hooks) <-+      forAll Gen.arbitraryManifest+    case writeManifest manifest' of+      Left (UnrepresentableRoutePredicate routePath predicate) -> do+        let Just (FileRoute _ predicates _) = Map.lookup routePath routes+        assert $+          predicate `elem` (normalizePredicate . fst <$> predicates)+        assert $+          all+            ((/= predicate) . normalizePredicate)+            (HashMap.elems monikers)+      Left (DuplicateRouteMoniker routePath moniker) -> do+        let Just (FileRoute _ predicates _) = Map.lookup routePath routes+            resolve predicate = case normalizePredicate predicate of+              Moniker name -> Just name+              normalizedPredicate ->+                listToMaybe $+                  sort+                    [ name+                    | (name, definition) <- HashMap.toList monikers+                    , normalizePredicate definition == normalizedPredicate+                    ]+            matches =+              [ ()+              | (predicate, _) <- predicates+              , resolve predicate == Just moniker+              ]+        assert $ length matches > 1+      Right toml -> do+        annotate $ unpack toml+        let Right (Manifest monikers' routes' ignores' hooks', _) =+              readManifest toml+            routeShape (FileRoute _ predicates fileType) =+              (sort $ show . snd <$> predicates, fileType)+        monikers' === monikers+        Map.map routeShape routes' === Map.map routeShape routes+        ignores' === ignores+        hooks' === hooks++  specify "selects deterministically between equivalent monikers" $ do+    let monikers = HashMap.fromList [(zeta, linux), (alpha, linux)]+        route = fileRoute' (`HashMap.lookup` monikers) [(linux, Nothing)] File+        manifest' = Manifest monikers (Map.singleton path route) Map.empty Map.empty+        Right toml = writeManifest manifest'+    toml `shouldSatisfy` isInfixOf "alpha = \"\""

@@ -99,7 +99,7 @@ expectLinuxKernel kernel = do   original kernel.name `shouldBe` "Linux"   original kernel.release-    `shouldSatisfy` (=~ ("^[0-9]+\\.[0-9]+\\.?[0-9]+[.-][0-9]+(-|$)" :: Text))+    `shouldSatisfy` (=~ ("^[0-9]+\\.[0-9]+\\.?[0-9]+[.-][0-9]+([-.]|$)" :: Text))   expectWindowsKernel :: Kernel -> IO ()

@@ -3,7 +3,8 @@ {-# LANGUAGE ScopedTypeVariables #-}  module Dojang.Types.Gen-  ( architecture+  ( arbitraryManifest+  , architecture   , ciText   , fileRoute   , fileRoute'@@ -40,7 +41,6 @@  import Data.CaseInsensitive (CI, mk) import Data.HashMap.Strict (HashMap, fromList, keys, lookup)-import Data.Map.Strict (empty) import Data.Text (Text, cons, length, pack) import Hedgehog.Gen qualified as Gen import Hedgehog.Range (Range, constant, constantFrom, singleton)@@ -390,29 +390,57 @@ fileRouteMap range monikers =   Gen.map range $ do     key <- osPath (singleton 1)-    value <--      fileRoute' (constant 0 5) monikers $-        Gen.choice $-          map return $-            fmap Moniker $-              case keys monikers of-                [] ->-                  let Right undefined' = parseMonikerName $ pack "undefined"-                  in [undefined']-                names -> names+    value <- representableRoute     return (key, value)+ where+  monikerPredicates :: [EnvironmentPredicate]+  monikerPredicates =+    fmap Moniker $ case keys monikers of+      [] ->+        let Right undefined' = parseMonikerName $ pack "undefined"+        in [undefined']+      names -> names+  representableRoute :: (MonadGen m) => m FileRoute.FileRoute+  representableRoute =+    fileRoute' (constant 0 5) monikers $ Gen.element monikerPredicates  +arbitraryFileRouteMap+  :: (MonadGen m) => Range Int -> MonikerMap -> m FileRouteMap+arbitraryFileRouteMap range monikers =+  Gen.map range $ do+    key <- osPath (singleton 1)+    value <- fileRoute' (constant 0 5) monikers environmentPredicate+    return (key, value)+++ignoreMap :: (MonadGen m) => m (Map.Map OsPath [String])+ignoreMap = Gen.map (constantFrom 0 0 5) $ do+  path <- osPath (singleton 1)+  patterns <- Gen.list (constantFrom 1 1 5) $ Gen.string (constant 0 20) osChar+  pure (path, patterns)++ manifest' :: forall m. (MonadGen m) => Range Int -> Range Int -> m Manifest manifest' monikerMapRange fileRouteMapRange = do   monikers <- monikerMap' monikerMapRange   fileRoutes <- fileRouteMap fileRouteMapRange monikers+  ignorePatterns <- ignoreMap   hooks <- hookMap (constant 0 3)-  return $ Manifest monikers fileRoutes Data.Map.Strict.empty hooks+  return $ Manifest monikers fileRoutes ignorePatterns hooks   manifest :: (MonadGen m) => m Manifest manifest = manifest' (constantFrom 0 0 5) (constantFrom 0 0 5)+++arbitraryManifest :: (MonadGen m) => m Manifest+arbitraryManifest = do+  monikers <- monikerMap' (constantFrom 0 0 5)+  fileRoutes <- arbitraryFileRouteMap (constantFrom 0 0 5) monikers+  ignorePatterns <- ignoreMap+  hooks <- hookMap (constant 0 3)+  return $ Manifest monikers fileRoutes ignorePatterns hooks   hook :: (MonadGen m) => m Hook