yaftee-conduit-bytestring-ft (empty) → 0.1.0.0

raw patch · 8 files changed

+306/−0 lines, 8 filesdep +basedep +bytestring-ftdep +higher-order-open-unionsetup-changed

Dependencies added: base, bytestring-ft, higher-order-open-union, tools-yj, typelevel-tools-yj, yaftee, yaftee-basic-monads, yaftee-conduit, yaftee-conduit-bytestring-ft

Files

• CHANGELOG.md +11/−0
• LICENSE +26/−0
• README.md +3/−0
• Setup.hs +2/−0
• src/Control/Monad/Yaftee/Pipe/ByteString/FingerTree/Crc32.hs +66/−0
• src/Control/Monad/Yaftee/Pipe/ByteString/FingerTree/OnDemand.hs +125/−0
• test/Spec.hs +2/−0
• yaftee-conduit-bytestring-ft.cabal +71/−0

@@ -0,0 +1,11 @@+# Changelog for `yaftee-conduit-bytestring-ft`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - YYYY-MM-DD

@@ -0,0 +1,26 @@+Copyright 2025 Yoshikuni Jujo++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1.  Redistributions of source code must retain the above copyright notice, this+    list of conditions and the following disclaimer.++2.  Redistributions in binary form must reproduce the above copyright notice,+    this list of conditions and the following disclaimer in the documentation+    and/or other materials provided with the distribution.++3.  Neither the name of the copyright holder nor the names of its contributors+    may be used to endorse or promote products derived from this software+    without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,3 @@+# yaftee-conduit-bytestring-ft++Finger tree-based byte string tools for Yaftee Conduit.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,66 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.ByteString.FingerTree.Crc32 (++	run, reset, complement, crc32, crc32',++	step++	) where++import Control.Monad.Fix+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.Pipe qualified as Pipe+import Control.Monad.Yaftee.State qualified as State+import Control.HigherOpenUnion qualified as U+import Data.HigherFunctor qualified as HFunctor+import Data.Word.Crc32 qualified as Crc32+import Data.ByteString.FingerTree qualified as BSF++run :: forall nm es i o r . HFunctor.Loose (U.U es) =>+	Eff.E (State.Named nm Crc32.C ': es) i o r -> Eff.E es i o (r, Crc32.C)+run = (`State.runN` Crc32.initial)++reset :: forall nm -> U.Member (State.Named nm Crc32.C) es => Eff.E es i o ()+reset nm = State.putN nm Crc32.initial++complement ::+	forall nm -> U.Member (State.Named nm Crc32.C) es => Eff.E es i o ()+complement nm = State.modifyN nm Crc32.complement++crc32 :: forall nm ->+	(U.Member Pipe.P es, U.Member (State.Named nm Crc32.C) es) =>+	Eff.E es BSF.ByteString BSF.ByteString r+crc32 nm = State.putN nm Crc32.initial >> body nm++body :: forall nm ->+	(U.Member Pipe.P es, U.Member (State.Named nm Crc32.C) es) =>+	Eff.E es BSF.ByteString BSF.ByteString r+body nm = fix \go -> Pipe.await >>= \s -> do+	State.modifyN nm (`step` s)+	Pipe.yield s+	go++crc32' :: forall nm ->+	(U.Member Pipe.P es, U.Member (State.Named nm Crc32.C) es) =>+	Eff.E es BSF.ByteString BSF.ByteString ()+crc32' nm = State.putN nm Crc32.initial >> body' nm++body' :: forall nm ->+	(U.Member Pipe.P es, U.Member (State.Named nm Crc32.C) es) =>+	Eff.E es BSF.ByteString BSF.ByteString ()+body' nm = fix \go -> Pipe.awaitMaybe >>= \case+	Nothing -> pure ()+	Just s -> do+		State.modifyN nm (`step` s)+		Pipe.yield s+		go++step :: Crc32.C -> BSF.ByteString -> Crc32.C+step = BSF.foldl' Crc32.step

@@ -0,0 +1,125 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}+{-# LANGUAGE RequiredTypeArguments #-}+{-# LANGUAGE DataKinds, ConstraintKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Monad.Yaftee.Pipe.ByteString.FingerTree.OnDemand (++	-- * RUN++	run, States,++	-- * ON DEMAND++	onDemand, onDemandWithInitial, Members, Request(..), ByteString++	) where++import Control.Monad.Fix+import Control.Monad.Yaftee.Eff qualified as Eff+import Control.Monad.Yaftee.Pipe qualified as Pipe+import Control.Monad.Yaftee.State qualified as State+import Control.Monad.Yaftee.Except qualified as Except+import Control.HigherOpenUnion qualified as U+import Data.TypeLevel.List+import Data.HigherFunctor qualified as HFunctor+import Data.Bool+import Data.ByteString.FingerTree qualified as BSF++run :: forall nm es i o a . HFunctor.Loose (U.U es) =>+	Eff.E (States nm `Append` es) i o a ->+	Eff.E es i o ((a, Request), ByteString)+run = (flip (State.runN @nm) $ ByteString BSF.Empty)+	. (flip (State.runN @nm) $ RequestBuffer 100)++type States nm = '[State.Named nm Request, State.Named nm ByteString]++onDemand :: forall nm -> (+	U.Member Pipe.P es,+	Members nm es, U.Member (Except.E String) es ) =>+	Eff.E es BSF.ByteString BSF.ByteString r+onDemand nm = fix \go -> State.getN nm >>= \case+	RequestBytes ln -> takeBytes nm ln+		>>= maybe (Except.throw errne) ((>> go) . Pipe.yield)+	RequestBuffer ln -> takeBuffer nm ln+		>>= maybe (Except.throw errne) ((>> go) . Pipe.yield)+	RequestString -> takeString nm+		>>= maybe (Except.throw errne) ((>> go) . Pipe.yield)+	RequestPushBack bs ->+		State.modifyN nm (ByteString . (bs `BSF.append`) . unByteString) >>+		Pipe.yield "" >> go+	where+	errne :: String+	errne = "Not enough ByteString"++onDemandWithInitial :: forall nm -> (+	U.Member Pipe.P es,+	Members nm es, U.Member (Except.E String) es ) =>+	BSF.ByteString -> Eff.E es BSF.ByteString BSF.ByteString r+onDemandWithInitial nm ib = do+	State.putN nm $ ByteString ib+	onDemand nm++type Members nm es = (+	U.Member (State.Named nm Request) es,+	U.Member (State.Named nm ByteString) es )++data Request+	= RequestBytes Int+	| RequestBuffer Int+	| RequestString+	| RequestPushBack BSF.ByteString+	deriving Show++newtype ByteString = ByteString { unByteString :: BSF.ByteString } deriving Show++takeBytes :: forall nm -> (+	U.Member Pipe.P es,+	U.Member (State.Named nm ByteString) es ) =>+	Int -> Eff.E es BSF.ByteString o (Maybe BSF.ByteString)+takeBytes nm ln = State.getsN nm unByteString >>= \bs ->+	case BSF.splitAt' ln bs of+		Nothing -> readMore nm >>= bool (pure Nothing) (takeBytes nm ln)+		Just (t, d) -> Just t <$ State.putN nm (ByteString d)++takeBuffer :: forall nm -> (+	U.Member Pipe.P es,+	U.Member (State.Named nm ByteString) es ) =>+	Int -> Eff.E es BSF.ByteString o (Maybe BSF.ByteString)+takeBuffer nm ln = State.getsN nm unByteString >>= \bs ->+	case BSF.splitAt' ln bs of+		Nothing -> readMore nm >>= bool+			(bool	(Just bs+					<$ State.putN nm (ByteString BSF.Empty))+				(pure Nothing) (BSF.null bs))+			(takeBuffer nm ln)+		Just (t, d) -> Just t <$ State.putN nm (ByteString d)++takeString ::+	forall nm ->+	(U.Member Pipe.P es, U.Member (State.Named nm ByteString) es) =>+	Eff.E es BSF.ByteString o (Maybe BSF.ByteString)+takeString nm = State.getsN nm unByteString >>= \bs ->+	case splitString bs of+		Nothing -> readMore nm >>= bool (pure Nothing) (takeString nm)+		Just (t, d) -> Just t <$ State.putN nm (ByteString d)++splitString :: BSF.ByteString -> Maybe (BSF.ByteString, BSF.ByteString)+splitString bs = case BSF.span (/= 0) bs of+	(_, "") -> Nothing+	(t, BSF.uncons -> Just (z, d)) -> Just (BSF.snoc t z, d)+	_ -> error "Never occur"++readMore :: forall nm -> (+	U.Member Pipe.P es,+	U.Member (State.Named nm ByteString) es ) =>+	Eff.E es BSF.ByteString o Bool+readMore nm = Pipe.awaitMaybe >>= \case+	Nothing -> pure False+	Just bs -> True <$ State.modifyN nm+		(ByteString . (`BSF.append` bs) . unByteString)

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"

@@ -0,0 +1,71 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.38.1.+--+-- see: https://github.com/sol/hpack++name:           yaftee-conduit-bytestring-ft+version:        0.1.0.0+synopsis:       Finger tree-based byte string tools for Yaftee Conduit+description:    Please see the README on GitHub at <https://github.com/YoshikuniJujo/yaftee-conduit-bytestring-ft#readme>+category:       Control+homepage:       https://github.com/YoshikuniJujo/yaftee-conduit-bytestring-ft#readme+bug-reports:    https://github.com/YoshikuniJujo/yaftee-conduit-bytestring-ft/issues+author:         Yoshikuni Jujo+maintainer:     yoshikuni.jujo@gmail.com+copyright:      (c) 2025 Yoshikuni Jujo+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+extra-doc-files:+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/YoshikuniJujo/yaftee-conduit-bytestring-ft++library+  exposed-modules:+      Control.Monad.Yaftee.Pipe.ByteString.FingerTree.Crc32+      Control.Monad.Yaftee.Pipe.ByteString.FingerTree.OnDemand+  other-modules:+      Paths_yaftee_conduit_bytestring_ft+  autogen-modules:+      Paths_yaftee_conduit_bytestring_ft+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , bytestring-ft ==0.1.*+    , higher-order-open-union ==0.1.*+    , tools-yj ==0.1.*+    , typelevel-tools-yj ==0.1.*+    , yaftee ==0.1.*+    , yaftee-basic-monads ==0.1.*+    , yaftee-conduit ==0.1.*+  default-language: Haskell2010++test-suite yaftee-conduit-bytestring-ft-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_yaftee_conduit_bytestring_ft+  autogen-modules:+      Paths_yaftee_conduit_bytestring_ft+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , bytestring-ft ==0.1.*+    , higher-order-open-union ==0.1.*+    , tools-yj ==0.1.*+    , typelevel-tools-yj ==0.1.*+    , yaftee ==0.1.*+    , yaftee-basic-monads ==0.1.*+    , yaftee-conduit ==0.1.*+    , yaftee-conduit-bytestring-ft+  default-language: Haskell2010