@@ -1,13 +1,14 @@
11{-# LANGUAGE OverloadedStrings #-}
22{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE LambdaCase #-}
34{-# LANGUAGE MultiParamTypeClasses #-}
45module Obelisk.Command.Run where
56
6−import qualified Control.Exception as E
7+import Control.Exception (bracket)
78import Control.Monad
89import Data.Either
910import Data.List
10−import Control.Monad.Reader (ask)
11+import Control.Monad.Reader (MonadIO, ask)
1112import Data.Maybe
1213import Control.Monad.IO.Class (liftIO)
1314import Data.Monoid
@@ -34,8 +35,7 @@ run = do
3435 pkgs <- getLocalPkgs
3536 withGhciScript pkgs $ \dotGhciPath -> do
3637 freePort <- getFreePort
37− let testCmd = unwords ["Obelisk.Run.run", show freePort, "backend", "frontend"]
38− runGhcid dotGhciPath $ Just testCmd
38+ runGhcid dotGhciPath $ Just $ unwords ["Obelisk.Run.run", show freePort, "backend", "frontend"]
3939
4040runRepl :: MonadObelisk m => m ()
4141runRepl = do
@@ -45,8 +45,8 @@ runRepl = do
4545
4646-- | Relative paths to local packages of an obelisk project
4747-- TODO a way to query this
48−getLocalPkgs :: MonadObelisk m => m [FilePath]
49−getLocalPkgs = return ["backend", "common", "frontend"]
48+getLocalPkgs :: Applicative f => f [FilePath]
49+getLocalPkgs = pure ["backend", "common", "frontend"]
5050
5151parseHsSrcDir
5252 :: MonadObelisk m
@@ -78,14 +78,15 @@ withGhciScript
7878withGhciScript pkgs f = do
7979 (pkgDirErrs, hsSrcDirs) <- fmap partitionEithers $ forM pkgs $ \pkg -> do
8080 let cabalFp = pkg </> pkg <.> "cabal"
81− xs <- parseHsSrcDir cabalFp
82− return $ case xs of
81+ flip fmap (parseHsSrcDir cabalFp) $ \case
8382 Nothing -> Left pkg
8483 Just hsSrcDirs -> Right $ toList $ fmap (pkg </>) hsSrcDirs
84+
8585 when (null hsSrcDirs) $
8686 failWith $ T.pack $ "No valid pkgs found in " <> intercalate ", " pkgs
8787 unless (null pkgDirErrs) $
8888 putLog Warning $ T.pack $ "Failed to find pkgs in " <> intercalate ", " pkgDirErrs
89+
8990 let dotGhci = unlines
9091 [ ":set -i" <> intercalate ":" (mconcat hsSrcDirs)
9192 , ":add Backend Frontend"
@@ -119,10 +120,10 @@ runGhcid dotGhci mcmd = callCommand $ unwords $ "ghcid" : opts
119120 ] <> testCmd
120121 testCmd = maybeToList (flip fmap mcmd $ \cmd -> "--test='" <> cmd <> "'")
121122
122−getFreePort :: MonadObelisk m => m PortNumber
123+getFreePort :: MonadIO m => m PortNumber
123124getFreePort = liftIO $ withSocketsDo $ do
124125 addr:_ <- getAddrInfo (Just defaultHints) (Just "127.0.0.1") (Just "0")
125− E.bracket (open addr) close socketPort
126+ bracket (open addr) close socketPort
126127 where
127128 open addr = do
128129 sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)