on master help sign in
Merge pull request #35 from tomsmalley/tom-fix-port
9fce2bdLuigy Leon
lib/run/src/Obelisk/Run.hs+7−3
@@ -48,9 +48,13 @@ run port backend frontend = do
48 runWidget conf frontend `finally` killThread backendTid
48 runWidget conf frontend `finally` killThread backendTid
49
49
50getConfigRoute :: IO (Maybe URI)
50getConfigRoute :: IO (Maybe URI)
51−getConfigRoute = do
51+getConfigRoute = get "common/route" >>= \case
52− mroute <- get "common/route"
52+ Just r -> case URI.mkURI $ T.strip r of
53− return $ URI.mkURI =<< mroute
53+ Just route -> pure $ Just route
54+ Nothing -> do
55+ putStrLn $ "Route is invalid: " <> show r
56+ pure Nothing
57+ Nothing -> pure Nothing
54
58
55defAppUri :: URI
59defAppUri :: URI
56defAppUri = fromMaybe (error "defAppUri") $ URI.mkURI "http://127.0.0.1:8000"
60defAppUri = fromMaybe (error "defAppUri") $ URI.mkURI "http://127.0.0.1:8000"
lib/selftest/obelisk-selftest.cabal+2
@@ -11,10 +11,12 @@ library
11 build-depends:
11 build-depends:
12 base
12 base
13 , containers
13 , containers
14+ , directory
14 , hspec
15 , hspec
15 , http-client
16 , http-client
16 , http-types
17 , http-types
17 , HUnit
18 , HUnit
19+ , obelisk-run
18 , process
20 , process
19 , network
21 , network
20 , shelly
22 , shelly
lib/selftest/src/Obelisk/SelfTest.hs+8
@@ -8,6 +8,7 @@ import Control.Monad
8import Control.Monad.IO.Class
8import Control.Monad.IO.Class
9import Data.Bool (bool)
9import Data.Bool (bool)
10import Data.Function (fix)
10import Data.Function (fix)
11+import Data.Maybe (isJust)
11import Data.Semigroup ((<>))
12import Data.Semigroup ((<>))
12import qualified Data.Set as Set
13import qualified Data.Set as Set
13import Data.String
14import Data.String
@@ -18,6 +19,7 @@ import qualified Network.HTTP.Client as HTTP
18import qualified Network.HTTP.Types as HTTP
19import qualified Network.HTTP.Types as HTTP
19import qualified Network.Socket as Socket
20import qualified Network.Socket as Socket
20import Shelly
21import Shelly
22+import System.Directory (withCurrentDirectory)
21import System.Environment
23import System.Environment
22import System.Exit (ExitCode (..), exitWith)
24import System.Exit (ExitCode (..), exitWith)
23import System.Info
25import System.Info
@@ -28,6 +30,8 @@ import Test.Hspec
28import Test.HUnit.Base
30import Test.HUnit.Base
29import System.Process (readProcessWithExitCode)
31import System.Process (readProcessWithExitCode)
30
32
33+import Obelisk.Run (getConfigRoute)
34+
31data ObRunState
35data ObRunState
32 = ObRunState_Init
36 = ObRunState_Init
33 | ObRunState_Startup
37 | ObRunState_Startup
@@ -81,6 +85,10 @@ main = do
81 errExit False $ run "ob" ["init", "--symlink", "/dev/null"]
85 errExit False $ run "ob" ["init", "--symlink", "/dev/null"]
82 ls tmp >>= liftIO . assertEqual "" []
86 ls tmp >>= liftIO . assertEqual "" []
83
87
88+ it "produces a valid route config" $ inTmp $ \tmp -> do
89+ run "ob" ["init"]
90+ liftIO $ withCurrentDirectory (T.unpack $ toTextIgnore tmp) $ getConfigRoute `shouldNotReturn` Nothing
91+
84 describe "ob run" $ do
92 describe "ob run" $ do
85 it "works in root directory" $ inTmp $ \_ -> do
93 it "works in root directory" $ inTmp $ \_ -> do
86 run "ob" ["init"]
94 run "ob" ["init"]