{- |
Module      :  Servant.Static.TH.Internal.FileTree

Copyright   :  Dennis Gosnell 2017
License     :  BSD3

Maintainer  :  Dennis Gosnell (cdep.illabout@gmail.com)
Stability   :  experimental
Portability :  unknown

Read a directory and the contents of all the files in it as a 'FileTree'.
-}

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 ((</>))

-- | This tree structure represents the directory structure on disk.
data FileTree
  = FileTreeFile FilePath ByteString
  -- ^ A file with it's 'FilePath' and contents as a 'ByteString'.
  | FileTreeDir FilePath (NonEmpty FileTree)
  -- ^ A directory with it's 'FilePath' and the files under it.
  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)

-- | This is a simple version of 'FileTree', just used for tagging a given
-- 'FilePath' as a directory or a file.
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)

-- | Get the 'FileType' for a given 'FilePath'.  Calls 'fail' if it is not a
-- file or a directory.
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
"\""

-- | Convert a 'FileType' to a 'FileTree'.  Return 'Nothing' if the input
-- 'FileType' is 'FileTypeDir', and that directory is empty.
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

-- | Convert an input directory 'FilePath' to a 'FileTree'.  Fails if the input
-- directory 'FilePath' is not a directory.
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

-- | Just like 'getFileTree', but returns an error with 'fail' if the input
-- directory is empty.
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