hix (empty) → 0.1.0.0
raw patch · 22 files changed
+2320/−0 lines, 22 filesdep +Cabaldep +aesondep +basesetup-changed
Dependencies added: Cabal, aeson, base, exon, extra, filepattern, generic-lens, hedgehog, hix, incipit-base, lens, lens-regex-pcre, optparse-applicative, path, path-io, random, tasty, tasty-hedgehog, transformers, unix
Files
- LICENSE +34/−0
- Setup.hs +2/−0
- app/Main.hs +3/−0
- hix.cabal +213/−0
- lib/Hix.hs +43/−0
- lib/Hix/Cabal.hs +101/−0
- lib/Hix/Component.hs +115/−0
- lib/Hix/Data/Error.hs +68/−0
- lib/Hix/Data/GhciConfig.hs +116/−0
- lib/Hix/Data/GhciTest.hs +30/−0
- lib/Hix/Env.hs +27/−0
- lib/Hix/Ghci.hs +187/−0
- lib/Hix/Json.hs +25/−0
- lib/Hix/Monad.hs +34/−0
- lib/Hix/Options.hs +260/−0
- lib/Hix/Optparse.hs +42/−0
- lib/Hix/Preproc.hs +463/−0
- test/Hix/Test/CabalFile.hs +73/−0
- test/Hix/Test/CabalTest.hs +32/−0
- test/Hix/Test/GhciTest.hs +164/−0
- test/Hix/Test/PreprocTest.hs +243/−0
- test/Main.hs +45/−0
+ LICENSE view
@@ -0,0 +1,34 @@+Copyright (c) 2020 Torsten Schmits++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the+following conditions are met:++ 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following+ disclaimer.+ 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided with the distribution.++Subject to the terms and conditions of this license, each copyright holder and contributor hereby grants to those+receiving rights under this license a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except+for failure to satisfy the conditions of this license) patent license to make, have made, use, offer to sell, sell,+import, and otherwise transfer this software, where such license applies only to those patent claims, already acquired+or hereafter acquired, licensable by such copyright holder or contributor that are necessarily infringed by:++ (a) their Contribution(s) (the licensed copyrights of copyright holders and non-copyrightable additions of+ contributors, in source or binary form) alone; or+ (b) combination of their Contribution(s) with the work of authorship to which such Contribution(s) was added by such+ copyright holder or contributor, if, at the time the Contribution is added, such addition causes such combination to+ be necessarily infringed. The patent license shall not apply to any other combinations which include the Contribution.++Except as expressly stated above, no rights or licenses from any copyright holder or contributor is granted under this+license, whether expressly, by implication, estoppel or otherwise.++DISCLAIMER++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,3 @@+module Main (main) where++import Hix (main)
+ hix.cabal view
@@ -0,0 +1,213 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.35.0.+--+-- see: https://github.com/sol/hpack++name: hix+version: 0.1.0.0+synopsis: Haskell/Nix development build tools+description: See https://hackage.haskell.org/package/hix/docs/Hix.html+category: Build+homepage: https://git.tryp.io/tek/hix+bug-reports: https://github.com/tek/hix/issues+author: Torsten Schmits+maintainer: hackage@tryp.io+copyright: 2023 Torsten Schmits+license: BSD-2-Clause-Patent+license-file: LICENSE+build-type: Simple++source-repository head+ type: git+ location: https://git.tryp.io/tek/hix++library+ exposed-modules:+ Hix+ Hix.Cabal+ Hix.Component+ Hix.Data.Error+ Hix.Data.GhciConfig+ Hix.Data.GhciTest+ Hix.Env+ Hix.Ghci+ Hix.Json+ Hix.Monad+ Hix.Options+ Hix.Optparse+ Hix.Preproc+ hs-source-dirs:+ lib+ default-extensions:+ AllowAmbiguousTypes+ ApplicativeDo+ BlockArguments+ DataKinds+ DefaultSignatures+ DeriveAnyClass+ DerivingStrategies+ DerivingVia+ DisambiguateRecordFields+ DuplicateRecordFields+ FunctionalDependencies+ GADTs+ LambdaCase+ LiberalTypeSynonyms+ MultiWayIf+ OverloadedLabels+ OverloadedLists+ OverloadedStrings+ PackageImports+ PartialTypeSignatures+ PatternSynonyms+ QuantifiedConstraints+ QuasiQuotes+ RecordWildCards+ RecursiveDo+ RoleAnnotations+ TemplateHaskell+ TypeFamilies+ TypeFamilyDependencies+ UndecidableInstances+ UnicodeSyntax+ ViewPatterns+ OverloadedRecordDot+ NoFieldSelectors+ ghc-options: -Wall -Widentities -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-type-patterns -Wunused-packages+ build-depends:+ Cabal+ , aeson ==2.0.*+ , base ==4.*+ , exon ==1.4.*+ , extra ==1.7.*+ , filepattern ==0.1.*+ , generic-lens ==2.2.*+ , incipit-base ==0.5.*+ , lens ==5.1.*+ , lens-regex-pcre ==1.1.*+ , optparse-applicative ==0.17.*+ , path ==0.9.*+ , path-io ==1.7.*+ , random ==1.2.*+ , transformers+ , unix+ mixins:+ base hiding (Prelude)+ , incipit-base (IncipitBase as Prelude)+ , incipit-base hiding (IncipitBase)+ default-language: GHC2021++executable hix+ main-is: Main.hs+ hs-source-dirs:+ app+ default-extensions:+ AllowAmbiguousTypes+ ApplicativeDo+ BlockArguments+ DataKinds+ DefaultSignatures+ DeriveAnyClass+ DerivingStrategies+ DerivingVia+ DisambiguateRecordFields+ DuplicateRecordFields+ FunctionalDependencies+ GADTs+ LambdaCase+ LiberalTypeSynonyms+ MultiWayIf+ OverloadedLabels+ OverloadedLists+ OverloadedStrings+ PackageImports+ PartialTypeSignatures+ PatternSynonyms+ QuantifiedConstraints+ QuasiQuotes+ RecordWildCards+ RecursiveDo+ RoleAnnotations+ TemplateHaskell+ TypeFamilies+ TypeFamilyDependencies+ UndecidableInstances+ UnicodeSyntax+ ViewPatterns+ OverloadedRecordDot+ NoFieldSelectors+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Widentities -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-type-patterns -Wunused-packages+ build-depends:+ base ==4.*+ , hix+ , incipit-base ==0.5.*+ mixins:+ base hiding (Prelude)+ , incipit-base (IncipitBase as Prelude)+ , incipit-base hiding (IncipitBase)+ default-language: GHC2021++test-suite hix-test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Hix.Test.CabalFile+ Hix.Test.CabalTest+ Hix.Test.GhciTest+ Hix.Test.PreprocTest+ hs-source-dirs:+ test+ default-extensions:+ AllowAmbiguousTypes+ ApplicativeDo+ BlockArguments+ DataKinds+ DefaultSignatures+ DeriveAnyClass+ DerivingStrategies+ DerivingVia+ DisambiguateRecordFields+ DuplicateRecordFields+ FunctionalDependencies+ GADTs+ LambdaCase+ LiberalTypeSynonyms+ MultiWayIf+ OverloadedLabels+ OverloadedLists+ OverloadedStrings+ PackageImports+ PartialTypeSignatures+ PatternSynonyms+ QuantifiedConstraints+ QuasiQuotes+ RecordWildCards+ RecursiveDo+ RoleAnnotations+ TemplateHaskell+ TypeFamilies+ TypeFamilyDependencies+ UndecidableInstances+ UnicodeSyntax+ ViewPatterns+ OverloadedRecordDot+ NoFieldSelectors+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Widentities -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-type-patterns -Wunused-packages+ build-depends:+ Cabal+ , base ==4.*+ , exon ==1.4.*+ , hedgehog ==1.1.*+ , hix+ , incipit-base ==0.5.*+ , path ==0.9.*+ , path-io ==1.7.*+ , tasty ==1.4.*+ , tasty-hedgehog ==1.3.*+ , transformers+ mixins:+ base hiding (Prelude)+ , incipit-base (IncipitBase as Prelude)+ , incipit-base hiding (IncipitBase)+ default-language: GHC2021
+ lib/Hix.hs view
@@ -0,0 +1,43 @@+module Hix where++import Control.Monad.Trans.Class (lift)+import Path.IO (getCurrentDir)++import Hix.Data.Error (Error (..), printEnvError, printGhciError, printPreprocError, printFatalError)+import Hix.Env (printEnvRunner)+import Hix.Ghci (printGhciCmdline, printGhcidCmdline)+import Hix.Monad (M, runM)+import qualified Hix.Options as Options+import Hix.Options (+ Command (EnvRunner, GhciCmd, GhcidCmd, Preproc),+ GlobalOptions (GlobalOptions),+ Options (Options),+ parseCli,+ )+import Hix.Preproc (preprocess)++handleError ::+ MonadIO m =>+ GlobalOptions ->+ Error ->+ m ()+handleError GlobalOptions {verbose} = \case+ PreprocError err -> printPreprocError err+ EnvError err -> printEnvError err+ GhciError err -> printGhciError err+ NoMatch msg | fromMaybe False verbose -> printPreprocError msg+ NoMatch _ -> unit+ Fatal err -> printFatalError err++runCommand :: Command -> M ()+runCommand = \case+ Preproc opts -> lift (preprocess opts)+ EnvRunner opts -> printEnvRunner opts.options+ GhcidCmd opts -> printGhcidCmdline opts+ GhciCmd opts -> printGhciCmdline opts++main :: IO ()+main = do+ Options global cmd <- parseCli+ cwd <- getCurrentDir+ leftA (handleError global) =<< runM cwd (runCommand cmd)
+ lib/Hix/Cabal.hs view
@@ -0,0 +1,101 @@+module Hix.Cabal where++import Control.Monad.Trans.Except (ExceptT (ExceptT), throwE)+import Distribution.PackageDescription (BuildInfo (..), GenericPackageDescription (..))+import Distribution.PackageDescription.Parsec (readGenericPackageDescription)+import Distribution.Types.Benchmark (benchmarkBuildInfo)+import Distribution.Types.CondTree (CondTree (..))+import qualified Distribution.Types.Executable as Executable+import Distribution.Types.Library (Library (..))+import Distribution.Types.TestSuite (testBuildInfo)+import Distribution.Utils.Path (getSymbolicPath)+import qualified Distribution.Verbosity as Cabal+import Exon (exon)+import Hix.Data.Error (Error (..), pathText, sourceError)+import Path (+ Abs,+ Dir,+ File,+ Path,+ Rel,+ absdir,+ isProperPrefixOf,+ parent,+ parseRelDir,+ parseRelFile,+ stripProperPrefix,+ toFilePath,+ (</>),+ )+import System.FilePattern.Directory (getDirectoryFiles)+import System.IO.Error (tryIOError)++noMatch :: Text -> Path b File -> ExceptT Error IO a+noMatch reason source =+ throwE (NoMatch (sourceError reason source))++cabalsInDir ::+ Path Abs Dir ->+ ExceptT Error IO [Path Abs File]+cabalsInDir dir = do+ matches <- liftIO (getDirectoryFiles (toFilePath dir) ["*.cabal"])+ let err = PreprocError [exon|Internal error when parsing globbed paths in '#{pathText dir}': #{show matches}|]+ maybe (throwE err) pure (traverse parse matches)+ where+ parse f = do+ rel <- parseRelFile f+ pure (dir </> rel)++findCabal ::+ Path Abs File ->+ ExceptT Error IO (Path Abs File, Path Rel File)+findCabal source =+ spin (parent source)+ where+ spin dir+ | dir == [absdir|/nix/store|] = notFound+ | dir == parent dir = notFound+ | otherwise = tryDir dir+ tryDir dir =+ cabalsInDir dir >>= \case+ [cabal] -> do+ sub <- stripProperPrefix (parent cabal) source+ pure (cabal, sub)+ [] -> spin (parent dir)+ _ -> throwE (PreprocError (sourceError "Multiple cabal files in parent dir of" source))+ notFound =+ noMatch "No cabal file found for " source++parseCabal :: Path Abs File -> ExceptT Error IO GenericPackageDescription+parseCabal path =+ ExceptT $ fmap (first (PreprocError . show)) $ tryIOError do+ readGenericPackageDescription Cabal.verbose (toFilePath path)++buildInfo ::+ (a -> BuildInfo) ->+ (b, CondTree c d a) ->+ BuildInfo+buildInfo f (_, t) =+ f t.condTreeData++matchComponent :: GenericPackageDescription -> Path Rel File -> ExceptT Error IO BuildInfo+matchComponent pkg source =+ maybe (noMatch "cabal component" source) pure (find matchSource infos)+ where+ matchSource BuildInfo {..} =+ any (matchSourceDir . getSymbolicPath) hsSourceDirs+ matchSourceDir dir+ | Just p <- parseRelDir dir, isProperPrefixOf p source = True+ | otherwise = False+ infos =+ ((.condTreeData.libBuildInfo) <$> maybeToList pkg.condLibrary) <>+ (buildInfo libBuildInfo <$> pkg.condSubLibraries) <>+ (buildInfo Executable.buildInfo <$> pkg.condExecutables) <>+ (buildInfo testBuildInfo <$> pkg.condTestSuites) <>+ (buildInfo benchmarkBuildInfo <$> pkg.condBenchmarks)++buildInfoForFile :: Path Abs File -> ExceptT Error IO BuildInfo+buildInfoForFile source = do+ (cabalPath, sourceRel) <- findCabal source+ pkg <- parseCabal cabalPath+ matchComponent pkg sourceRel
+ lib/Hix/Component.hs view
@@ -0,0 +1,115 @@+module Hix.Component where++import Control.Monad.Trans.Reader (ask)+import Data.List.Extra (firstJust)+import qualified Data.Map.Strict as Map+import Data.Map.Strict ((!?))+import qualified Data.Text as Text+import Exon (exon)+import Path (Abs, Dir, File, Path, Rel, SomeBase (Abs, Rel), isProperPrefixOf, stripProperPrefix)++import Hix.Data.Error (pathText)+import qualified Hix.Data.GhciConfig as GhciConfig+import Hix.Data.GhciConfig (+ ComponentConfig,+ PackageConfig (PackageConfig),+ PackageName (PackageName),+ PackagesConfig,+ SourceDir (SourceDir),+ Target (Target),+ )+import qualified Hix.Monad as Monad+import Hix.Monad (Env (Env), M, noteEnv)+import qualified Hix.Options as Options+import Hix.Options (+ ComponentCoords,+ ComponentSpec (ComponentSpec),+ PackageSpec (PackageSpec),+ TargetSpec (TargetForComponent, TargetForFile),+ )++tryPackageByDir ::+ PackagesConfig ->+ Path Rel Dir ->+ Maybe PackageConfig+tryPackageByDir config dir =+ find match (Map.elems config)+ where+ match pkg = pkg.src == dir++packageByDir ::+ PackagesConfig ->+ Path Rel Dir ->+ M PackageConfig+packageByDir config dir =+ noteEnv [exon|No package at this directory: #{pathText dir}|] (tryPackageByDir config dir)++packageForSpec ::+ PackagesConfig ->+ PackageSpec ->+ M PackageConfig+packageForSpec config = \case+ PackageSpec _ (Just (Abs dir)) -> do+ Env {root} <- ask+ rel <- noteEnv [exon|Path is not a subdirectory of the project root: #{pathText dir}|] (stripProperPrefix root dir)+ packageByDir config rel+ PackageSpec (PackageName name) (Just (Rel dir)) | Text.elem '/' name ->+ packageByDir config dir+ PackageSpec name dir ->+ noteEnv [exon|No package matching '##{name}'|] (config !? name <|> (tryDir =<< dir))+ where+ tryDir = \case+ Abs _ -> Nothing+ Rel rd -> tryPackageByDir config rd++matchComponent :: ComponentConfig -> ComponentSpec -> Bool+matchComponent candidate (ComponentSpec name dir) =+ candidate.name == name || any (\ d -> elem @[] d (coerce candidate.sourceDirs)) dir++componentError :: PackageName -> ComponentSpec -> Text+componentError pname spec =+ [exon|No component with name or source dir '##{name}' in the package '##{pname}'|]+ where+ name = spec.name++targetForComponent ::+ PackagesConfig ->+ ComponentCoords ->+ M Target+targetForComponent config spec = do+ package <- packageForSpec config spec.package+ component <- noteEnv (componentError package.name spec.component) (find match (Map.elems package.components))+ pure Target {sourceDir = Nothing, ..}+ where+ match = flip matchComponent spec.component++targetForFile ::+ PackagesConfig ->+ Path Abs File ->+ M Target+targetForFile config file = do+ Env {root} <- ask+ fileRel <- stripProperPrefix root file+ (package, subpath) <- pkgError (firstJust (matchPackage fileRel) (Map.elems config))+ (component, sourceDir) <- compError (firstJust (matchSourceDir subpath) (Map.elems package.components))+ pure Target {..}+ where+ matchPackage fileRel package@PackageConfig {src} = do+ subpath <- stripProperPrefix src fileRel+ pure (package, subpath)+ matchSourceDir subpath component = do+ let match d@(SourceDir dir) = if isProperPrefixOf dir subpath then Just d else Nothing+ dir <- firstJust match (coerce component.sourceDirs)+ pure (component, Just dir)+ pkgError = noteEnv "No package contains this file"+ compError = noteEnv "No component source dir contains this file"++targetComponent ::+ PackagesConfig ->+ TargetSpec ->+ M Target+targetComponent config = \case+ TargetForComponent spec ->+ targetForComponent config spec+ TargetForFile spec ->+ targetForFile config spec
+ lib/Hix/Data/Error.hs view
@@ -0,0 +1,68 @@+module Hix.Data.Error where++import Control.Monad.Trans.Except (ExceptT, throwE)+import qualified Data.Text.IO as Text+import Exon (exon)+import Path (Path, toFilePath)+import System.IO (stderr)+import System.IO.Error (tryIOError)++data Error =+ PreprocError Text+ |+ EnvError Text+ |+ GhciError Text+ |+ NoMatch Text+ |+ Fatal Text+ deriving stock (Eq, Show, Generic)++pathText :: Path b t -> Text+pathText =+ toText . toFilePath++printPreprocError ::+ MonadIO m =>+ Text ->+ m ()+printPreprocError msg =+ liftIO (Text.hPutStrLn stderr [exon|>>> Preprocessor generator failed: #{msg}|])++printEnvError ::+ MonadIO m =>+ Text ->+ m ()+printEnvError msg =+ liftIO (Text.hPutStrLn stderr [exon|>>> Invalid env config: #{msg}|])++printGhciError ::+ MonadIO m =>+ Text ->+ m ()+printGhciError msg =+ liftIO (Text.hPutStrLn stderr [exon|>>> Invalid ghci config: #{msg}|])++printFatalError ::+ MonadIO m =>+ Text ->+ m ()+printFatalError msg =+ liftIO (Text.hPutStrLn stderr [exon|>>> Fatal error: #{msg}|])++sourceError :: Text -> Path b t -> Text+sourceError reason source =+ [exon|#{reason} the source file '#{pathText source}'|]++tryIO ::+ IO a ->+ ExceptT Error IO a+tryIO ma =+ liftIO (tryIOError ma) >>= \case+ Right a -> pure a+ Left err -> throwE (Fatal (show err))++note :: Text -> Maybe a -> ExceptT Error IO a+note err =+ maybe (throwE (GhciError err)) pure
+ lib/Hix/Data/GhciConfig.hs view
@@ -0,0 +1,116 @@+module Hix.Data.GhciConfig where++import Data.Aeson (FromJSON (parseJSON), FromJSONKey)+import GHC.Exts (IsList)+import Path (Abs, Dir, File, Path, Rel)++newtype PackagePath =+ PackagePath { unPackagePath :: Path Rel Dir }+ deriving stock (Eq, Show, Ord, Generic)+ deriving newtype (FromJSON, FromJSONKey)++newtype SourceDir =+ SourceDir { unSourceDir :: Path Rel Dir }+ deriving stock (Eq, Show, Generic)+ deriving newtype (FromJSON)++newtype SourceDirs =+ SourceDirs { unSourceDirs :: [SourceDir] }+ deriving stock (Eq, Show, Generic)++instance FromJSON SourceDirs where+ parseJSON v =+ (SourceDirs <$> parseJSON v)+ <|>+ (SourceDirs . pure <$> parseJSON v)++newtype PackageName =+ PackageName { unPackageName :: Text }+ deriving stock (Eq, Show, Generic)+ deriving newtype (IsString, Ord, FromJSON, FromJSONKey)++newtype ModuleName =+ ModuleName { unModuleName :: Text }+ deriving stock (Eq, Show, Generic)+ deriving newtype (IsString, Ord, FromJSON, FromJSONKey)++newtype ComponentName =+ ComponentName { unComponentName :: Text }+ deriving stock (Eq, Show, Generic)+ deriving newtype (IsString, Ord, FromJSON, FromJSONKey)++newtype EnvName =+ EnvName { unEnvName :: Text }+ deriving stock (Eq, Show, Generic)+ deriving newtype (IsString, Ord, FromJSON, FromJSONKey)++newtype EnvRunner =+ EnvRunner (Path Abs File)+ deriving stock (Eq, Show, Generic)+ deriving newtype (FromJSON)++data ComponentConfig =+ ComponentConfig {+ name :: ComponentName,+ sourceDirs :: SourceDirs,+ runner :: Maybe EnvRunner+ }+ deriving stock (Eq, Show, Generic)+ deriving anyclass (FromJSON)++data PackageConfig =+ PackageConfig {+ name :: PackageName,+ src :: Path Rel Dir,+ components :: Map ComponentName ComponentConfig+ }+ deriving stock (Eq, Show, Generic)+ deriving anyclass (FromJSON)++data Target =+ Target {+ package :: PackageConfig,+ component :: ComponentConfig,+ sourceDir :: Maybe SourceDir+ }+ deriving stock (Eq, Show, Generic)++newtype RunnerName =+ RunnerName { unRunnerName :: Text }+ deriving stock (Eq, Show, Generic)+ deriving newtype (IsString, Ord, FromJSONKey)++newtype GhciSetupCode =+ GhciSetupCode { unGhciSetupCode :: Text }+ deriving stock (Eq, Show, Generic)+ deriving newtype (IsString, Ord, FromJSON, Semigroup, Monoid)++newtype GhciRunExpr =+ GhciRunExpr { unGhciRunExpr :: Text }+ deriving stock (Eq, Show, Generic)+ deriving newtype (IsString, Ord, FromJSON)++newtype GhciArgs =+ GhciArgs { unGhciArgs :: [Text] }+ deriving stock (Eq, Show, Generic)+ deriving newtype (IsList, Ord, FromJSON)++type PackagesConfig = Map PackageName PackageConfig++data EnvConfig =+ EnvConfig {+ packages :: PackagesConfig,+ defaultEnv :: EnvRunner+ }+ deriving stock (Eq, Show, Generic)+ deriving anyclass (FromJSON)++data GhciConfig =+ GhciConfig {+ packages :: PackagesConfig,+ setup :: Map RunnerName GhciSetupCode,+ run :: Map RunnerName GhciRunExpr,+ args :: GhciArgs+ }+ deriving stock (Eq, Show, Generic)+ deriving anyclass (FromJSON)
+ lib/Hix/Data/GhciTest.hs view
@@ -0,0 +1,30 @@+module Hix.Data.GhciTest where++import Path (Abs, Dir, File, Path)++import Hix.Data.GhciConfig (GhciArgs)++data GhciTest =+ GhciTest {+ args :: GhciArgs,+ searchPath :: [Path Abs Dir],+ script :: Text,+ test :: Maybe Text+ }+ deriving stock (Eq, Show, Generic)++data GhciRun =+ GhciRun {+ test :: GhciTest,+ shell :: Text,+ run :: Maybe Text,+ scriptFile :: Path Abs File+ }+ deriving stock (Eq, Show, Generic)++data GhcidRun =+ GhcidRun {+ cmdline :: Text,+ ghci :: GhciRun+ }+ deriving stock (Eq, Show, Generic)
+ lib/Hix/Env.hs view
@@ -0,0 +1,27 @@+module Hix.Env where++import qualified Data.Text.IO as Text++import Hix.Component (targetComponent)+import Hix.Data.Error (pathText)+import qualified Hix.Data.GhciConfig as GhciConfig+import Hix.Data.GhciConfig (EnvRunner (EnvRunner), PackagesConfig, Target (Target))+import Hix.Json (jsonConfig)+import Hix.Monad (M)+import qualified Hix.Options as Options+import Hix.Options (EnvRunnerOptions, TargetSpec)++componentRunner :: PackagesConfig -> TargetSpec -> M (Maybe EnvRunner)+componentRunner config spec = do+ Target {component} <- targetComponent config spec+ pure component.runner++envRunner :: EnvRunnerOptions -> M EnvRunner+envRunner opts = do+ config <- either pure jsonConfig opts.config+ fromMaybe config.defaultEnv . join <$> traverse (componentRunner config.packages) opts.component++printEnvRunner :: EnvRunnerOptions -> M ()+printEnvRunner opts = do+ EnvRunner runner <- envRunner opts+ liftIO (Text.putStrLn (pathText runner))
+ lib/Hix/Ghci.hs view
@@ -0,0 +1,187 @@+module Hix.Ghci where++import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Except (ExceptT)+import Control.Monad.Trans.Reader (ask)+import Data.List.Extra (nubOrd)+import qualified Data.Map.Strict as Map+import Data.Map.Strict ((!?))+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+import Exon (exon)+import Path (Abs, Dir, File, Path, Rel, parseRelDir, reldir, splitExtension, stripProperPrefix, toFilePath, (</>))+import Path.IO (createDirIfMissing, getCurrentDir, getTempDir, openTempFile)+import System.IO (hClose)+import System.Posix.User (getLoginName)++import Hix.Component (targetComponent)+import Hix.Data.Error (Error, note, pathText, tryIO)+import qualified Hix.Data.GhciConfig as GhciConfig+import Hix.Data.GhciConfig (+ ComponentConfig,+ GhciConfig,+ GhciRunExpr (GhciRunExpr),+ GhciSetupCode (GhciSetupCode),+ ModuleName (ModuleName),+ PackageConfig,+ PackageName,+ SourceDir (SourceDir),+ Target (Target),+ )+import qualified Hix.Data.GhciTest as GhciTest+import Hix.Data.GhciTest (GhciRun (GhciRun), GhciTest (GhciTest), GhcidRun (GhcidRun))+import Hix.Json (jsonConfig)+import qualified Hix.Monad as Monad+import Hix.Monad (Env (Env), M, noteGhci, tryIOM)+import qualified Hix.Options as Options+import Hix.Options (+ GhciOptions (GhciOptions),+ TargetSpec (TargetForComponent, TargetForFile),+ TestOptions (TestOptions),+ )++relativeToComponent ::+ PackageConfig ->+ Maybe SourceDir ->+ Path Abs File ->+ M (Path Rel File)+relativeToComponent package mdir path = do+ Env {root} <- ask+ SourceDir dir <- noteGhci "Internal: No source dir for file target" mdir+ noteGhci "Internal: Bad file target" (stripProperPrefix (root </> package.src </> dir) path)++moduleName ::+ PackageConfig ->+ Maybe SourceDir ->+ GhciOptions ->+ M ModuleName+moduleName package component = \case+ GhciOptions {component = TargetForComponent _, test} -> pure test.mod+ GhciOptions {component = TargetForFile path} -> do+ rel <- relativeToComponent package component path+ pure (ModuleName (Text.replace "/" "." (withoutExt rel)))+ where+ withoutExt p = pathText (maybe p fst (splitExtension p))++ghciScript ::+ GhciConfig ->+ PackageConfig ->+ Maybe SourceDir ->+ GhciOptions ->+ M Text+ghciScript config package component opt = do+ ModuleName module_ <- moduleName package component opt+ pure [exon|#{setup}+:load #{module_}+import #{module_}|]+ where+ GhciSetupCode setup = fold (flip Map.lookup config.setup =<< opt.test.runner)++componentSearchPaths :: PackageConfig -> ComponentConfig -> [Path Rel Dir]+componentSearchPaths pkg comp = do+ SourceDir dir <- coerce comp.sourceDirs+ pure (pkg.src </> dir)++librarySearchPaths :: Map PackageName PackageConfig -> [Path Rel Dir]+librarySearchPaths pkgs = do+ pkg <- Map.elems pkgs+ comp <- maybeToList (pkg.components !? "library")+ componentSearchPaths pkg comp++searchPath :: Map PackageName PackageConfig -> PackageConfig -> ComponentConfig -> [Path Rel Dir]+searchPath pkgs pkg comp =+ nubOrd (componentSearchPaths pkg comp <> librarySearchPaths pkgs)++testRun :: GhciConfig -> TestOptions -> Maybe Text+testRun config = \case+ TestOptions {test, runner = Just runner} | Just (GhciRunExpr run) <- config.run !? runner ->+ Just [exon|(#{run}) #{fold test}|]+ TestOptions {test = Just test} ->+ Just test+ TestOptions {test = Nothing} ->+ Nothing++assemble :: GhciOptions -> M GhciTest+assemble opt = do+ config <- either pure jsonConfig opt.config+ cwd <- tryIOM getCurrentDir+ Target {..} <- targetComponent config.packages opt.component+ script <- ghciScript config package sourceDir opt+ pure GhciTest {+ script,+ test = testRun config opt.test,+ args = config.args,+ searchPath = (cwd </>) <$> searchPath config.packages package component+ }++hixTempDir ::+ ExceptT Error IO (Path Abs Dir)+hixTempDir = do+ tmp <- tryIO getTempDir+ user <- note "Couldn't determine user name" . parseRelDir =<< tryIO getLoginName+ let hixTmp = tmp </> [reldir|hix|] </> user+ tryIO (createDirIfMissing True hixTmp)+ pure hixTmp++ghciScriptFile ::+ Path Abs Dir ->+ Text ->+ ExceptT Error IO (Path Abs File)+ghciScriptFile tmp text =+ tryIO do+ (path, handle) <- openTempFile tmp "hix-ghci-.ghci"+ Text.hPutStr handle text+ hClose handle+ pure path++searchPathArg :: NonEmpty (Path Abs Dir) -> Text+searchPathArg paths =+ [exon|-i#{colonSeparated}|]+ where+ colonSeparated = Text.intercalate ":" (pathText <$> toList paths)++ghciCmdline ::+ GhciTest ->+ Path Abs File ->+ Maybe (Path Abs File) ->+ GhciRun+ghciCmdline test scriptFile runScriptFile =+ GhciRun {..}+ where+ shell = [exon|##{Text.unwords (coerce test.args)} #{sp} -ghci-script=##{toFilePath scriptFile}|]+ run = runScriptFile <&> \ f -> [exon|-ghci-script=##{toFilePath f}|]+ sp = foldMap searchPathArg (nonEmpty test.searchPath)++ghciCmdlineFromOptions ::+ Path Abs Dir ->+ GhciOptions ->+ M GhciRun+ghciCmdlineFromOptions tmp opt = do+ conf <- assemble opt+ shellScriptFile <- lift (ghciScriptFile tmp conf.script)+ runScriptFile <- lift (traverse (ghciScriptFile tmp) conf.test)+ pure (ghciCmdline conf shellScriptFile runScriptFile)++ghcidCmdlineFromOptions ::+ Path Abs Dir ->+ GhciOptions ->+ M GhcidRun+ghcidCmdlineFromOptions tmp opt = do+ ghci <- ghciCmdlineFromOptions tmp opt+ pure (GhcidRun [exon|ghcid --command="ghci #{ghci.shell}" --test='##{fromMaybe "main" ghci.test.test}'|] ghci)++printGhciCmdline ::+ GhciOptions ->+ M ()+printGhciCmdline opt = do+ tmp <- lift hixTempDir+ cmd <- ghciCmdlineFromOptions tmp opt+ liftIO (Text.putStrLn [exon|ghci #{cmd.shell} #{fold cmd.run}|])++printGhcidCmdline ::+ GhciOptions ->+ M ()+printGhcidCmdline opt = do+ tmp <- lift hixTempDir+ cmd <- ghcidCmdlineFromOptions tmp opt+ liftIO (Text.putStrLn cmd.cmdline)
+ lib/Hix/Json.hs view
@@ -0,0 +1,25 @@+module Hix.Json where++import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Except (throwE)+import qualified Data.Aeson as Aeson+import Data.Aeson (FromJSON, fromJSON)+import Exon (exon)++import Hix.Data.Error (Error (GhciError))+import Hix.Monad (M)+import Hix.Optparse (JsonConfig (JsonConfig))++jsonConfig ::+ FromJSON a =>+ JsonConfig ->+ M a+jsonConfig (JsonConfig mv) =+ liftIO mv >>= \case+ Left msg -> failure [exon|Invalid JSON: #{toText msg}|]+ Right v -> case fromJSON v of+ Aeson.Success a -> pure a+ Aeson.Error err -> failure [exon|Invalid JSON: #{toText err}+#{show v}|]+ where+ failure = lift . throwE . GhciError
+ lib/Hix/Monad.hs view
@@ -0,0 +1,34 @@+module Hix.Monad where++import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)+import Control.Monad.Trans.Reader (ReaderT (runReaderT))+import Path (Abs, Dir, Path)++import Hix.Data.Error (Error (GhciError), tryIO)++data Env =+ Env {+ root :: Path Abs Dir+ }+ deriving stock (Eq, Show, Generic)++type M a = ReaderT Env (ExceptT Error IO) a++noteEnv :: Text -> Maybe a -> M a+noteEnv err =+ maybe (lift (throwE (GhciError err))) pure++noteGhci :: Text -> Maybe a -> M a+noteGhci err =+ maybe (lift (throwE (GhciError err))) pure++runM :: Path Abs Dir -> M a -> IO (Either Error a)+runM root ma =+ runExceptT (runReaderT ma (Env root))++tryIOM ::+ IO a ->+ M a+tryIOM ma =+ lift (tryIO ma)
+ lib/Hix/Options.hs view
@@ -0,0 +1,260 @@+module Hix.Options where++import Options.Applicative (+ CommandFields,+ Mod,+ Parser,+ bashCompleter,+ command,+ completer,+ customExecParser,+ fullDesc,+ header,+ help,+ helper,+ hsubparser,+ info,+ long,+ option,+ prefs,+ progDesc,+ short,+ showHelpOnEmpty,+ showHelpOnError,+ strOption,+ switch,+ value,+ )+import Path (Abs, Dir, File, Path, SomeBase, parseRelDir, parseSomeDir)+import Prelude hiding (Mod, mod)++import Hix.Data.GhciConfig (+ ComponentName (ComponentName),+ EnvConfig,+ EnvName,+ GhciConfig,+ ModuleName,+ PackageName (PackageName),+ RunnerName,+ SourceDir (SourceDir),+ )+import Hix.Optparse (JsonConfig, absFileOption, jsonOption)++data PreprocOptions =+ PreprocOptions {+ source :: Path Abs File,+ inFile :: Path Abs File,+ outFile :: Path Abs File+ }+ deriving stock (Eq, Show, Generic)++data PackageSpec =+ PackageSpec {+ name :: PackageName,+ dir :: Maybe (SomeBase Dir)+ }+ deriving stock (Eq, Show, Generic)++data ComponentSpec =+ ComponentSpec {+ name :: ComponentName,+ dir :: Maybe SourceDir+ }+ deriving stock (Eq, Show, Generic)++data ComponentCoords =+ ComponentCoords {+ package :: PackageSpec,+ component :: ComponentSpec+ }+ deriving stock (Eq, Show, Generic)++data TargetSpec =+ TargetForFile (Path Abs File)+ |+ TargetForComponent ComponentCoords+ deriving stock (Eq, Show, Generic)++data TestOptions =+ TestOptions {+ mod :: ModuleName,+ test :: Maybe Text,+ runner :: Maybe RunnerName+ }+ deriving stock (Eq, Show, Generic)++data EnvRunnerOptions =+ EnvRunnerOptions {+ config :: Either EnvConfig JsonConfig,+ component :: Maybe TargetSpec+ }+ deriving stock (Show, Generic)++data GhciOptions =+ GhciOptions {+ config :: Either GhciConfig JsonConfig,+ component :: TargetSpec,+ test :: TestOptions+ }+ deriving stock (Show, Generic)++data EnvRunnerCommandOptions =+ EnvRunnerCommandOptions {+ options :: EnvRunnerOptions,+ test :: TestOptions+ }+ deriving stock (Show, Generic)++data Command =+ Preproc PreprocOptions+ |+ EnvRunner EnvRunnerCommandOptions+ |+ GhcidCmd GhciOptions+ |+ GhciCmd GhciOptions+ deriving stock (Show)++data GlobalOptions =+ GlobalOptions {+ verbose :: Maybe Bool+ }+ deriving stock (Eq, Show, Generic)+ deriving anyclass (Default)++data Options =+ Options {+ global :: GlobalOptions,+ cmd :: Command+ }+ deriving stock (Show)++fileParser ::+ String ->+ String ->+ Parser (Path Abs File)+fileParser longName helpText =+ option absFileOption (long longName <> completer (bashCompleter "file") <> help helpText)++preprocParser :: Parser PreprocOptions+preprocParser =+ PreprocOptions+ <$>+ fileParser "source" "The original source file"+ <*>+ fileParser "in" "The prepared input file"+ <*>+ fileParser "out" "The path to the output file"++packageSpecParser :: Parser PackageSpec+packageSpecParser = do+ name <- strOption (long "package" <> short 'p' <> help "The name or directory of the test package")+ pure PackageSpec {name = PackageName name, dir = parseSomeDir (toString name)}++componentSpecParser :: Parser ComponentSpec+componentSpecParser = do+ name <- strOption (long "component" <> short 'c' <> help h <> value "test")+ pure ComponentSpec {name = ComponentName name, dir = SourceDir <$> parseRelDir (toString name)}+ where+ h = "The name or relative directory of the test component"++componentForModuleParser :: Parser ComponentCoords+componentForModuleParser =+ ComponentCoords+ <$>+ packageSpecParser+ <*>+ componentSpecParser++componentForFileParser :: Parser TargetSpec+componentForFileParser =+ TargetForFile+ <$>+ option absFileOption (long "file" <> short 'f' <> help "The absolute file path of the test module")++targetSpecParser :: Parser TargetSpec+targetSpecParser =+ TargetForComponent <$> componentForModuleParser+ <|>+ componentForFileParser++envNameParser :: Parser EnvName+envNameParser =+ strOption (long "env" <> short 'e' <> help "The name of the environment")++testParser :: Parser (Maybe Text)+testParser =+ optional (strOption (long "test" <> short 't' <> help "The Haskell function that should be executed"))++runnerParser :: Parser (Maybe RunnerName)+runnerParser =+ optional (strOption (+ long "run"+ <>+ short 'r'+ <>+ help "The name of the command defined in the Hix option 'ghci.run'"+ ))++moduleParser :: Parser ModuleName+moduleParser =+ strOption (long "module" <> short 'm' <> help "The module containing the test function" <> value "Main")++jsonConfigParser ::+ Parser JsonConfig+jsonConfigParser =+ option jsonOption (long "config" <> short 'c' <> help "The Hix-generated config, file or text")++testOptionsParser :: Parser TestOptions+testOptionsParser = do+ test <- testParser+ runner <- runnerParser+ mod <- moduleParser+ pure TestOptions {..}++envParser :: Parser EnvRunnerCommandOptions+envParser = do+ options <- do+ config <- Right <$> jsonConfigParser+ component <- optional targetSpecParser+ pure EnvRunnerOptions {..}+ test <- testOptionsParser+ pure EnvRunnerCommandOptions {..}++ghciParser :: Parser GhciOptions+ghciParser = do+ config <- Right <$> jsonConfigParser+ component <- targetSpecParser+ test <- testOptionsParser+ pure GhciOptions {..}++commands ::+ Mod CommandFields Command+commands =+ command "preproc" (Preproc <$> info preprocParser (progDesc "Preprocess a source file for use with ghcid"))+ <>+ command "env" (EnvRunner <$> info envParser (progDesc "Print the env runner for a component or a named env"))+ <>+ command "ghci-cmd" (GhciCmd <$> info ghciParser (progDesc "Print a ghci cmdline to load a module in a Hix env"))+ <>+ command "ghcid-cmd" (GhcidCmd <$> info ghciParser (progDesc "Print a ghcid cmdline to run a function in a Hix env"))++globalParser :: Parser GlobalOptions+globalParser = do+ verbose <- optional (switch (long "verbose" <> short 'v' <> help "Verbose output"))+ pure GlobalOptions {..}++appParser ::+ Parser Options+appParser =+ Options <$> globalParser <*> hsubparser commands++parseCli ::+ IO Options+parseCli = do+ customExecParser parserPrefs (info (appParser <**> helper) desc)+ where+ parserPrefs =+ prefs (showHelpOnEmpty <> showHelpOnError)+ desc =+ fullDesc <> header "Tools for maintaining Hix projects"
+ lib/Hix/Optparse.hs view
@@ -0,0 +1,42 @@+-- |Combinators for @optparse-applicative@.+module Hix.Optparse where++import Data.Aeson (Value, eitherDecodeFileStrict', eitherDecodeStrict')+import Exon (exon)+import Options.Applicative (ReadM, readerError)+import Options.Applicative.Types (readerAsk)+import Path (Abs, Dir, File, Path, Rel, parseAbsFile, parseRelDir, parseRelFile, toFilePath)+import qualified Text.Show as Show++-- |An absolute file path option for @optparse-applicative@.+absFileOption :: ReadM (Path Abs File)+absFileOption = do+ raw <- readerAsk+ leftA (const (readerError [exon|not a valid absolute file path: #{raw}|])) (parseAbsFile raw)++-- |A relative file path option for @optparse-applicative@.+relFileOption :: ReadM (Path Rel File)+relFileOption = do+ raw <- readerAsk+ leftA (const (readerError [exon|not a valid relative file path: #{raw}|])) (parseRelFile raw)++-- |A relative dir path option for @optparse-applicative@.+relDirOption :: ReadM (Path Rel Dir)+relDirOption = do+ raw <- readerAsk+ leftA (const (readerError [exon|not a valid relative dir path: #{raw}|])) (parseRelDir raw)++newtype JsonConfig =+ JsonConfig { unJsonConfig :: IO (Either String Value) }+ deriving stock (Generic)++instance Show JsonConfig where+ show (JsonConfig _) = "JsonConfig"++jsonOption ::+ ReadM JsonConfig+jsonOption = do+ raw <- readerAsk+ pure $ JsonConfig $ case parseAbsFile raw of+ Just f -> eitherDecodeFileStrict' (toFilePath f)+ Nothing -> pure (eitherDecodeStrict' (encodeUtf8 raw))
+ lib/Hix/Preproc.hs view
@@ -0,0 +1,463 @@+module Hix.Preproc where++import Control.Lens (IndexedTraversal', has, index, ix, preview, (%~), (.~), (^..))+import Control.Lens.Regex.ByteString (Match, group, groups, match, regex)+import Control.Monad.Trans.Except (ExceptT, throwE)+import qualified Data.ByteString as ByteString+import Data.ByteString (elemIndex)+import qualified Data.ByteString.Builder as ByteStringBuilder+import Data.ByteString.Builder (Builder, byteString, charUtf8, stringUtf8)+import Data.Generics.Labels ()+import Data.List.Extra (firstJust)+import qualified Distribution.ModuleName as ModuleName+import Distribution.ModuleName (ModuleName)+import Distribution.PackageDescription (BuildInfo (..), ModuleRenaming (..), unPackageName)+import Distribution.Simple (PerCompilerFlavor (PerCompilerFlavor))+import Distribution.Types.IncludeRenaming (IncludeRenaming (..))+import Distribution.Types.Mixin (Mixin (..))+import qualified Exon+import Exon (exon)+import Language.Haskell.Extension (+ Extension (DisableExtension, EnableExtension, UnknownExtension),+ Language (UnknownLanguage),+ )+import Path (Abs, File, Path, toFilePath)+import Prelude hiding (group)+import System.Random (randomRIO)++import Hix.Cabal (buildInfoForFile)+import Hix.Data.Error (Error (..), sourceError, tryIO)+import Hix.Options (PreprocOptions (..))++type Regex = IndexedTraversal' Int ByteString Match++data Prelude =+ Prelude {+ preludePackage :: ByteString,+ preludeModule :: ByteString+ }+ deriving stock (Show)++newtype DummyExportName =+ DummyExportName { unDummyExportName :: ByteString }+ deriving stock (Eq, Show, Generic)+ deriving newtype (IsString, Ord)++noMatch :: Text -> Path b File -> ExceptT Error IO a+noMatch reason source =+ throwE (NoMatch (sourceError reason source))++takeLine :: ByteString -> Maybe (ByteString, ByteString)+takeLine bs =+ elemIndex 10 bs <&> \ i ->+ let (xs, ys) = ByteString.splitAt i bs+ in (xs, ByteString.tail ys)++nl :: Builder+nl = charUtf8 '\n'++lineB :: Builder -> Builder+lineB bs =+ bs <> nl++line :: ByteString -> Builder+line bs =+ lineB (byteString bs)++joinLinesReverse :: [ByteString] -> ByteString+joinLinesReverse =+ foldr joinLine mempty+ where+ joinLine a b = b <> a <> "\n"++joinLinesReverseBuilder :: [ByteString] -> Builder+joinLinesReverseBuilder =+ foldr joinLine mempty+ where+ joinLine a b = b <> line a++extension :: Extension -> Maybe Builder+extension = \case+ EnableExtension ext -> Just (show ext)+ DisableExtension ext -> Just ("No" <> show ext)+ UnknownExtension _ -> Nothing++languagePragma :: [Builder] -> Builder+languagePragma exts =+ [exon|{-# language #{Exon.intercalate ", " exts} #-}|]++extensionsPragma :: BuildInfo -> Maybe Builder+extensionsPragma info+ | null exts = Nothing+ | otherwise = Just (languagePragma exts)+ where+ exts = maybeToList (dlExtension =<< info.defaultLanguage) ++ mapMaybe extension info.defaultExtensions+ dlExtension = \case+ UnknownLanguage _ -> Nothing+ lang -> Just (stringUtf8 (show lang))++optionsPragma :: Builder -> Builder+optionsPragma opts =+ lineB [exon|{-# options_ghc #{opts} #-}|]++noImplicitPreludeRegex :: Regex+noImplicitPreludeRegex =+ [regex|\bNoImplicitPrelude\b|]++commentRegex :: Regex+commentRegex =+ [regex|^\s*--|]++moduleRegex :: Regex+moduleRegex =+ [regex|^\s*module\b\s+(\S+)|]++moduleEndRegex :: Regex+moduleEndRegex =+ [regex|\bwhere\b|]++importsEndRegex :: Regex+importsEndRegex =+ [regex|^\S|]++importRegex :: Regex+importRegex =+ [regex|^import\b|]++containsNoImplicitPrelude :: ByteString -> Bool+containsNoImplicitPrelude =+ has noImplicitPreludeRegex++isComment :: ByteString -> Bool+isComment =+ has commentRegex++isModule :: ByteString -> Maybe ByteString+isModule =+ preview (moduleRegex . group 0)++isModuleEnd :: ByteString -> Bool+isModuleEnd =+ has moduleEndRegex++isImportsEnd :: ByteString -> Bool+isImportsEnd =+ has importsEndRegex++isImport :: ByteString -> Bool+isImport =+ has importRegex++data Phase =+ PreModule+ |+ ModuleStart+ |+ ModuleExports+ |+ Imports+ deriving stock (Eq, Show, Generic)++data PreludeAction =+ PreludeDefault+ |+ PreludeNoImplicit+ |+ PreludeReplaced+ deriving stock (Eq, Show, Generic)++data CustomPrelude =+ CustomPrelude Prelude PreludeAction+ |+ NoCustomPrelude+ deriving stock (Show, Generic)++notPre :: Phase -> Bool+notPre = \case+ PreModule -> False+ _ -> True++pattern NotPre :: Phase+pattern NotPre <- (notPre -> True)++inModule :: Phase -> Bool+inModule = \case+ ModuleStart -> True+ ModuleExports -> True+ _ -> False++pattern InModule :: Phase+pattern InModule <- (inModule -> True)++preludeRegex :: Regex+preludeRegex =+ [regex|^import\s*((?:"[^"]+" )?\s*)(?:qualified )?\s*(Prelude)|]++replacePrelude :: ByteString -> Prelude -> Maybe ByteString+replacePrelude l Prelude {..}+ | has preludeRegex l =+ Just (l & preludeRegex . groups %~ insertPrelude)+ | otherwise =+ Nothing+ where+ insertPrelude =+ (ix 0 .~ [exon|"#{preludePackage}" |])+ .+ (ix 1 .~ preludeModule)++parenRegex :: Regex+parenRegex =+ [regex|(\()|]++dummyExportPlaceholder :: ByteString+dummyExportPlaceholder =+ "HIX_DUMMY_EXPORT>"++dummyExportPlaceholderRegex :: Regex+dummyExportPlaceholderRegex =+ [regex|HIX_DUMMY_EXPORT>|]++insertExport ::+ ByteString ->+ ByteString+insertExport =+ parenRegex . index 0 . match .~ ("(" <> dummyExportPlaceholder)++moduleExportsRegex :: Regex+moduleExportsRegex =+ [regex|\bmodule ([\w.]+)\s*($|,|--|\))|]++moduleExports ::+ ByteString ->+ [ByteString]+moduleExports l =+ l ^.. moduleExportsRegex . group 0++data Header =+ Header {+ moduleLines :: [ByteString],+ importLines :: [ByteString],+ rest :: Builder,+ moduleEndLine :: Int,+ importsEndLine :: Int,+ prelude :: CustomPrelude,+ exportsSelf :: Bool+ }+ deriving stock (Show, Generic)++data ScanState =+ ScanState {+ phase :: Phase,+ moduleLines :: [ByteString],+ importLines :: [ByteString],+ moduleLength :: Int,+ importsLength :: Int,+ prelude :: CustomPrelude,+ moduleName :: Maybe ByteString,+ exportsSelf :: Bool+ }+ deriving stock (Show, Generic)++scanHeader ::+ Maybe Prelude ->+ ByteString ->+ Header+scanHeader customPrelude =+ tryProcessLine ScanState {+ phase = PreModule,+ moduleLines = mempty,+ importLines = mempty,+ moduleLength = 1,+ importsLength = 0,+ prelude = initPrelude,+ moduleName = Nothing,+ exportsSelf = False+ }+ where+ initPrelude = case customPrelude of+ Just p -> CustomPrelude p PreludeDefault+ Nothing -> NoCustomPrelude++ tryProcessLine s input =+ case takeLine input of+ Just (nextLine, inputRest) ->+ processLine s nextLine inputRest+ Nothing ->+ finish s mempty++ processLine s l ls | isComment l || ByteString.isPrefixOf "#" l =+ pushCurrent s l ls+ processLine ScanState {phase = PreModule, prelude = CustomPrelude p PreludeDefault, ..} l ls | containsNoImplicitPrelude l =+ pushModule ScanState {phase = PreModule, prelude = CustomPrelude p PreludeNoImplicit, ..} l ls+ processLine s@ScanState {phase = PreModule} l ls | Just name <- isModule l =+ changePhase (s & #moduleName .~ Just name) ModuleStart l ls+ processLine s@ScanState {phase = ModuleStart} l ls | has parenRegex l =+ changePhase s ModuleExports (insertExport l) ls+ processLine s@ScanState {phase = ModuleExports, moduleName = Just name, exportsSelf = False} l ls+ | exs <- moduleExports l+ , elem name exs =+ processLine (s & #exportsSelf .~ True) l ls+ processLine ScanState {phase = InModule, ..} l ls | isModuleEnd l =+ pushModule ScanState {phase = Imports, ..} l ls+ processLine s@ScanState {phase = InModule} l ls | isImport l =+ changePhase s Imports l ls+ processLine ScanState {phase = Imports, prelude = CustomPrelude p action, ..} l ls | isImport l =+ let+ (replaced, newAction) =+ case replacePrelude l p of+ Just new -> (new, PreludeReplaced)+ Nothing -> (l, action)+ in pushImport ScanState {phase = Imports, prelude = CustomPrelude p newAction, ..} replaced ls+ processLine s@ScanState {phase = Imports} l ls | isImportsEnd l =+ finish s (line l <> byteString ls)+ processLine s l ls =+ pushCurrent s l ls++ changePhase s phase = processLine s {phase}++ pushCurrent s@ScanState {phase}+ | Imports <- phase = pushImport s+ | otherwise = pushModule s++ pushModule ScanState {..} l =+ tryProcessLine ScanState {+ moduleLines = l : moduleLines,+ moduleLength = moduleLength + 1,+ ..+ }++ pushImport ScanState {..} l =+ tryProcessLine ScanState {importLines = l : importLines, importsLength = importsLength + 1, ..}++ finish ScanState {..} rest =+ Header {+ moduleEndLine = moduleLength,+ importsEndLine = moduleLength + importsLength,+ ..+ }++preludeRenaming :: [(b, ModuleName)] -> Maybe b+preludeRenaming =+ firstJust \case+ (real, "Prelude") -> Just real+ _ -> Nothing++pattern PreludeRenaming :: ModuleName -> ModuleRenaming+pattern PreludeRenaming p <- ModuleRenaming (preludeRenaming -> Just p)++pattern PreludeInclude :: ModuleName -> IncludeRenaming+pattern PreludeInclude p <- IncludeRenaming {includeProvidesRn = PreludeRenaming p}++findPrelude :: [Mixin] -> Maybe Prelude+findPrelude =+ firstJust \case+ Mixin {mixinIncludeRenaming = PreludeInclude real, ..} ->+ let+ preludePackage = encodeUtf8 (unPackageName mixinPackageName)+ preludeModule = Exon.intercalate "." (encodeUtf8 <$> ModuleName.components real)+ in Just Prelude {..}+ _ -> Nothing++customPreludeImport :: Prelude -> Builder+customPreludeImport Prelude {..} =+ lineB [exon|import "#{byteString preludePackage}" #{byteString preludeModule} as Prelude|]++needPreludeExtensions :: PreludeAction -> Bool+needPreludeExtensions = \case+ PreludeDefault -> True+ PreludeNoImplicit -> False+ PreludeReplaced -> True++pattern NeedPreludeExtensions :: PreludeAction+pattern NeedPreludeExtensions <- (needPreludeExtensions -> True)++needDummy :: CustomPrelude -> Bool+needDummy = \case+ NoCustomPrelude -> False+ CustomPrelude _ action -> needPreludeExtensions action++pattern NeedDummy :: CustomPrelude+pattern NeedDummy <- (needDummy -> True)++preludeExtensions :: CustomPrelude -> Builder+preludeExtensions = \case+ CustomPrelude _ NeedPreludeExtensions ->+ lineB (languagePragma ["PackageImports", "NoImplicitPrelude"])+ _ ->+ mempty++explicitPreludeImport ::+ Builder ->+ CustomPrelude ->+ Builder+explicitPreludeImport lineNo = \case+ CustomPrelude prelude PreludeDefault -> customPreludeImport prelude <> lineNo+ _ -> mempty++dummyDecl ::+ CustomPrelude ->+ Builder ->+ DummyExportName ->+ Builder+dummyDecl NeedDummy lineNo (DummyExportName n) =+ lineB [exon|type #{byteString n} = Int|] <> lineNo+dummyDecl _ _ _ =+ mempty++replaceDummy ::+ CustomPrelude ->+ Bool ->+ DummyExportName ->+ ByteString ->+ ByteString+replaceDummy NeedDummy False (DummyExportName n) =+ dummyExportPlaceholderRegex . index 0 . match .~ [exon|#{n},|]+replaceDummy _ _ _ =+ dummyExportPlaceholderRegex . index 0 . match .~ ""++assemble ::+ Path Abs File ->+ Header ->+ Maybe Builder ->+ Maybe Builder ->+ DummyExportName ->+ Builder+assemble source Header {..} exts options dummyExportName =+ foldMap optionsPragma options <>+ foldMap lineB exts <>+ preludeExtensions prelude <>+ linePragma 1 <>+ byteString (replaceDummy prelude exportsSelf dummyExportName moduleString) <>+ explicitPreludeImport (linePragma moduleEndLine) prelude <>+ importsString <>+ dummyDecl prelude (linePragma importsEndLine) dummyExportName <>+ rest+ where+ linePragma n =+ lineB [exon|{-# line #{show n} "#{stringUtf8 (toFilePath source)}" #-}|]+ moduleString = joinLinesReverse moduleLines+ importsString = joinLinesReverseBuilder importLines++preprocessModule ::+ Path Abs File ->+ BuildInfo ->+ DummyExportName ->+ ByteString ->+ Builder+preprocessModule source info dummyExportName inLines =+ assemble source header (extensionsPragma info) options dummyExportName+ where+ options = Exon.intercalate " " <$> nonEmpty (stringUtf8 <$> ghcOptions)+ PerCompilerFlavor ghcOptions _ = info.options+ customPrelude = findPrelude info.mixins+ header = scanHeader customPrelude inLines++-- TODO add common stanzas+preprocess :: PreprocOptions -> ExceptT Error IO ()+preprocess PreprocOptions {..} = do+ info <- buildInfoForFile source+ inLines <- tryIO (ByteString.readFile (toFilePath inFile))+ dummyNumber :: Int <- randomRIO (10000, 10000000)+ let dummyExportName = DummyExportName [exon|Hix_Dummy_#{show dummyNumber}|]+ let result = preprocessModule source info dummyExportName inLines+ tryIO (ByteStringBuilder.writeFile (toFilePath outFile) result)
+ test/Hix/Test/CabalFile.hs view
@@ -0,0 +1,73 @@+module Hix.Test.CabalFile where++import Distribution.Fields.ParseResult (parseString)+import Distribution.PackageDescription (GenericPackageDescription)+import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)+import Distribution.Verbosity (silent)+import Exon (exon)++testCabal :: ByteString+testCabal =+ [exon|cabal-version: 2.2+name: hix+version: 0.1.0.0+common stuff+ default-extensions:+ ScopedTypeVariables+library+ exposed-modules:+ Hix+ hs-source-dirs:+ lib+ default-extensions:+ AllowAmbiguousTypes+ NoApplicativeDo+ ghc-options: -Wall -Wunused-imports+ build-depends:+ Cabal+ , base >=4.12 && <5+ mixins:+ base hiding (Prelude)+ , incipit-base (IncipitBase as Prelude)+ , incipit-base hiding (IncipitBase)+ default-language: Haskell2010+test-suite hix-unit+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs:+ test+ build-depends:+ base >=4.12 && <5+ default-language: Haskell2010+|]++testPackage :: IO (GenericPackageDescription)+testPackage =+ parseString parseGenericPackageDescription silent "hix" testCabal++testCabalNoPrelude :: ByteString+testCabalNoPrelude =+ [exon|cabal-version: 2.2+name: hix+version: 0.1.0.0+common stuff+ default-extensions:+ ScopedTypeVariables+library+ exposed-modules:+ Hix+ hs-source-dirs:+ lib+ default-extensions:+ AllowAmbiguousTypes+ NoApplicativeDo+ ghc-options: -Wall -Wunused-imports+ build-depends:+ Cabal+ , base >=4.12 && <5+ default-language: Haskell2010+|]++testPackageNoPrelude :: IO (GenericPackageDescription)+testPackageNoPrelude =+ parseString parseGenericPackageDescription silent "hix" testCabalNoPrelude
+ test/Hix/Test/CabalTest.hs view
@@ -0,0 +1,32 @@+module Hix.Test.CabalTest where++import Control.Monad.Trans.Except (runExceptT)+import qualified Data.ByteString as ByteString+import Distribution.PackageDescription (+ BuildInfo (defaultExtensions),+ CondTree (condTreeData),+ GenericPackageDescription (condLibrary),+ Library (libBuildInfo),+ )+import Hedgehog (TestT, (===))+import Hix.Cabal (parseCabal)+import Language.Haskell.Extension (+ Extension (DisableExtension, EnableExtension),+ KnownExtension (AllowAmbiguousTypes, ApplicativeDo),+ )+import Path (relfile, toFilePath, (</>))+import Path.IO (withSystemTempDir)++import Hix.Test.CabalFile (testCabal)++target :: [Extension]+target =+ [EnableExtension AllowAmbiguousTypes, DisableExtension ApplicativeDo]++test_cabal :: TestT IO ()+test_cabal = do+ Right pkg <- liftIO $ withSystemTempDir "hix-unit" \ tmp -> do+ let cabalFile = tmp </> [relfile|test.cabal|]+ ByteString.writeFile (toFilePath cabalFile) testCabal+ runExceptT (parseCabal cabalFile)+ Just target === (pkg.condLibrary <&> \ l -> l.condTreeData.libBuildInfo.defaultExtensions)
+ test/Hix/Test/GhciTest.hs view
@@ -0,0 +1,164 @@+module Hix.Test.GhciTest where++import Control.Monad.Trans.Class (lift)+import Exon (exon)+import Hedgehog (TestT, evalEither, (===))+import Path (Abs, Dir, File, Path, Rel, SomeBase (Rel), absdir, absfile, reldir, relfile, (</>))+import Path.IO (getCurrentDir, withSystemTempDir)++import Hix.Data.Error (pathText)+import Hix.Data.GhciConfig (+ ComponentConfig (..),+ ComponentName,+ EnvConfig (EnvConfig),+ EnvRunner (EnvRunner),+ GhciConfig (..),+ PackageConfig (..),+ PackagesConfig,+ SourceDir (SourceDir),+ SourceDirs (SourceDirs),+ )+import qualified Hix.Data.GhciTest as GhciTest+import Hix.Env (envRunner)+import Hix.Ghci (assemble, ghcidCmdlineFromOptions)+import Hix.Monad (runM)+import qualified Hix.Options as Options+import Hix.Options (+ ComponentCoords (ComponentCoords),+ ComponentSpec (ComponentSpec),+ EnvRunnerOptions (EnvRunnerOptions),+ GhciOptions (GhciOptions, component),+ PackageSpec (PackageSpec),+ TargetSpec (TargetForComponent, TargetForFile),+ TestOptions (TestOptions),+ )++root :: Path Abs Dir+root =+ [absdir|/project|]++runner1 :: EnvRunner+runner1 =+ EnvRunner [absfile|/runner1.bash|]++runner2 :: EnvRunner+runner2 =+ EnvRunner [absfile|/runner2.bash|]++defaultRunner :: EnvRunner+defaultRunner =+ EnvRunner [absfile|/default|]++component :: ComponentName -> Path Rel Dir -> EnvRunner -> ComponentConfig+component name dir runner =+ ComponentConfig {+ name,+ sourceDirs = SourceDirs [SourceDir dir],+ runner = Just runner+ }++packages :: PackagesConfig+packages =+ [+ ("api", PackageConfig {+ name = "api",+ src = [reldir|packages/api|],+ components = [+ ("library", component "api" [reldir|lib|] runner1),+ ("server", component "server" [reldir|app|] runner1),+ ("api-test", component "api-test" [reldir|test|] runner1)+ ]+ }),+ ("core", PackageConfig {+ name = "core",+ src = [reldir|packages/core|],+ components = [+ ("library", component "core" [reldir|lib|] runner1),+ ("core-test", component "core-test" [reldir|test|] runner2)+ ]+ })+ ]++spec1 :: TargetSpec+spec1 =+ TargetForComponent ComponentCoords {+ package = PackageSpec "api" (Just (Rel [reldir|api|])),+ component = ComponentSpec "test" (Just (SourceDir [reldir|test|]))+ }++options :: GhciOptions+options =+ GhciOptions {+ config = Left GhciConfig {+ packages,+ setup = [("generic", "import Test.Tasty")],+ run = [("generic", ("check . property . test"))],+ args = ["-Werror"]+ },+ component = spec1,+ test = TestOptions {+ mod = "Api.ServerTest",+ test = Just "test_server",+ runner = Just "generic"+ }+ }++ghcidTarget ::+ Path Abs Dir ->+ Path Abs File ->+ Text+ghcidTarget cwd scriptFile =+ [exon|ghcid --command="ghci -Werror -i#{path} -ghci-script=#{pathText scriptFile}" --test='#{test}'|]+ where+ test = "(check . property . test) test_server"+ path = [exon|#{dir}packages/api/test/:#{dir}packages/api/lib/:#{dir}packages/core/lib/|]+ dir = pathText cwd++test_ghcid :: TestT IO ()+test_ghcid = do+ cwd <- getCurrentDir+ res <- lift $ withSystemTempDir "hix-test" \ tmp ->+ runM root (ghcidCmdlineFromOptions tmp options)+ cmdline <- evalEither res+ ghcidTarget cwd cmdline.ghci.scriptFile === cmdline.cmdline++spec2 :: TargetSpec+spec2 =+ TargetForFile (root </> [relfile|packages/core/test/Main.hs|])++spec3 :: TargetSpec+spec3 =+ TargetForComponent ComponentCoords {+ package = PackageSpec "packages/core" (Just (Rel [reldir|packages/core|])),+ component = ComponentSpec "core-test" (Just (SourceDir [reldir|core-test|]))+ }++runnerFor :: EnvRunner -> TargetSpec -> TestT IO ()+runnerFor target spec = do+ res <- evalEither =<< liftIO (runM root (envRunner conf))+ target === res+ where+ conf = EnvRunnerOptions (Left (EnvConfig packages defaultRunner)) (Just spec)++test_componentEnv :: TestT IO ()+test_componentEnv = do+ runnerFor runner1 spec1+ runnerFor runner2 spec2+ runnerFor runner2 spec3++spec4 :: TargetSpec+spec4 =+ TargetForFile (root </> [relfile|packages/core/test/Core/Test/Main.hs|])++target_moduleName :: Text+target_moduleName =+ [exon|import Test.Tasty+:load #{m}+import #{m}|]+ where+ m = "Core.Test.Main"++test_moduleName :: TestT IO ()+test_moduleName = do+ conf <- evalEither =<< liftIO (runM root (assemble options { component = spec4 }))+ target_moduleName === conf.script
+ test/Hix/Test/PreprocTest.hs view
@@ -0,0 +1,243 @@+module Hix.Test.PreprocTest where++import Data.ByteString.Builder (toLazyByteString)+import qualified Data.Text as Text+import Distribution.PackageDescription (+ CondTree (condTreeData),+ GenericPackageDescription (condLibrary),+ Library (libBuildInfo),+ )+import Exon (exon)+import Hedgehog (TestT, evalMaybe, (===))+import Path (absfile)++import Hix.Preproc (preprocessModule)+import Hix.Test.CabalFile (testPackage, testPackageNoPrelude)++pragmas :: Text+pragmas =+ [exon|{-# options_ghc -Wall -Wunused-imports #-}+{-# language Haskell2010, AllowAmbiguousTypes, NoApplicativeDo #-}|]++preprocTestNoPrelude ::+ HasCallStack =>+ ByteString ->+ Text ->+ TestT IO ()+preprocTestNoPrelude module_ target =+ withFrozenCallStack do+ pkg <- liftIO testPackageNoPrelude+ info <- evalMaybe (pkg.condLibrary <&> \ l -> l.condTreeData.libBuildInfo)+ let result = toLazyByteString (preprocessModule [absfile|/foo/bar/Foo.hs|] info "Hix_Dummy" module_)+ Text.lines target === Text.lines (decodeUtf8 result)++preprocTest ::+ HasCallStack =>+ ByteString ->+ Text ->+ TestT IO ()+preprocTest module_ target =+ withFrozenCallStack do+ pkg <- liftIO testPackage+ info <- evalMaybe (pkg.condLibrary <&> \ l -> l.condTreeData.libBuildInfo)+ let result = toLazyByteString (preprocessModule [absfile|/foo/bar/Foo.hs|] info "Hix_Dummy" module_)+ Text.lines target === Text.lines (decodeUtf8 result)++moduleInsert :: ByteString+moduleInsert =+ [exon|{-# language OverloadedLabels #-}++module Foo (+ moo,++noo,+) where++import Data.Char++f :: Int+f = 1+|]++targetInsert :: Text+targetInsert =+ [exon|#{pragmas}+{-# language PackageImports, NoImplicitPrelude #-}+{-# line 1 "/foo/bar/Foo.hs" #-}+{-# language OverloadedLabels #-}++module Foo (Hix_Dummy,+ moo,++noo,+) where+import "incipit-base" IncipitBase as Prelude+{-# line 8 "/foo/bar/Foo.hs" #-}++import Data.Char++type Hix_Dummy = Int+{-# line 11 "/foo/bar/Foo.hs" #-}+f :: Int+f = 1+|]++test_preprocInsertPrelude :: TestT IO ()+test_preprocInsertPrelude =+ preprocTest moduleInsert targetInsert++moduleReplace :: ByteString+moduleReplace =+ [exon|{-# language OverloadedLabels #-}++module Foo (+ moo,++ noo,+ ) where++import Data.Char+import "base" Prelude (sum)+import Data.List+import Prelude hiding (Maybe)+import Data.Maybe++f :: Int+f = 1+|]++targetReplace :: Text+targetReplace =+ [exon|#{pragmas}+{-# language PackageImports, NoImplicitPrelude #-}+{-# line 1 "/foo/bar/Foo.hs" #-}+{-# language OverloadedLabels #-}++module Foo (Hix_Dummy,+ moo,++ noo,+ ) where++import Data.Char+import "incipit-base" IncipitBase (sum)+import Data.List+import "incipit-base" IncipitBase hiding (Maybe)+import Data.Maybe++type Hix_Dummy = Int+{-# line 15 "/foo/bar/Foo.hs" #-}+f :: Int+f = 1+|]++test_preprocReplacePrelude :: TestT IO ()+test_preprocReplacePrelude =+ preprocTest moduleReplace targetReplace++moduleSingleLineModule :: ByteString+moduleSingleLineModule =+ [exon|module Foo where++f :: Int+f = 1+|]++targetSingleLineModule :: Text+targetSingleLineModule =+ [exon|#{pragmas}+{-# language PackageImports, NoImplicitPrelude #-}+{-# line 1 "/foo/bar/Foo.hs" #-}+module Foo where+import "incipit-base" IncipitBase as Prelude+{-# line 2 "/foo/bar/Foo.hs" #-}++type Hix_Dummy = Int+{-# line 3 "/foo/bar/Foo.hs" #-}+f :: Int+f = 1+|]++test_preprocSingleLineModule :: TestT IO ()+test_preprocSingleLineModule =+ preprocTest moduleSingleLineModule targetSingleLineModule++moduleSelfExport :: ByteString+moduleSelfExport =+ [exon|module Foo (module Foo) where++f :: Int+f = 1+|]++targetSelfExport :: Text+targetSelfExport =+ [exon|#{pragmas}+{-# language PackageImports, NoImplicitPrelude #-}+{-# line 1 "/foo/bar/Foo.hs" #-}+module Foo (module Foo) where+import "incipit-base" IncipitBase as Prelude+{-# line 2 "/foo/bar/Foo.hs" #-}++type Hix_Dummy = Int+{-# line 3 "/foo/bar/Foo.hs" #-}+f :: Int+f = 1+|]++test_preprocSelfExport :: TestT IO ()+test_preprocSelfExport =+ preprocTest moduleSelfExport targetSelfExport++moduleSelfExport2 :: ByteString+moduleSelfExport2 =+ [exon|module Foo (+ module Bar,+ module Foo,+ module Baz,+) where++f :: Int+f = 1+|]++targetSelfExport2 :: Text+targetSelfExport2 =+ [exon|#{pragmas}+{-# language PackageImports, NoImplicitPrelude #-}+{-# line 1 "/foo/bar/Foo.hs" #-}+module Foo (+ module Bar,+ module Foo,+ module Baz,+) where+import "incipit-base" IncipitBase as Prelude+{-# line 6 "/foo/bar/Foo.hs" #-}++type Hix_Dummy = Int+{-# line 7 "/foo/bar/Foo.hs" #-}+f :: Int+f = 1+|]++test_preprocSelfExport2 :: TestT IO ()+test_preprocSelfExport2 =+ preprocTest moduleSelfExport2 targetSelfExport2++moduleNoPrelude :: ByteString+moduleNoPrelude =+ [exon|module Main where+import System.Exit (exitSuccess)+|]++targetNoPrelude :: Text+targetNoPrelude =+ [exon|#{pragmas}+{-# line 1 "/foo/bar/Foo.hs" #-}+module Main where+import System.Exit (exitSuccess)+|]++test_preprocNoPrelude :: TestT IO ()+test_preprocNoPrelude =+ preprocTestNoPrelude moduleNoPrelude targetNoPrelude
+ test/Main.hs view
@@ -0,0 +1,45 @@+module Main where++import Hedgehog (TestT, property, test, withTests)+import Hix.Test.CabalTest (test_cabal)+import Hix.Test.GhciTest (test_componentEnv, test_ghcid, test_moduleName)+import Hix.Test.PreprocTest (+ test_preprocInsertPrelude,+ test_preprocNoPrelude,+ test_preprocReplacePrelude,+ test_preprocSelfExport,+ test_preprocSelfExport2,+ test_preprocSingleLineModule,+ )+import Test.Tasty (TestName, TestTree, defaultMain, testGroup)+import Test.Tasty.Hedgehog (testProperty)++unitTest ::+ HasCallStack =>+ TestName ->+ TestT IO () ->+ TestTree+unitTest desc t =+ withFrozenCallStack do+ testProperty desc (withTests 1 (property (test t)))++tests :: TestTree+tests =+ testGroup "all" [+ unitTest "parse cabal file" test_cabal,+ testGroup "preprocess source file" [+ unitTest "insert prelude import" test_preprocInsertPrelude,+ unitTest "replace prelude imports" test_preprocReplacePrelude,+ unitTest "single line module decl" test_preprocSingleLineModule,+ unitTest "self exporting module, inline" test_preprocSelfExport,+ unitTest "self exporting module, separate line" test_preprocSelfExport2,+ unitTest "self exporting module, separate line" test_preprocNoPrelude,+ unitTest "run ghcid" test_ghcid,+ unitTest "component env" test_componentEnv,+ unitTest "extract module name from path" test_moduleName+ ]+ ]++main :: IO ()+main =+ defaultMain tests