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 (FileTree -> FileTree -> Bool
(FileTree -> FileTree -> Bool)
-> (FileTree -> FileTree -> Bool) -> Eq FileTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileTree -> FileTree -> Bool
$c/= :: FileTree -> FileTree -> Bool
== :: FileTree -> FileTree -> Bool
$c== :: FileTree -> FileTree -> Bool
Eq, ReadPrec [FileTree]
ReadPrec FileTree
Int -> ReadS FileTree
ReadS [FileTree]
(Int -> ReadS FileTree)
-> ReadS [FileTree]
-> ReadPrec FileTree
-> ReadPrec [FileTree]
-> Read FileTree
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileTree]
$creadListPrec :: ReadPrec [FileTree]
readPrec :: ReadPrec FileTree
$creadPrec :: ReadPrec FileTree
readList :: ReadS [FileTree]
$creadList :: ReadS [FileTree]
readsPrec :: Int -> ReadS FileTree
$creadsPrec :: Int -> ReadS FileTree
Read, Int -> FileTree -> ShowS
[FileTree] -> ShowS
FileTree -> String
(Int -> FileTree -> ShowS)
-> (FileTree -> String) -> ([FileTree] -> ShowS) -> Show FileTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileTree] -> ShowS
$cshowList :: [FileTree] -> ShowS
show :: FileTree -> String
$cshow :: FileTree -> String
showsPrec :: Int -> FileTree -> ShowS
$cshowsPrec :: Int -> FileTree -> ShowS
Show)
data FileType
= FileTypeFile FilePath
| FileTypeDir FilePath
deriving (FileType -> FileType -> Bool
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c== :: FileType -> FileType -> Bool
Eq, ReadPrec [FileType]
ReadPrec FileType
Int -> ReadS FileType
ReadS [FileType]
(Int -> ReadS FileType)
-> ReadS [FileType]
-> ReadPrec FileType
-> ReadPrec [FileType]
-> Read FileType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileType]
$creadListPrec :: ReadPrec [FileType]
readPrec :: ReadPrec FileType
$creadPrec :: ReadPrec FileType
readList :: ReadS [FileType]
$creadList :: ReadS [FileType]
readsPrec :: Int -> ReadS FileType
$creadsPrec :: Int -> ReadS FileType
Read, Int -> FileType -> ShowS
[FileType] -> ShowS
FileType -> String
(Int -> FileType -> ShowS)
-> (FileType -> String) -> ([FileType] -> ShowS) -> Show FileType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileType] -> ShowS
$cshowList :: [FileType] -> ShowS
show :: FileType -> String
$cshow :: FileType -> String
showsPrec :: Int -> FileType -> ShowS
$cshowsPrec :: Int -> FileType -> ShowS
Show)
getFileType :: FilePath -> IO FileType
getFileType :: String -> IO FileType
getFileType String
path = do
Bool
isFile <- String -> IO Bool
doesFileExist String
path
Bool
isDir <- String -> IO Bool
doesDirectoryExist String
path
case (Bool
isFile, Bool
isDir) of
(Bool
True, Bool
_) -> FileType -> IO FileType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileType -> IO FileType) -> FileType -> IO FileType
forall a b. (a -> b) -> a -> b
$ String -> FileType
FileTypeFile String
path
(Bool
_, Bool
True) -> FileType -> IO FileType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileType -> IO FileType) -> FileType -> IO FileType
forall a b. (a -> b) -> a -> b
$ String -> FileType
FileTypeDir String
path
(Bool, Bool)
_ ->
String -> IO FileType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO FileType) -> String -> IO FileType
forall a b. (a -> b) -> a -> b
$
String
"getFileType: Could not determine the type of file \"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
path String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\""
fileTypeToFileTree :: FileType -> IO (Maybe FileTree)
fileTypeToFileTree :: FileType -> IO (Maybe FileTree)
fileTypeToFileTree (FileTypeFile String
filePath) =
FileTree -> Maybe FileTree
forall a. a -> Maybe a
Just (FileTree -> Maybe FileTree)
-> (ByteString -> FileTree) -> ByteString -> Maybe FileTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString -> FileTree
FileTreeFile String
filePath (ByteString -> Maybe FileTree)
-> IO ByteString -> IO (Maybe FileTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
ByteString.readFile String
filePath
fileTypeToFileTree (FileTypeDir String
dir) = do
[FileTree]
fileTrees <- String -> IO [FileTree]
getFileTree String
dir
Maybe FileTree -> IO (Maybe FileTree)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FileTree -> IO (Maybe FileTree))
-> Maybe FileTree -> IO (Maybe FileTree)
forall a b. (a -> b) -> a -> b
$
case [FileTree]
fileTrees of
[] -> Maybe FileTree
forall a. Maybe a
Nothing
(FileTree
ft:[FileTree]
fts) -> FileTree -> Maybe FileTree
forall a. a -> Maybe a
Just (FileTree -> Maybe FileTree)
-> (NonEmpty FileTree -> FileTree)
-> NonEmpty FileTree
-> Maybe FileTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty FileTree -> FileTree
FileTreeDir String
dir (NonEmpty FileTree -> Maybe FileTree)
-> NonEmpty FileTree -> Maybe FileTree
forall a b. (a -> b) -> a -> b
$ FileTree
ft FileTree -> [FileTree] -> NonEmpty FileTree
forall a. a -> [a] -> NonEmpty a
:| [FileTree]
fts
getFileTree :: FilePath -> IO [FileTree]
getFileTree :: String -> IO [FileTree]
getFileTree String
templateDir = do
[String]
filePaths <- [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
listDirectory String
templateDir
let fullFilePaths :: [String]
fullFilePaths = ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
templateDir String -> ShowS
</>) [String]
filePaths
[FileType]
fileTypes <- (String -> IO FileType) -> [String] -> IO [FileType]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO FileType
getFileType [String]
fullFilePaths
[Maybe FileTree]
fileTreesWithMaybe <- (FileType -> IO (Maybe FileTree))
-> [FileType] -> IO [Maybe FileTree]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FileType -> IO (Maybe FileTree)
fileTypeToFileTree [FileType]
fileTypes
[FileTree] -> IO [FileTree]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileTree] -> IO [FileTree]) -> [FileTree] -> IO [FileTree]
forall a b. (a -> b) -> a -> b
$ [Maybe FileTree] -> [FileTree]
forall a. [Maybe a] -> [a]
catMaybes [Maybe FileTree]
fileTreesWithMaybe
getFileTreeIgnoreEmpty :: FilePath -> IO (NonEmpty FileTree)
getFileTreeIgnoreEmpty :: String -> IO (NonEmpty FileTree)
getFileTreeIgnoreEmpty String
templateDir = do
[FileTree]
fileTrees <- String -> IO [FileTree]
getFileTree String
templateDir
case [FileTree]
fileTrees of
[] ->
String -> IO (NonEmpty FileTree)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (NonEmpty FileTree))
-> String -> IO (NonEmpty FileTree)
forall a b. (a -> b) -> a -> b
$
String
"getFileTreeIgnoreEmpty: Top level template directory is empty: \"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
templateDir String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\""
(FileTree
ft:[FileTree]
fts) -> NonEmpty FileTree -> IO (NonEmpty FileTree)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty FileTree -> IO (NonEmpty FileTree))
-> NonEmpty FileTree -> IO (NonEmpty FileTree)
forall a b. (a -> b) -> a -> b
$ FileTree
ft FileTree -> [FileTree] -> NonEmpty FileTree
forall a. a -> [a] -> NonEmpty a
:| [FileTree]
fts