project-template 0.1.3.2 → 0.1.4
raw patch · 3 files changed
+71/−35 lines, 3 filesdep −base64-conduitdep −basic-preludedep ~conduit
Dependencies removed: base64-conduit, basic-prelude
Dependency ranges changed: conduit
Files
- Text/ProjectTemplate.hs +59/−21
- project-template.cabal +2/−5
- test/Text/ProjectTemplateSpec.hs +10/−9
Text/ProjectTemplate.hs view
@@ -1,11 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-} module Text.ProjectTemplate ( -- * Create a template createTemplate@@ -19,31 +17,39 @@ , ProjectTemplateException (..) ) where -import BasicPrelude-import Data.Conduit-import Data.Conduit.List (sinkNull, consume)+import Control.Exception (Exception, assert)+import Control.Monad (unless)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Class (lift) import Control.Monad.Writer (MonadWriter, tell)+import Data.ByteString (ByteString)+import qualified Data.ByteString as S import qualified Data.ByteString.Base64 as B64-import Data.Typeable (Typeable)-import Filesystem (createTree)-import Filesystem.Path.CurrentOS (directory, fromText, toText, encodeString)-import qualified Data.Conduit.Base64+import qualified Data.ByteString.Lazy as L+import Data.Conduit (Conduit, MonadResource, MonadThrow,+ Sink, await, awaitForever, leftover,+ monadThrow, yield, ($$), (=$),+ (=$=)) import qualified Data.Conduit.Binary as CB-import qualified Data.Conduit.Text as CT+import Data.Conduit.List (consume, sinkNull) import qualified Data.Conduit.List as CL-import Data.Text.Encoding (encodeUtf8)-import qualified Data.ByteString.Lazy as L-import qualified Data.Map as Map+import qualified Data.Conduit.Text as CT+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8)+import Data.Typeable (Typeable)+import Filesystem (createTree)+import Filesystem.Path.CurrentOS (FilePath, directory, encodeString,+ fromText, toText, (</>))+import Prelude hiding (FilePath) -- | Create a template file from a stream of file/contents combinations. -- -- Since 0.1.0 createTemplate-#if MIN_VERSION_conduit(1, 0, 0) :: Monad m => Conduit (FilePath, m ByteString) m ByteString-#else- :: Monad m => GInfConduit (FilePath, m ByteString) m ByteString-#endif createTemplate = awaitForever $ \(fp, getBS) -> do bs <- lift getBS case yield bs $$ CT.decode CT.utf8 =$ sinkNull of@@ -88,7 +94,7 @@ Nothing -> lift $ monadThrow $ InvalidInput t Just (fp', isBinary) -> do let src- | isBinary = binaryLoop =$= Data.Conduit.Base64.decode+ | isBinary = binaryLoop =$= decode64 | otherwise = textLoop True src =$ perFile (fromText fp') start@@ -114,7 +120,7 @@ textLoop False getFileName t =- case words t of+ case T.words t of ["{-#", "START_FILE", fn, "#-}"] -> Just (fn, False) ["{-#", "START_FILE", "BASE64", fn, "#-}"] -> Just (fn, True) _ -> Nothing@@ -143,7 +149,7 @@ -- > execWriter $ runExceptionT_ $ src $$ unpackTemplate receiveMem id -- -- Since 0.1.0-receiveMem :: MonadWriter (Map FilePath LByteString) m+receiveMem :: MonadWriter (Map FilePath L.ByteString) m => FileReceiver m receiveMem fp = do bss <- consume@@ -156,3 +162,35 @@ | BinaryLoopNeedsOneLine deriving (Show, Typeable) instance Exception ProjectTemplateException++decode64 :: Monad m => Conduit ByteString m ByteString+decode64 = codeWith 4 B64.decodeLenient++codeWith :: Monad m => Int -> (ByteString -> ByteString) -> Conduit ByteString m ByteString+codeWith size f =+ loop+ where+ loop = await >>= maybe (return ()) push++ loopWith bs+ | S.null bs = loop+ | otherwise = await >>= maybe (yield (f bs)) (pushWith bs)++ push bs = do+ let (x, y) = S.splitAt (len - (len `mod` size)) bs+ unless (S.null x) $ yield $ f x+ loopWith y+ where+ len = S.length bs++ pushWith bs1 bs2 | S.length bs1 + S.length bs2 < size = loopWith (S.append bs1 bs2)+ pushWith bs1 bs2 = assertion1 $ assertion2 $ do+ yield $ f bs1'+ push y+ where+ m = S.length bs1 `mod` size+ (x, y) = S.splitAt (size - m) bs2+ bs1' = S.append bs1 x++ assertion1 = assert $ S.length bs1 < size+ assertion2 = assert $ S.length bs1' `mod` size == 0
project-template.cabal view
@@ -1,5 +1,5 @@ name: project-template-version: 0.1.3.2+version: 0.1.4 synopsis: Specify Haskell project templates and generate files description: See initial blog post for explanation: <http://www.yesodweb.com/blog/2012/09/project-templates> homepage: https://github.com/fpco/haskell-ide@@ -14,16 +14,14 @@ library exposed-modules: Text.ProjectTemplate build-depends: base >= 4 && < 5- , basic-prelude >= 0.3.5 , base64-bytestring- , base64-conduit , system-filepath >= 0.4 , system-fileio >= 0.3 , text >= 0.11 , bytestring >= 0.9 , transformers >= 0.2 , mtl >= 2.0- , conduit >= 0.5.4+ , conduit >= 1.0 && < 1.1 , resourcet >= 0.4.3 , containers ghc-options: -Wall@@ -35,7 +33,6 @@ type: exitcode-stdio-1.0 build-depends: base , project-template- , basic-prelude , hspec >= 1.3 , transformers , QuickCheck
test/Text/ProjectTemplateSpec.hs view
@@ -1,22 +1,23 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoImplicitPrelude #-} module Text.ProjectTemplateSpec where import Test.Hspec import Test.Hspec.QuickCheck import Text.ProjectTemplate-import BasicPrelude import Data.Conduit import Control.Monad.Trans.Writer (execWriter) import Test.QuickCheck.Arbitrary import Data.Char (isAlphaNum) import qualified Data.ByteString.Base64 as B64-import Data.Text (pack, unpack)-import Data.Text.Lazy (toChunks, fromChunks) import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S import qualified Data.Map as Map import Filesystem.Path.CurrentOS (decodeString)+import Control.Arrow (second, (***))+import Control.Applicative ((<$>))+import Data.Monoid (mconcat, mappend)+import Prelude hiding (FilePath)+import Filesystem.Path (FilePath) spec :: Spec spec = do@@ -29,16 +30,16 @@ $$ createTemplate =$ unpackTemplate receiveMem id m'' = Map.fromList $ map (second $ mconcat . L.toChunks) $ Map.toList m'- in if m == m'' then True else error (unpack $ show m'')+ in if m == m'' then True else error (show m'') describe "binaries" $ do- prop "works with multilines" $ \words ->- let bs = S.pack words+ prop "works with multilines" $ \words' ->+ let bs = S.pack words' encoded = B64.joinWith "\n" 5 $ B64.encode bs- content = "{-# START_FILE BASE64 foo #-}\n" ++ encoded+ content = "{-# START_FILE BASE64 foo #-}\n" `mappend` encoded m = execWriter $ runExceptionT_ $ yield content $$ unpackTemplate receiveMem id in Map.lookup "foo" m == Just (L.fromChunks [bs]) -newtype Helper = Helper (Map FilePath ByteString)+newtype Helper = Helper (Map.Map FilePath S.ByteString) deriving (Show, Eq) instance Arbitrary Helper where