module Web.Minion.Embed where

import Control.Monad.IO.Class (MonadIO (..))
import FileEmbedLzma.Untyped
import Language.Haskell.TH
import System.Directory

indexName :: FilePath
indexName :: FilePath
indexName = FilePath
"index.html.tmpl"

fixPath :: (MonadIO m) => FilePath -> m FilePath
fixPath :: forall (m :: * -> *). MonadIO m => FilePath -> m FilePath
fixPath FilePath
path = IO FilePath -> m FilePath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  FilePath
currDirectory <- IO FilePath
getCurrentDirectory
  [FilePath]
curDirectoryContents <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
currDirectory
  FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    if FilePath
indexName FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
curDirectoryContents
      then FilePath
currDirectory FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path
      else FilePath
currDirectory FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/minion-openapi3/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path

embedIndex :: Q Exp
embedIndex :: Q Exp
embedIndex = FilePath -> Q FilePath
forall (m :: * -> *). MonadIO m => FilePath -> m FilePath
fixPath FilePath
indexName Q FilePath -> (FilePath -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Q Exp
embedText

embedUi :: Q Exp
embedUi :: Q Exp
embedUi = FilePath -> Q FilePath
forall (m :: * -> *). MonadIO m => FilePath -> m FilePath
fixPath FilePath
"ui" Q FilePath -> (FilePath -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Q Exp
embedRecursiveDir