---------------------------------------------------------------------
--
-- Module      :   read the setting file

----------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module ShakeBake.ReadSettingFile where  

import Foundational.SettingsPage
-- import Uniform.Json
import Uniform.Yaml
import UniformBase

readSettings :: NoticeLevel -> Path Abs File -> ErrIO  Settings

{- | must be the settingsNN.yaml file, (absolute, fixed before to current dir)
 which contain the rest of the siteHeader
 returns layout and port
-}
readSettings :: NoticeLevel -> Path Abs File -> ErrIO Settings
readSettings NoticeLevel
debug Path Abs File
settingsfilename =
    do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords
                [ Text
"readSettings"
                , Text
"file"
                , forall a. PrettyStrings a => a -> Text
showPretty Path Abs File
settingsfilename
                ]
        Settings
sett3 :: Settings <- forall a. (FromJSON a, Show a) => Path Abs File -> ErrIO a
readYaml2rec Path Abs File
settingsfilename 
        forall (m :: * -> *) a. Monad m => a -> m a
return Settings
sett3