on master help sign in
Merge branch 'routes' into reunification
commit96d2bc75e0f9398cbebb2e5f82b1a58eea40df00 authorKen Micklas <kmicklas@gmail.com> dateWed 19 Sep 2018, 17:48 (8 years ago) parentd84f2923c34272
1 file changed+35−10
lib/command/src/Obelisk/Command/Run.hs+35−10
lib/command/src/Obelisk/Command/Run.hs+35−10
@@ -16,11 +16,13 @@ import Data.Maybe
1616import qualified Data.Text as T
1717import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)
1818import Distribution.Parsec.ParseResult (runParseResult)
19+import Distribution.Pretty
1920import Distribution.Types.BuildInfo
2021import Distribution.Types.CondTree
2122import Distribution.Types.GenericPackageDescription
2223import Distribution.Types.Library
2324import Distribution.Utils.Generic (withUTF8FileContents, toUTF8BS)
25+import Language.Haskell.Extension
2426import Network.Socket
2527import System.Directory
2628import System.FilePath
@@ -32,6 +34,14 @@ import Obelisk.CliApp (CliT (..), HasCliConfig, Severity (..), callCommand, fail
3234 runCli)
3335import Obelisk.Command.Project (inProjectShell)
3436
37+data CabalPackageInfo = CabalPackageInfo
38+ { _cabalPackageInfo_packageRoot :: FilePath
39+ , _cabalPackageInfo_sourceDirs :: NE.NonEmpty FilePath
40+ -- ^ List of hs src dirs of the library component
41+ , _cabalPackageInfo_defaultExtensions :: [Extension]
42+ -- ^ List of globally enable extensions of the library component
43+ }
44+
3545-- NOTE: `run` is not polymorphic like the rest because we use StaticPtr to invoke it.
3646run :: ObeliskT IO ()
3747run = do
@@ -56,11 +66,11 @@ runWatch = do
5666getLocalPkgs :: Applicative f => f [FilePath]
5767getLocalPkgs = pure ["backend", "common", "frontend"]
5868
59−parseHsSrcDir
69+parseCabalPackage
6070 :: (MonadObelisk m)
6171 => FilePath -- ^ package cabal file path
62− -> m (Maybe (NE.NonEmpty FilePath)) -- ^ List of hs src dirs of the library component
63−parseHsSrcDir cabalFp = do
72+ -> m (Maybe CabalPackageInfo)
73+parseCabalPackage cabalFp = do
6474 exists <- liftIO $ doesFileExist cabalFp
6575 if exists
6676 then do
@@ -71,7 +81,13 @@ parseHsSrcDir cabalFp = do
7181 Right gpkg -> do
7282 return $ do
7383 (_, lib) <- simplifyCondTree (const $ pure True) <$> condLibrary gpkg
74− pure $ fromMaybe (pure ".") $ NE.nonEmpty $ hsSourceDirs $ libBuildInfo lib
84+ pure $ CabalPackageInfo
85+ { _cabalPackageInfo_packageRoot = takeDirectory cabalFp
86+ , _cabalPackageInfo_sourceDirs =
87+ fromMaybe (pure ".") $ NE.nonEmpty $ hsSourceDirs $ libBuildInfo lib
88+ , _cabalPackageInfo_defaultExtensions =
89+ defaultExtensions $ libBuildInfo lib
90+ }
7591 Left (_, errors) -> do
7692 putLog Error $ T.pack "Failed to parse cabal file: "
7793 mapM_ (putLog Error) $ fmap (T.pack . show) errors
@@ -90,19 +106,24 @@ withGhciScript
90106 -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporory .ghci
91107 -> m ()
92108withGhciScript pkgs f = do
93− (pkgDirErrs, hsSrcDirs) <- fmap partitionEithers $ forM pkgs $ \pkg -> do
109+ (pkgDirErrs, packageInfos) <- fmap partitionEithers $ forM pkgs $ \pkg -> do
94110 let cabalFp = pkg </> pkg <.> "cabal"
95− flip fmap (parseHsSrcDir cabalFp) $ \case
111+ flip fmap (parseCabalPackage cabalFp) $ \case
96112 Nothing -> Left pkg
97− Just hsSrcDirs -> Right $ toList $ fmap (pkg </>) hsSrcDirs
113+ Just packageInfo -> Right packageInfo
98114
99− when (null hsSrcDirs) $
115+ when (null packageInfos) $
100116 failWith $ T.pack $ "No valid pkgs found in " <> intercalate ", " pkgs
101117 unless (null pkgDirErrs) $
102118 putLog Warning $ T.pack $ "Failed to find pkgs in " <> intercalate ", " pkgDirErrs
103119
104− let dotGhci = unlines
105− [ ":set -i" <> intercalate ":" (mconcat hsSrcDirs)
120+ let extensions = packageInfos >>= _cabalPackageInfo_defaultExtensions
121+ extensionsLine = if extensions == mempty
122+ then ""
123+ else ":set " <> intercalate " " ((("-X" <>) . prettyShow) <$> extensions)
124+ dotGhci = unlines $
125+ [ ":set -i" <> intercalate ":" (packageInfos >>= rootedSourceDirs)
126+ , extensionsLine
106127 , ":load Backend Frontend"
107128 , "import Obelisk.Run"
108129 , "import qualified Frontend"
@@ -113,6 +134,10 @@ withGhciScript pkgs f = do
113134 liftIO $ writeFile dotGhciPath dotGhci
114135 f dotGhciPath
115136
137+ where
138+ rootedSourceDirs pkg = NE.toList $
139+ (_cabalPackageInfo_packageRoot pkg </>) <$> _cabalPackageInfo_sourceDirs pkg
140+
116141-- | Run ghci repl
117142runGhciRepl
118143 :: MonadObelisk m