git.iko.soy/obelisk
on master help sign in
Merge branch 'routes' into reunification
96d2bc7Ken Micklas
lib/command/src/Obelisk/Command/Run.hs+35−10
compare with master
unifiedsplit
@@ -16,11 +16,13 @@ import Data.Maybe
16import qualified Data.Text as T
16import qualified Data.Text as T
17import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)
17import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)
18import Distribution.Parsec.ParseResult (runParseResult)
18import Distribution.Parsec.ParseResult (runParseResult)
19+import Distribution.Pretty
19import Distribution.Types.BuildInfo
20import Distribution.Types.BuildInfo
20import Distribution.Types.CondTree
21import Distribution.Types.CondTree
21import Distribution.Types.GenericPackageDescription
22import Distribution.Types.GenericPackageDescription
22import Distribution.Types.Library
23import Distribution.Types.Library
23import Distribution.Utils.Generic (withUTF8FileContents, toUTF8BS)
24import Distribution.Utils.Generic (withUTF8FileContents, toUTF8BS)
25+import Language.Haskell.Extension
24import Network.Socket
26import Network.Socket
25import System.Directory
27import System.Directory
26import System.FilePath
28import System.FilePath
@@ -32,6 +34,14 @@ import Obelisk.CliApp (CliT (..), HasCliConfig, Severity (..), callCommand, fail
32 runCli)
34 runCli)
33import Obelisk.Command.Project (inProjectShell)
35import Obelisk.Command.Project (inProjectShell)
34
36
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+
35-- NOTE: `run` is not polymorphic like the rest because we use StaticPtr to invoke it.
45-- NOTE: `run` is not polymorphic like the rest because we use StaticPtr to invoke it.
36run :: ObeliskT IO ()
46run :: ObeliskT IO ()
37run = do
47run = do
@@ -56,11 +66,11 @@ runWatch = do
56getLocalPkgs :: Applicative f => f [FilePath]
66getLocalPkgs :: Applicative f => f [FilePath]
57getLocalPkgs = pure ["backend", "common", "frontend"]
67getLocalPkgs = pure ["backend", "common", "frontend"]
58
68
59−parseHsSrcDir
69+parseCabalPackage
60 :: (MonadObelisk m)
70 :: (MonadObelisk m)
61 => FilePath -- ^ package cabal file path
71 => FilePath -- ^ package cabal file path
62− -> m (Maybe (NE.NonEmpty FilePath)) -- ^ List of hs src dirs of the library component
72+ -> m (Maybe CabalPackageInfo)
63−parseHsSrcDir cabalFp = do
73+parseCabalPackage cabalFp = do
64 exists <- liftIO $ doesFileExist cabalFp
74 exists <- liftIO $ doesFileExist cabalFp
65 if exists
75 if exists
66 then do
76 then do
@@ -71,7 +81,13 @@ parseHsSrcDir cabalFp = do
71 Right gpkg -> do
81 Right gpkg -> do
72 return $ do
82 return $ do
73 (_, lib) <- simplifyCondTree (const $ pure True) <$> condLibrary gpkg
83 (_, lib) <- simplifyCondTree (const $ pure True) <$> condLibrary gpkg
84+ pure $ CabalPackageInfo
85+ { _cabalPackageInfo_packageRoot = takeDirectory cabalFp
86+ , _cabalPackageInfo_sourceDirs =
74− pure $ fromMaybe (pure ".") $ NE.nonEmpty $ hsSourceDirs $ libBuildInfo lib
87+ fromMaybe (pure ".") $ NE.nonEmpty $ hsSourceDirs $ libBuildInfo lib
88+ , _cabalPackageInfo_defaultExtensions =
89+ defaultExtensions $ libBuildInfo lib
90+ }
75 Left (_, errors) -> do
91 Left (_, errors) -> do
76 putLog Error $ T.pack "Failed to parse cabal file: "
92 putLog Error $ T.pack "Failed to parse cabal file: "
77 mapM_ (putLog Error) $ fmap (T.pack . show) errors
93 mapM_ (putLog Error) $ fmap (T.pack . show) errors
@@ -90,19 +106,24 @@ withGhciScript
90 -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporory .ghci
106 -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporory .ghci
91 -> m ()
107 -> m ()
92withGhciScript pkgs f = do
108withGhciScript pkgs f = do
93− (pkgDirErrs, hsSrcDirs) <- fmap partitionEithers $ forM pkgs $ \pkg -> do
109+ (pkgDirErrs, packageInfos) <- fmap partitionEithers $ forM pkgs $ \pkg -> do
94 let cabalFp = pkg </> pkg <.> "cabal"
110 let cabalFp = pkg </> pkg <.> "cabal"
95− flip fmap (parseHsSrcDir cabalFp) $ \case
111+ flip fmap (parseCabalPackage cabalFp) $ \case
96 Nothing -> Left pkg
112 Nothing -> Left pkg
97− Just hsSrcDirs -> Right $ toList $ fmap (pkg </>) hsSrcDirs
113+ Just packageInfo -> Right packageInfo
98
114
99− when (null hsSrcDirs) $
115+ when (null packageInfos) $
100 failWith $ T.pack $ "No valid pkgs found in " <> intercalate ", " pkgs
116 failWith $ T.pack $ "No valid pkgs found in " <> intercalate ", " pkgs
101 unless (null pkgDirErrs) $
117 unless (null pkgDirErrs) $
102 putLog Warning $ T.pack $ "Failed to find pkgs in " <> intercalate ", " pkgDirErrs
118 putLog Warning $ T.pack $ "Failed to find pkgs in " <> intercalate ", " pkgDirErrs
103
119
120+ let extensions = packageInfos >>= _cabalPackageInfo_defaultExtensions
121+ extensionsLine = if extensions == mempty
122+ then ""
123+ else ":set " <> intercalate " " ((("-X" <>) . prettyShow) <$> extensions)
104− let dotGhci = unlines
124+ dotGhci = unlines $
105− [ ":set -i" <> intercalate ":" (mconcat hsSrcDirs)
125+ [ ":set -i" <> intercalate ":" (packageInfos >>= rootedSourceDirs)
126+ , extensionsLine
106 , ":load Backend Frontend"
127 , ":load Backend Frontend"
107 , "import Obelisk.Run"
128 , "import Obelisk.Run"
108 , "import qualified Frontend"
129 , "import qualified Frontend"
@@ -113,6 +134,10 @@ withGhciScript pkgs f = do
113 liftIO $ writeFile dotGhciPath dotGhci
134 liftIO $ writeFile dotGhciPath dotGhci
114 f dotGhciPath
135 f dotGhciPath
115
136
137+ where
138+ rootedSourceDirs pkg = NE.toList $
139+ (_cabalPackageInfo_packageRoot pkg </>) <$> _cabalPackageInfo_sourceDirs pkg
140+
116-- | Run ghci repl
141-- | Run ghci repl
117runGhciRepl
142runGhciRepl
118 :: MonadObelisk m
143 :: MonadObelisk m