SSH server library, fork of Hackage one but hoping to get patches upstream

[[ 🗃 ^6r4Ao ssh ]] :: [📥 Inbox] [📤 Outbox] [🐤 Followers] [🤝 Collaborators] [🛠 Changes]

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|]
[See repo JSON]