{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoOverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
module Salak(
runSalak
, runSalakWith
, loadAndRunSalak
, loadAndRunSalak'
, PropConfig(..)
, MonadSalak(..)
, RunSalakT
, RunSalak
, PropOp(..)
, FromProp(..)
, Prop
, readPrimitive
, readEnum
, SourcePack
, Salak
, SalakException(..)
, module Salak.Internal.Writable
, LoadSalakT
, LoadSalak
, loadCommandLine
, ParseCommandLine
, defaultParseCommandLine
, loadEnv
, loadMock
, loadSalak
, loadSalakWith
, ExtLoad
, loadByExt
, HasLoad(..)
, (:|:)(..)
, ReloadResult(..)
, MonadCatch
, MonadThrow
, MonadIO
) where
import Control.Monad.Catch
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.IO.Unlift
import Control.Monad.Reader
import Data.Default
import Data.Maybe
import Data.Text (Text)
import Salak.Internal
import Salak.Internal.Prop
import Salak.Internal.Source
import Salak.Internal.Writable
import System.Directory
import System.FilePath ((</>))
type Salak = SourcePack
data PropConfig = PropConfig
{ configKey :: !Text
, configName :: !String
, searchCurrent :: !Bool
, searchHome :: !Bool
, commandLine :: !ParseCommandLine
, loggerF :: !LFunc
, loadExt :: FilePath -> LoadSalak ()
}
instance Default PropConfig where
def = PropConfig
"application"
"application"
True
False
defaultParseCommandLine
(\_ -> return ())
(\_ -> return ())
data FileConfig = FileConfig
{ configNm :: Maybe String
, configDir :: Maybe FilePath
}
instance FromProp m FileConfig where
{-# INLINE fromProp #-}
fromProp = FileConfig
<$> "name" .?= Nothing
<*> "dir" .?= Nothing
type ExtLoad = (String, FilePath -> LoadSalak ())
class HasLoad a where
loaders :: a -> [ExtLoad]
data a :|: b = a :|: b
infixr 3 :|:
instance (HasLoad a, HasLoad b) => HasLoad (a :|: b) where
loaders (a :|: b) = loaders a ++ loaders b
loadByExt :: HasLoad a => a -> FilePath -> LoadSalak ()
loadByExt xs f = mapM_ go (loaders xs)
where
{-# INLINE go #-}
go (ext, ly) = tryLoadFile ly $ f ++ "." ++ ext
loadSalak :: (MonadThrow m, MonadIO m) => PropConfig -> LoadSalakT m ()
loadSalak PropConfig{..} = do
setLogF loggerF
loadCommandLine commandLine
loadEnv
FileConfig{..} <- require configKey
forM_
[ return configDir
, ifS searchCurrent getCurrentDirectory
, ifS searchHome getHomeDirectory
] (loadConf $ fromMaybe configName configNm)
where
{-# INLINE ifS #-}
ifS True gxd = Just <$> liftIO gxd
ifS _ _ = return Nothing
{-# INLINE loadConf #-}
loadConf n mf = lift mf >>= mapM_ (liftNT . loadExt . (</> n))
loadSalakWith :: (MonadThrow m, MonadIO m, HasLoad file) => file -> String -> LoadSalakT m ()
loadSalakWith file name = loadSalak def { configName = name, loadExt = loadByExt file }
runSalak :: (MonadCatch m, MonadIO m) => PropConfig -> RunSalakT m a -> m a
runSalak c = loadAndRunSalak (loadSalak c)
runSalakWith :: (MonadCatch m, MonadIO m, HasLoad file) => String -> file -> RunSalakT m a -> m a
runSalakWith name file = loadAndRunSalak (loadSalakWith file name)