module Servant.Static.TH.Internal.FileTree where
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import Data.List (sort)
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Maybe (catMaybes)
import Data.Monoid ((<>))
import System.Directory
(doesDirectoryExist, doesFileExist, listDirectory)
import System.FilePath ((</>))
data FileTree
= FileTreeFile FilePath ByteString
| FileTreeDir FilePath (NonEmpty FileTree)
deriving (Eq, Read, Show)
data FileType
= FileTypeFile FilePath
| FileTypeDir FilePath
deriving (Eq, Read, Show)
getFileType :: FilePath -> IO FileType
getFileType path = do
isFile <- doesFileExist path
isDir <- doesDirectoryExist path
case (isFile, isDir) of
(True, _) -> pure $ FileTypeFile path
(_, True) -> pure $ FileTypeDir path
_ ->
fail $
"getFileType: Could not determine the type of file \"" <> path <> "\""
fileTypeToFileTree :: FileType -> IO (Maybe FileTree)
fileTypeToFileTree (FileTypeFile filePath) =
Just . FileTreeFile filePath <$> ByteString.readFile filePath
fileTypeToFileTree (FileTypeDir dir) = do
fileTrees <- getFileTree dir
pure $
case fileTrees of
[] -> Nothing
(ft:fts) -> Just . FileTreeDir dir $ ft :| fts
getFileTree :: FilePath -> IO [FileTree]
getFileTree templateDir = do
filePaths <- sort <$> listDirectory templateDir
let fullFilePaths = fmap (templateDir </>) filePaths
fileTypes <- traverse getFileType fullFilePaths
fileTreesWithMaybe <- traverse fileTypeToFileTree fileTypes
pure $ catMaybes fileTreesWithMaybe
getFileTreeIgnoreEmpty :: FilePath -> IO (NonEmpty FileTree)
getFileTreeIgnoreEmpty templateDir = do
fileTrees <- getFileTree templateDir
case fileTrees of
[] ->
fail $
"getFileTreeIgnoreEmpty: Top level template directory is empty: \"" <>
templateDir <> "\""
(ft:fts) -> pure $ ft :| fts