{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}

module Language.Ginger.FileLoader
where

import System.FilePath
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Control.Monad.IO.Class (MonadIO (..))
import Data.Maybe (fromMaybe)

import Language.Ginger.Value

fileLoader :: forall m. MonadIO m
           => FilePath
           -> TemplateLoader m
fileLoader :: forall (m :: * -> *). MonadIO m => FilePath -> TemplateLoader m
fileLoader FilePath
baseDir Text
templateName = do
  let templateBasename :: FilePath
templateBasename =
          Text -> FilePath
Text.unpack (Text -> FilePath) -> (Text -> Text) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
".." Text
"" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"//" Text
"/" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
templateName (Maybe Text -> Text) -> (Text -> Maybe Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          Text -> Text -> Maybe Text
Text.stripPrefix Text
"/" (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$
            Text
templateName
      templateFilename :: FilePath
templateFilename =
          FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
templateBasename
  IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
Text.readFile FilePath
templateFilename