diff --git a/Text/ProjectTemplate.hs b/Text/ProjectTemplate.hs --- a/Text/ProjectTemplate.hs +++ b/Text/ProjectTemplate.hs @@ -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 diff --git a/project-template.cabal b/project-template.cabal --- a/project-template.cabal +++ b/project-template.cabal @@ -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: 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 diff --git a/test/Text/ProjectTemplateSpec.hs b/test/Text/ProjectTemplateSpec.hs --- a/test/Text/ProjectTemplateSpec.hs +++ b/test/Text/ProjectTemplateSpec.hs @@ -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