{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
module Snap.Snaplet.PureScript.Internal (
    CompilationMode(..)
  , CompilationOutput(..)
  , Verbosity(..)
  , SpagoPath(getSpagoPath)
  , PureScript(..)
  , devFlagEnabled
  , getCompilationFlavour
  , getDestDir
  , getSpagoFile
  , getAbsoluteOutputDir
  , prependToPath
  , findOrInstallSpago
  , shV
  , shS
  ) where

import           Control.Exception (SomeException)
import           Control.Monad.IO.Class
import           Control.Monad.Reader
import           Data.Configurator as Cfg
import           Data.Configurator.Types
import           Data.Maybe
import           Data.String
import           Data.String.Conv
import qualified Data.Text as T
import           Shelly ( run, run_, echo, fromText, errExit, catchany_sh, verbosely, lastExitCode, Sh, setenv
                        , get_env_text, shelly, escaping, toTextWarn, silently
                        )
import qualified Shelly as Sh
import           Snap
import           Snap.Snaplet.PureScript.Hooks (Hooks)
import           Text.Read hiding (String)

--------------------------------------------------------------------------------
data CompilationMode = CompileOnce
                     | CompileAlways
                     | CompileNever
                     deriving (Int -> CompilationMode -> ShowS
[CompilationMode] -> ShowS
CompilationMode -> String
(Int -> CompilationMode -> ShowS)
-> (CompilationMode -> String)
-> ([CompilationMode] -> ShowS)
-> Show CompilationMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompilationMode] -> ShowS
$cshowList :: [CompilationMode] -> ShowS
show :: CompilationMode -> String
$cshow :: CompilationMode -> String
showsPrec :: Int -> CompilationMode -> ShowS
$cshowsPrec :: Int -> CompilationMode -> ShowS
Show, CompilationMode -> CompilationMode -> Bool
(CompilationMode -> CompilationMode -> Bool)
-> (CompilationMode -> CompilationMode -> Bool)
-> Eq CompilationMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompilationMode -> CompilationMode -> Bool
$c/= :: CompilationMode -> CompilationMode -> Bool
== :: CompilationMode -> CompilationMode -> Bool
$c== :: CompilationMode -> CompilationMode -> Bool
Eq, ReadPrec [CompilationMode]
ReadPrec CompilationMode
Int -> ReadS CompilationMode
ReadS [CompilationMode]
(Int -> ReadS CompilationMode)
-> ReadS [CompilationMode]
-> ReadPrec CompilationMode
-> ReadPrec [CompilationMode]
-> Read CompilationMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompilationMode]
$creadListPrec :: ReadPrec [CompilationMode]
readPrec :: ReadPrec CompilationMode
$creadPrec :: ReadPrec CompilationMode
readList :: ReadS [CompilationMode]
$creadList :: ReadS [CompilationMode]
readsPrec :: Int -> ReadS CompilationMode
$creadsPrec :: Int -> ReadS CompilationMode
Read)

instance Configured CompilationMode where
  convert :: Value -> Maybe CompilationMode
convert (String Text
t) = String -> Maybe CompilationMode
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe CompilationMode)
-> (Text -> String) -> Text -> Maybe CompilationMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe CompilationMode) -> Text -> Maybe CompilationMode
forall a b. (a -> b) -> a -> b
$ Text
t
  convert Value
_ = Maybe CompilationMode
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
newtype SpagoPath = SpagoPath { SpagoPath -> String
getSpagoPath :: FilePath } deriving (Int -> SpagoPath -> ShowS
[SpagoPath] -> ShowS
SpagoPath -> String
(Int -> SpagoPath -> ShowS)
-> (SpagoPath -> String)
-> ([SpagoPath] -> ShowS)
-> Show SpagoPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpagoPath] -> ShowS
$cshowList :: [SpagoPath] -> ShowS
show :: SpagoPath -> String
$cshow :: SpagoPath -> String
showsPrec :: Int -> SpagoPath -> ShowS
$cshowsPrec :: Int -> SpagoPath -> ShowS
Show, ReadPrec [SpagoPath]
ReadPrec SpagoPath
Int -> ReadS SpagoPath
ReadS [SpagoPath]
(Int -> ReadS SpagoPath)
-> ReadS [SpagoPath]
-> ReadPrec SpagoPath
-> ReadPrec [SpagoPath]
-> Read SpagoPath
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SpagoPath]
$creadListPrec :: ReadPrec [SpagoPath]
readPrec :: ReadPrec SpagoPath
$creadPrec :: ReadPrec SpagoPath
readList :: ReadS [SpagoPath]
$creadList :: ReadS [SpagoPath]
readsPrec :: Int -> ReadS SpagoPath
$creadsPrec :: Int -> ReadS SpagoPath
Read)

instance Configured SpagoPath where
  convert :: Value -> Maybe SpagoPath
convert (String Text
"") = Maybe SpagoPath
forall a. Maybe a
Nothing
  convert (String Text
t)  = SpagoPath -> Maybe SpagoPath
forall a. a -> Maybe a
Just (SpagoPath -> Maybe SpagoPath)
-> (Text -> SpagoPath) -> Text -> Maybe SpagoPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SpagoPath
SpagoPath (String -> SpagoPath) -> (Text -> String) -> Text -> SpagoPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a b. StringConv a b => a -> b
toS (Text -> Maybe SpagoPath) -> Text -> Maybe SpagoPath
forall a b. (a -> b) -> a -> b
$ Text
t
  convert Value
_ = Maybe SpagoPath
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
data Verbosity = Verbose
               | Quiet
               deriving (Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> String
(Int -> Verbosity -> ShowS)
-> (Verbosity -> String)
-> ([Verbosity] -> ShowS)
-> Show Verbosity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verbosity] -> ShowS
$cshowList :: [Verbosity] -> ShowS
show :: Verbosity -> String
$cshow :: Verbosity -> String
showsPrec :: Int -> Verbosity -> ShowS
$cshowsPrec :: Int -> Verbosity -> ShowS
Show, ReadPrec [Verbosity]
ReadPrec Verbosity
Int -> ReadS Verbosity
ReadS [Verbosity]
(Int -> ReadS Verbosity)
-> ReadS [Verbosity]
-> ReadPrec Verbosity
-> ReadPrec [Verbosity]
-> Read Verbosity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Verbosity]
$creadListPrec :: ReadPrec [Verbosity]
readPrec :: ReadPrec Verbosity
$creadPrec :: ReadPrec Verbosity
readList :: ReadS [Verbosity]
$creadList :: ReadS [Verbosity]
readsPrec :: Int -> ReadS Verbosity
$creadsPrec :: Int -> ReadS Verbosity
Read, Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c== :: Verbosity -> Verbosity -> Bool
Eq)

instance Configured Verbosity where
  convert :: Value -> Maybe Verbosity
convert (String Text
t) = String -> Maybe Verbosity
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Verbosity)
-> (Text -> String) -> Text -> Maybe Verbosity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Verbosity) -> Text -> Maybe Verbosity
forall a b. (a -> b) -> a -> b
$ Text
t
  convert Value
_ = Maybe Verbosity
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
data CompilationOutput = CompilationFailed !T.Text
                       | CompilationSucceeded
                       deriving (Int -> CompilationOutput -> ShowS
[CompilationOutput] -> ShowS
CompilationOutput -> String
(Int -> CompilationOutput -> ShowS)
-> (CompilationOutput -> String)
-> ([CompilationOutput] -> ShowS)
-> Show CompilationOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompilationOutput] -> ShowS
$cshowList :: [CompilationOutput] -> ShowS
show :: CompilationOutput -> String
$cshow :: CompilationOutput -> String
showsPrec :: Int -> CompilationOutput -> ShowS
$cshowsPrec :: Int -> CompilationOutput -> ShowS
Show, Eq CompilationOutput
Eq CompilationOutput
-> (CompilationOutput -> CompilationOutput -> Ordering)
-> (CompilationOutput -> CompilationOutput -> Bool)
-> (CompilationOutput -> CompilationOutput -> Bool)
-> (CompilationOutput -> CompilationOutput -> Bool)
-> (CompilationOutput -> CompilationOutput -> Bool)
-> (CompilationOutput -> CompilationOutput -> CompilationOutput)
-> (CompilationOutput -> CompilationOutput -> CompilationOutput)
-> Ord CompilationOutput
CompilationOutput -> CompilationOutput -> Bool
CompilationOutput -> CompilationOutput -> Ordering
CompilationOutput -> CompilationOutput -> CompilationOutput
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompilationOutput -> CompilationOutput -> CompilationOutput
$cmin :: CompilationOutput -> CompilationOutput -> CompilationOutput
max :: CompilationOutput -> CompilationOutput -> CompilationOutput
$cmax :: CompilationOutput -> CompilationOutput -> CompilationOutput
>= :: CompilationOutput -> CompilationOutput -> Bool
$c>= :: CompilationOutput -> CompilationOutput -> Bool
> :: CompilationOutput -> CompilationOutput -> Bool
$c> :: CompilationOutput -> CompilationOutput -> Bool
<= :: CompilationOutput -> CompilationOutput -> Bool
$c<= :: CompilationOutput -> CompilationOutput -> Bool
< :: CompilationOutput -> CompilationOutput -> Bool
$c< :: CompilationOutput -> CompilationOutput -> Bool
compare :: CompilationOutput -> CompilationOutput -> Ordering
$ccompare :: CompilationOutput -> CompilationOutput -> Ordering
$cp1Ord :: Eq CompilationOutput
Ord, CompilationOutput -> CompilationOutput -> Bool
(CompilationOutput -> CompilationOutput -> Bool)
-> (CompilationOutput -> CompilationOutput -> Bool)
-> Eq CompilationOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompilationOutput -> CompilationOutput -> Bool
$c/= :: CompilationOutput -> CompilationOutput -> Bool
== :: CompilationOutput -> CompilationOutput -> Bool
$c== :: CompilationOutput -> CompilationOutput -> Bool
Eq)

--------------------------------------------------------------------------------
data PureScript = PureScript {
    PureScript -> CompilationMode
pursCompilationMode :: CompilationMode
  , PureScript -> Verbosity
pursVerbosity :: Verbosity
  , PureScript -> Bool
pursBundle :: !Bool
  -- ^ Whether or not bundle everything in a fat app with a PS namespace.
  , PureScript -> Text
pursBundleName :: !T.Text
  -- ^ The name for your bundled output.
  , PureScript -> Text
pursBundleExe :: !T.Text
  -- ^ The name for the program used to bundle your app. (e.g. "spago", "psc-bundle", etc)
  , PureScript -> [Text]
pursBundleOpts :: ![T.Text]
  -- ^ Override the arguments passed to the bundle executable.
  , PureScript -> SpagoPath
pursSpagoPath :: !SpagoPath
  -- ^ The absolute path to a `spago` executable. This can be user-provided
  -- or inferred automatically by this snaplet.
  , PureScript -> Text
pursPsPath :: !T.Text
  -- ^ The absolute path to the directory containing the PureScript toolchain.
  -- If not specified, this snaplet will use the globally installed PureScript.
  , PureScript -> [Text]
pursPsaOpts :: [T.Text]
  -- ^ Extra options to pass to https://github.com/natefaubion/purescript-psa,
  -- if available.
  , PureScript -> Bool
pursPermissiveInit :: !Bool
  -- ^ Be lenient towards compilation errors in case the `pursInit` function
  -- initial compilation fails. Useful in devel mode to avoid your web server
  -- to not start at all when you are debugging your PS.
  , PureScript -> Text
pursPwdDir :: !T.Text
  -- ^ The PWD of your snaplet
  , PureScript -> Text
pursOutputDir :: !T.Text
  , PureScript -> [Text]
pursModules :: ![T.Text]
  -- ^ Where to store compilation artifacts (defaults to /js)
  , PureScript -> Hooks
pursHooks :: Hooks
  -- ^ Hooks to run at different times during the program execution
  } deriving Int -> PureScript -> ShowS
[PureScript] -> ShowS
PureScript -> String
(Int -> PureScript -> ShowS)
-> (PureScript -> String)
-> ([PureScript] -> ShowS)
-> Show PureScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PureScript] -> ShowS
$cshowList :: [PureScript] -> ShowS
show :: PureScript -> String
$cshow :: PureScript -> String
showsPrec :: Int -> PureScript -> ShowS
$cshowsPrec :: Int -> PureScript -> ShowS
Show

--------------------------------------------------------------------------------
devFlagEnabled :: Bool
devFlagEnabled :: Bool
devFlagEnabled =
#ifdef DEVELOPMENT
  True
#else
  Bool
False
#endif

--------------------------------------------------------------------------------
shS :: MonadIO m => Sh a -> m a
shS :: Sh a -> m a
shS = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (Sh a -> IO a) -> Sh a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sh a -> IO a
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (Sh a -> IO a) -> (Sh a -> Sh a) -> Sh a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sh a -> Sh a
forall a. Sh a -> Sh a
silently (Sh a -> Sh a) -> (Sh a -> Sh a) -> Sh a -> Sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Sh a -> Sh a
forall a. Bool -> Sh a -> Sh a
escaping Bool
False

--------------------------------------------------------------------------------
shV :: MonadIO m => Sh a -> m a
shV :: Sh a -> m a
shV = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (Sh a -> IO a) -> Sh a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sh a -> IO a
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (Sh a -> IO a) -> (Sh a -> Sh a) -> Sh a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sh a -> Sh a
forall a. Sh a -> Sh a
verbosely (Sh a -> Sh a) -> (Sh a -> Sh a) -> Sh a -> Sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Sh a -> Sh a
forall a. Bool -> Sh a -> Sh a
escaping Bool
False

--------------------------------------------------------------------------------
findOrInstallSpago :: T.Text
                  -> Maybe SpagoPath
                  -> (Monad (m b v), MonadIO (m b v), MonadSnaplet m)
                  => m b v SpagoPath
findOrInstallSpago :: Text
-> Maybe SpagoPath
-> (Monad (m b v), MonadIO (m b v), MonadSnaplet m) =>
   m b v SpagoPath
findOrInstallSpago Text
psPath Maybe SpagoPath
mbP = do
  let p :: SpagoPath
p = SpagoPath -> Maybe SpagoPath -> SpagoPath
forall a. a -> Maybe a -> a
fromMaybe (String -> SpagoPath
SpagoPath String
"spago") Maybe SpagoPath
mbP
  Bool
installed <- Sh Bool -> m b v Bool
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shS (Text -> SpagoPath -> Sh Bool
spagoInstalled Text
psPath SpagoPath
p)
  case Bool
installed of
    Bool
True  -> SpagoPath -> m b v SpagoPath
forall (m :: * -> *) a. Monad m => a -> m a
return SpagoPath
p
    Bool
False -> Sh SpagoPath -> m b v SpagoPath
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shS (Sh SpagoPath -> m b v SpagoPath)
-> Sh SpagoPath -> m b v SpagoPath
forall a b. (a -> b) -> a -> b
$ do
      Text -> Sh ()
echo Text
"Spago not found, installing it locally for you..."
      Sh ()
forall (m :: * -> *). MonadIO m => m ()
installSpago Sh () -> Sh SpagoPath -> Sh SpagoPath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sh SpagoPath
forall (m :: * -> *). MonadIO m => m SpagoPath
whichSpago

--------------------------------------------------------------------------------
whichSpago :: MonadIO m => m SpagoPath
whichSpago :: m SpagoPath
whichSpago = String -> SpagoPath
SpagoPath (String -> SpagoPath) -> (Text -> String) -> Text -> SpagoPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a b. StringConv a b => a -> b
toS (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> SpagoPath) -> m Text -> m SpagoPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sh Text -> m Text
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shS (String -> [Text] -> Sh Text
run String
"which" [Text
"spago"])

--------------------------------------------------------------------------------
-- | add the filepath onto the PATH env variable
prependToPath :: Sh.FilePath -> Sh ()
prependToPath :: String -> Sh ()
prependToPath String
fp = do
  Text
tp <- String -> Sh Text
toTextWarn String
fp
  Text
pe <- Text -> Sh Text
get_env_text Text
"PATH"
  Text -> Text -> Sh ()
setenv Text
"PATH" (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$ Text
tp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
':' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pe

--------------------------------------------------------------------------------
installSpago :: MonadIO m => m ()
installSpago :: m ()
installSpago = Sh () -> m ()
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shS (Sh () -> m ()) -> Sh () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> [Text] -> Sh ()
run_ String
"npm" [Text
"install", Text
"spago"]

--------------------------------------------------------------------------------
spagoInstalled :: T.Text -> SpagoPath -> Sh Bool
spagoInstalled :: Text -> SpagoPath -> Sh Bool
spagoInstalled Text
psPath (SpagoPath String
pp) = Bool -> Sh Bool -> Sh Bool
forall a. Bool -> Sh a -> Sh a
errExit Bool
False (Sh Bool -> Sh Bool) -> Sh Bool -> Sh Bool
forall a b. (a -> b) -> a -> b
$ Sh Bool -> Sh Bool
forall a. Sh a -> Sh a
verbosely (Sh Bool -> Sh Bool) -> Sh Bool -> Sh Bool
forall a b. (a -> b) -> a -> b
$ do
  Sh Bool
check Sh Bool -> (SomeException -> Sh Bool) -> Sh Bool
forall a. Sh a -> (SomeException -> Sh a) -> Sh a
`catchany_sh` \(SomeException
e :: SomeException) -> do
    Text -> Sh ()
echo (String -> Text
forall a b. StringConv a b => a -> b
toS (String -> Text)
-> (SomeException -> String) -> SomeException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show (SomeException -> Text) -> SomeException -> Text
forall a b. (a -> b) -> a -> b
$ SomeException
e)
    Bool -> Sh Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  where
    check :: Sh Bool
check = do
      String -> Sh ()
prependToPath (Text -> String
fromText Text
psPath)
      String -> [Text] -> Sh ()
run_ (ShowS
forall a. IsString a => String -> a
fromString String
pp) [Text
"--version"]
      Int
eC <- Sh Int
lastExitCode
      Bool -> Sh Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Sh Bool) -> Bool -> Sh Bool
forall a b. (a -> b) -> a -> b
$ case Int
eC of
          Int
0  -> Bool
True
          Int
1  -> Bool
True
          Int
_  -> Bool
False

--------------------------------------------------------------------------------
-- | Returns the `CompilationMode` the Snaplet should be using.
-- It will default to `CompileAlways` if your Snap app was compiled with
-- -fdevelopment or the environment is "devel", `CompileOnce` otherwise.
-- Consider using `CompileNever` if you do not want this snaplet to build
-- your .js bundle on the fly, for example if you have frozen its content and
-- you want to serve it straigth away in production.
getCompilationFlavour :: Initializer b v CompilationMode
getCompilationFlavour :: Initializer b v CompilationMode
getCompilationFlavour = do
 -- Any input for the user have highest priority
 Config
cfg <- Initializer b v Config
forall (m :: * -> * -> * -> *) b v.
(Monad (m b v), MonadSnaplet m) =>
m b v Config
getSnapletUserConfig
 Maybe CompilationMode
cm <- IO (Maybe CompilationMode)
-> Initializer b v (Maybe CompilationMode)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Config -> Text -> IO (Maybe CompilationMode)
forall a. Configured a => Config -> Text -> IO (Maybe a)
Cfg.lookup Config
cfg Text
"compilationMode")
 case Maybe CompilationMode
cm of
  Just CompilationMode
c -> CompilationMode -> Initializer b v CompilationMode
forall (m :: * -> *) a. Monad m => a -> m a
return CompilationMode
c
  Maybe CompilationMode
Nothing -> do
    Bool
inDevelMode <- (String
"devel" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool) -> Initializer b v String -> Initializer b v Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Initializer b v String
forall b v. Initializer b v String
getEnvironment
    CompilationMode -> Initializer b v CompilationMode
forall (m :: * -> *) a. Monad m => a -> m a
return (CompilationMode -> Initializer b v CompilationMode)
-> CompilationMode -> Initializer b v CompilationMode
forall a b. (a -> b) -> a -> b
$ if Bool
inDevelMode Bool -> Bool -> Bool
|| Bool
devFlagEnabled
               then CompilationMode
CompileAlways
               else CompilationMode
CompileOnce

--------------------------------------------------------------------------------
getDestDir :: (Monad (m b v), MonadIO (m b v), MonadSnaplet m) => m b v T.Text
getDestDir :: m b v Text
getDestDir = do
  String
fp <- m b v String
forall (m :: * -> * -> * -> *) b v.
(Monad (m b v), MonadSnaplet m) =>
m b v String
getSnapletFilePath
  Text -> m b v Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m b v Text) -> Text -> m b v Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
fp

--------------------------------------------------------------------------------
getSpagoFile :: (Monad (m b v), MonadIO (m b v), MonadSnaplet m) => m b v T.Text
getSpagoFile :: m b v Text
getSpagoFile = (Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
"/spago.dhall") (Text -> Text) -> m b v Text -> m b v Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b v Text
forall (m :: * -> * -> * -> *) b v.
(Monad (m b v), MonadIO (m b v), MonadSnaplet m) =>
m b v Text
getDestDir

--------------------------------------------------------------------------------
getAbsoluteOutputDir :: Handler b PureScript T.Text
getAbsoluteOutputDir :: Handler b PureScript Text
getAbsoluteOutputDir = do
  Text
wDir <- (PureScript -> Text) -> Handler b PureScript Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PureScript -> Text
pursPwdDir
  Text
oDir <- (PureScript -> Text) -> Handler b PureScript Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PureScript -> Text
pursOutputDir
  Text -> Handler b PureScript Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Handler b PureScript Text)
-> Text -> Handler b PureScript Text
forall a b. (a -> b) -> a -> b
$ Text
wDir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
oDir