@@ -1,13 +1,14 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
4module Obelisk.Command.Run where
5module Obelisk.Command.Run where
6−import qualified Control.Exception as E
7+import Control.Exception (bracket)
7import Control.Monad
8import Control.Monad
8import Data.Either
9import Data.Either
9import Data.List
10import Data.List
10−import Control.Monad.Reader (ask)
11+import Control.Monad.Reader (MonadIO, ask)
11import Data.Maybe
12import Data.Maybe
12import Control.Monad.IO.Class (liftIO)
13import Control.Monad.IO.Class (liftIO)
13import Data.Monoid
14import Data.Monoid
@@ -34,8 +35,7 @@ run = do
34 pkgs <- getLocalPkgs
35 pkgs <- getLocalPkgs
35 withGhciScript pkgs $ \dotGhciPath -> do
36 withGhciScript pkgs $ \dotGhciPath -> do
36 freePort <- getFreePort
37 freePort <- getFreePort
37− let testCmd = unwords ["Obelisk.Run.run", show freePort, "backend", "frontend"]
38+ runGhcid dotGhciPath $ Just $ unwords ["Obelisk.Run.run", show freePort, "backend", "frontend"]
38− runGhcid dotGhciPath $ Just testCmd
40runRepl :: MonadObelisk m => m ()
40runRepl :: MonadObelisk m => m ()
41runRepl = do
41runRepl = do
@@ -45,8 +45,8 @@ runRepl = do
46-- | Relative paths to local packages of an obelisk project
46-- | Relative paths to local packages of an obelisk project
47-- TODO a way to query this
47-- TODO a way to query this
48−getLocalPkgs :: MonadObelisk m => m [FilePath]
48+getLocalPkgs :: Applicative f => f [FilePath]
49−getLocalPkgs = return ["backend", "common", "frontend"]
49+getLocalPkgs = pure ["backend", "common", "frontend"]
51parseHsSrcDir
51parseHsSrcDir
52 :: MonadObelisk m
52 :: MonadObelisk m
@@ -78,14 +78,15 @@ withGhciScript
78withGhciScript pkgs f = do
78withGhciScript pkgs f = do
79 (pkgDirErrs, hsSrcDirs) <- fmap partitionEithers $ forM pkgs $ \pkg -> do
79 (pkgDirErrs, hsSrcDirs) <- fmap partitionEithers $ forM pkgs $ \pkg -> do
80 let cabalFp = pkg </> pkg <.> "cabal"
80 let cabalFp = pkg </> pkg <.> "cabal"
81− xs <- parseHsSrcDir cabalFp
81+ flip fmap (parseHsSrcDir cabalFp) $ \case
83 Nothing -> Left pkg
82 Nothing -> Left pkg
84 Just hsSrcDirs -> Right $ toList $ fmap (pkg </>) hsSrcDirs
83 Just hsSrcDirs -> Right $ toList $ fmap (pkg </>) hsSrcDirs
85 when (null hsSrcDirs) $
85 when (null hsSrcDirs) $
86 failWith $ T.pack $ "No valid pkgs found in " <> intercalate ", " pkgs
86 failWith $ T.pack $ "No valid pkgs found in " <> intercalate ", " pkgs
87 unless (null pkgDirErrs) $
87 unless (null pkgDirErrs) $
88 putLog Warning $ T.pack $ "Failed to find pkgs in " <> intercalate ", " pkgDirErrs
88 putLog Warning $ T.pack $ "Failed to find pkgs in " <> intercalate ", " pkgDirErrs
89 let dotGhci = unlines
90 let dotGhci = unlines
90 [ ":set -i" <> intercalate ":" (mconcat hsSrcDirs)
91 [ ":set -i" <> intercalate ":" (mconcat hsSrcDirs)
91 , ":add Backend Frontend"
92 , ":add Backend Frontend"
@@ -119,10 +120,10 @@ runGhcid dotGhci mcmd = callCommand $ unwords $ "ghcid" : opts
119 ] <> testCmd
120 ] <> testCmd
120 testCmd = maybeToList (flip fmap mcmd $ \cmd -> "--test='" <> cmd <> "'")
121 testCmd = maybeToList (flip fmap mcmd $ \cmd -> "--test='" <> cmd <> "'")
122−getFreePort :: MonadObelisk m => m PortNumber
123+getFreePort :: MonadIO m => m PortNumber
123getFreePort = liftIO $ withSocketsDo $ do
124getFreePort = liftIO $ withSocketsDo $ do
124 addr:_ <- getAddrInfo (Just defaultHints) (Just "127.0.0.1") (Just "0")
125 addr:_ <- getAddrInfo (Just defaultHints) (Just "127.0.0.1") (Just "0")
125− E.bracket (open addr) close socketPort
126+ bracket (open addr) close socketPort
127 open addr = do
128 open addr = do
128 sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
129 sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)