From c3c0d0eaedd1a9f53df2a4f97a46979be1abfdf2 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 7 Nov 2012 10:59:18 +0200 Subject: [PATCH] Switch to project-template --- yesod/MultiFile.hs | 93 --------------------------------- yesod/Scaffolding/Scaffolder.hs | 6 +-- yesod/yesod.cabal | 4 +- 3 files changed, 5 insertions(+), 98 deletions(-) delete mode 100644 yesod/MultiFile.hs diff --git a/yesod/MultiFile.hs b/yesod/MultiFile.hs deleted file mode 100644 index be382ef2..00000000 --- a/yesod/MultiFile.hs +++ /dev/null @@ -1,93 +0,0 @@ --- FIXME: Depend on the not-yet-released project-template library. -{-# LANGUAGE OverloadedStrings #-} -module MultiFile where - -import Control.Monad (unless) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Trans.Resource (runExceptionT) -import qualified Data.ByteString as S -import qualified Data.ByteString.Base64 as B64 -import Data.Conduit (Conduit, MonadResource, Sink, - await, awaitForever, leftover, - yield, ($$), (=$)) -import Data.Conduit.Binary (sinkFile) -import Data.Conduit.List (sinkNull) -import qualified Data.Conduit.List as CL -import qualified Data.Conduit.Text as CT -import Data.Functor.Identity (runIdentity) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Text.Encoding (encodeUtf8) -import Filesystem (createTree) -import Filesystem.Path.CurrentOS (FilePath, directory, encode, - encodeString, fromText, ()) -import Prelude hiding (FilePath) - -unpackMultiFile - :: MonadResource m - => FilePath -- ^ output folder - -> (Text -> Text) -- ^ fix each input line, good for variables - -> Sink S.ByteString m () -unpackMultiFile root fixLine = - CT.decode CT.utf8 =$ CT.lines =$ CL.map fixLine =$ start - where - start = - await >>= maybe (return ()) go - where - go t = - case getFileName t of - Nothing -> error $ "Invalid input: " ++ show t - Just (fp', isBinary) -> do - let fp = root fromText fp' - liftIO $ createTree $ directory fp - let src - | isBinary = binaryLoop - | otherwise = textLoop - src =$ sinkFile (encodeString fp) - start - - binaryLoop = do - await >>= maybe (error "binaryLoop needs 1 line") go - where - go = yield . B64.decodeLenient . encodeUtf8 - textLoop = - await >>= maybe (return ()) go - where - go t = - case getFileName t of - Just{} -> leftover t - Nothing -> do - yield $ encodeUtf8 t - yield "\n" - textLoop - - getFileName t = - case T.words t of - ["{-#", "START_FILE", fn, "#-}"] -> Just (fn, False) - ["{-#", "START_FILE", "BASE64", fn, "#-}"] -> Just (fn, True) - _ -> Nothing - -createMultiFile - :: MonadIO m - => FilePath -- ^ folder containing the files - -> Conduit FilePath m S.ByteString -- ^ FilePath is relative to containing folder -createMultiFile root = do - awaitForever handleFile - where - handleFile fp' = do - bs <- liftIO $ S.readFile $ encodeString fp - case runIdentity $ runExceptionT $ yield bs $$ CT.decode CT.utf8 =$ sinkNull of - Left{} -> do - yield "{-# START_FILE BASE64 " - yield $ encode fp' - yield " #-}\n" - yield $ B64.encode bs - yield "\n" - Right{} -> do - yield "{-# START_FILE " - yield $ encode fp' - yield " #-}\n" - yield bs - unless ("\n" `S.isSuffixOf` bs) $ yield "\n" - where - fp = root fp' diff --git a/yesod/Scaffolding/Scaffolder.hs b/yesod/Scaffolding/Scaffolder.hs index 95d505b2..5b59c772 100644 --- a/yesod/Scaffolding/Scaffolder.hs +++ b/yesod/Scaffolding/Scaffolder.hs @@ -10,7 +10,7 @@ import Data.String (fromString) import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.IO as TLIO -import MultiFile (unpackMultiFile) +import Text.ProjectTemplate (unpackTemplate, receiveFS) import System.IO import Text.Shakespeare.Text (renderTextUrl, textFile) @@ -74,8 +74,8 @@ scaffold = do putStrLn "That's it! I'm creating your files now..." - let sink = unpackMultiFile - (fromString project) + let sink = unpackTemplate + (receiveFS $ fromString project) (T.replace "PROJECTNAME" (T.pack project)) runResourceT $ yield (backendBS backend) $$ sink diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index c13a4fe6..b8123871 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -106,11 +106,11 @@ executable yesod , http-reverse-proxy >= 0.1.0.4 , network , http-conduit + , project-template >= 0.1 ghc-options: -Wall -threaded main-is: main.hs - other-modules: MultiFile - Scaffolding.Scaffolder + other-modules: Scaffolding.Scaffolder Devel Build GhcBuild