SSH server library, fork of Hackage one but hoping to get patches upstream
Clone
HTTPS:
darcs clone https://vervis.peers.community/repos/6r4Ao
SSH:
darcs clone USERNAME@vervis.peers.community:6r4Ao
Tags
TODO
test
/
EmbedTree.hs
{-# LANGUAGE TemplateHaskell, TupleSections #-}
module EmbedTree where
import Control.Applicative ((<$>))
import qualified Data.Map as Map
import Data.Map (Map)
import Instances.TH.Lift ()
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import PseudoMacros
import System.Directory
(doesFileExist, doesDirectoryExist
,getDirectoryContents
)
import System.FilePath (takeDirectory, (</>))
data Entry = File String | Directory (Map String Entry)
getFile :: Entry -> String
getFile (File contents) = contents
getFile (Directory _) = error $ "getFile: found a directory"
getDirectory :: Entry -> Map String Entry
getDirectory (File _) = error $ "getDirectory: found a file"
getDirectory (Directory contents) = contents
getEntry :: String -> Map String Entry -> Entry
getEntry name entries =
case Map.lookup name entries of
Nothing -> error $ "getEntry: " ++ name ++ " not found"
Just v -> v
instance Lift Entry where
lift (File contents) = AppE (ConE 'File) <$> [|contents|]
lift (Directory entries) = AppE (ConE 'Directory) <$> [|entries|]
readTree :: FilePath -> IO Entry
readTree path = do
isFile <- doesFileExist path
if isFile
then File <$> readFile path
else do
isDirectory <- doesDirectoryExist path
if isDirectory
then do
entries <- filter (`notElem` [".", ".."]) <$> getDirectoryContents path
Directory . Map.fromList <$> mapM (\entry -> (entry,) <$> readTree (path </> entry)) entries
else fail $ path ++ " is not a file or directory"
embedTree :: FilePath -> ExpQ
embedTree relPath = do
t <- runIO (readTree (takeDirectory $__FILE__ </> relPath))
[|t|]
|