{-# LANGUAGE OverloadedStrings #-}
module Snap.Snaplet.PureScript.Hooks (
  getHooks
  , Hook
  , Hooks(..)
  ) where

import           Data.Configurator
import           Data.Configurator.Types (Config)
import qualified Data.Text as T
import           Shelly

--------------------------------------------------------------------------------
type Hook = Sh ()

--------------------------------------------------------------------------------
data Hooks = Hooks {
    Hooks -> Hook
preInitHook     :: Hook
  , Hooks -> Hook
postInitHook    :: Hook
  , Hooks -> Hook
preBuildHook    :: Hook
  , Hooks -> Hook
postBuildHook   :: Hook
  , Hooks -> Hook
preBundleHook   :: Hook
  , Hooks -> Hook
postBundleHook  :: Hook
  }

instance Show Hooks where
  show :: Hooks -> String
show Hooks
_ = String
"<<hooks>>"

--------------------------------------------------------------------------------
noOpHook :: Hook
noOpHook :: Hook
noOpHook = () -> Hook
forall (m :: * -> *) a. Monad m => a -> m a
return ()

--------------------------------------------------------------------------------
mkHook :: T.Text -> Hook
mkHook :: Text -> Hook
mkHook Text
"" = Hook
noOpHook
mkHook Text
t  = case Text -> [Text]
T.words Text
t of
  [] -> Hook
noOpHook
  (Text
x:[Text]
args) -> Bool -> Hook -> Hook
forall a. Bool -> Sh a -> Sh a
escaping Bool
False (Hook -> Hook) -> Hook -> Hook
forall a b. (a -> b) -> a -> b
$ String -> [Text] -> Hook
run_ (Text -> String
fromText Text
x) [Text]
args

--------------------------------------------------------------------------------
getHooks :: Config -> IO Hooks
getHooks :: Config -> IO Hooks
getHooks Config
cfg =
  Hook -> Hook -> Hook -> Hook -> Hook -> Hook -> Hooks
Hooks (Hook -> Hook -> Hook -> Hook -> Hook -> Hook -> Hooks)
-> IO Hook -> IO (Hook -> Hook -> Hook -> Hook -> Hook -> Hooks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Hook
mkHook (Text -> Hook) -> IO Text -> IO Hook
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Config -> Text -> IO Text
forall a. Configured a => a -> Config -> Text -> IO a
lookupDefault Text
"" Config
cfg Text
"hooks.preInit")
        IO (Hook -> Hook -> Hook -> Hook -> Hook -> Hooks)
-> IO Hook -> IO (Hook -> Hook -> Hook -> Hook -> Hooks)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Hook
mkHook (Text -> Hook) -> IO Text -> IO Hook
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Config -> Text -> IO Text
forall a. Configured a => a -> Config -> Text -> IO a
lookupDefault Text
"" Config
cfg Text
"hooks.postInit")
        IO (Hook -> Hook -> Hook -> Hook -> Hooks)
-> IO Hook -> IO (Hook -> Hook -> Hook -> Hooks)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Hook
mkHook (Text -> Hook) -> IO Text -> IO Hook
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Config -> Text -> IO Text
forall a. Configured a => a -> Config -> Text -> IO a
lookupDefault Text
"" Config
cfg Text
"hooks.preBuild")
        IO (Hook -> Hook -> Hook -> Hooks)
-> IO Hook -> IO (Hook -> Hook -> Hooks)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Hook
mkHook (Text -> Hook) -> IO Text -> IO Hook
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Config -> Text -> IO Text
forall a. Configured a => a -> Config -> Text -> IO a
lookupDefault Text
"" Config
cfg Text
"hooks.postBuild")
        IO (Hook -> Hook -> Hooks) -> IO Hook -> IO (Hook -> Hooks)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Hook
mkHook (Text -> Hook) -> IO Text -> IO Hook
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Config -> Text -> IO Text
forall a. Configured a => a -> Config -> Text -> IO a
lookupDefault Text
"" Config
cfg Text
"hooks.preBundle")
        IO (Hook -> Hooks) -> IO Hook -> IO Hooks
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Hook
mkHook (Text -> Hook) -> IO Text -> IO Hook
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Config -> Text -> IO Text
forall a. Configured a => a -> Config -> Text -> IO a
lookupDefault Text
"" Config
cfg Text
"hooks.postBundle")