supplemented (empty) → 0.5.0.1
raw patch · 6 files changed
+327/−0 lines, 6 filesdep +QuickCheckdep +attoparsecdep +base-preludesetup-changed
Dependencies added: QuickCheck, attoparsec, base-prelude, quickcheck-instances, rebase, supplemented, tasty, tasty-hunit, tasty-quickcheck, tasty-smallcheck, transformers
Files
- LICENSE +22/−0
- Setup.hs +2/−0
- library/Supplemented.hs +175/−0
- library/Supplemented/Prelude.hs +20/−0
- supplemented.cabal +79/−0
- test/Main.hs +29/−0
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2016, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ library/Supplemented.hs view
@@ -0,0 +1,175 @@+module Supplemented+(+ Supplemented,+ runSupplemented,+ essence,+ supplement,+)+where++import Supplemented.Prelude+++{-# RULES+"essence/supplement/<*" [~2]+ forall p1 p2.+ essence p1 <* supplement p2 =+ essenceAndSupplement p1 p2+"essence/supplement/*>" [~2]+ forall p1 p2.+ essence p1 *> supplement p2 =+ essenceAndSupplement (p1 $> ()) p2+"*>/supplement" [~2]+ forall p pp.+ pp *> supplement p =+ mapSupplement (*> p) pp $> ()+"<*/supplement" [~2]+ forall p pp.+ pp <* supplement p =+ mapSupplement (*> p) pp+ #-}+++newtype Supplemented m a =+ Supplemented (Either (a, m ()) (m (a, m ())))++instance Functor m => Functor (Supplemented m) where+ {-# INLINABLE fmap #-}+ fmap f (Supplemented either1) =+ Supplemented either2+ where+ either2 =+ case either1 of+ Left (result1, supplement1) ->+ Left (f result1, supplement1)+ Right m1 ->+ Right $+ fmap (\(result1, supplement1) -> (f result1, supplement1)) $+ m1++instance Monad m => Applicative (Supplemented m) where+ {-# INLINE pure #-}+ pure a =+ Supplemented (Left (a, pure ()))+ {-# INLINABLE [2] (<*>) #-}+ (<*>) (Supplemented either1) (Supplemented either2) =+ {-# SCC "(<*>)" #-} + Supplemented either3+ where+ either3 =+ case either1 of+ Left (result1, supplement1) ->+ case either2 of+ Left (result2, supplement2) ->+ Left (result1 result2, supplement1 *> supplement2)+ Right m2 ->+ Right $+ fmap (\(result2, supplement2) -> (result1 result2, supplement2)) $+ supplement1 *> m2+ Right m1 ->+ case either2 of+ Left (result2, supplement2) ->+ Right $+ fmap (\(result1, supplement1) -> (result1 result2, supplement1 *> supplement2)) $+ m1+ Right m2 ->+ Right $+ do+ (result1, supplement1) <- m1+ supplement1+ (result2, supplement2) <- m2+ return (result1 result2, supplement2)++instance MonadPlus m => Alternative (Supplemented m) where+ {-# INLINE empty #-}+ empty =+ Supplemented (Right mzero)+ {-# INLINABLE [2] (<|>) #-}+ (<|>) (Supplemented either1) (Supplemented either2) =+ {-# SCC "(<|>)" #-} + Supplemented either3+ where+ either3 =+ Right (mplus (m either1) (m either2))+ where+ m =+ either (\(result, supplement) -> (result, return ()) <$ supplement) id++instance Monad m => Monad (Supplemented m) where+ {-# INLINE return #-}+ return =+ pure+ {-# INLINABLE (>>=) #-}+ (>>=) (Supplemented either1) k2 =+ {-# SCC "(>>=)" #-} + Supplemented either3+ where+ either3 =+ case either1 of+ Left (result1, supplement1) ->+ case k2 result1 of+ Supplemented either2 ->+ case either2 of+ Left (result2, supplement2) ->+ Left (result2, supplement1 *> supplement2)+ Right m2 ->+ Right (supplement1 *> m2)+ Right m1 ->+ Right $+ do+ (result1, supplement1) <- m1+ case k2 result1 of+ Supplemented either2 ->+ case either2 of+ Left (result2, supplement2) ->+ return (result2, supplement1 *> supplement2)+ Right m2 ->+ do+ supplement1+ m2++instance MonadPlus m => MonadPlus (Supplemented m) where+ {-# INLINE mzero #-}+ mzero =+ empty+ {-# INLINE mplus #-}+ mplus =+ (<|>)++instance MonadTrans Supplemented where+ {-# INLINE lift #-}+ lift =+ essence+++{-# INLINE runSupplemented #-}+runSupplemented :: Monad m => Supplemented m a -> m (a, m ())+runSupplemented (Supplemented either1) =+ either return id either1++{-# INLINE [2] essence #-}+essence :: Monad m => m a -> Supplemented m a+essence essence =+ Supplemented (Right (fmap (\r -> (r, return ())) essence))++{-# INLINE [2] supplement #-}+supplement :: Monad m => m () -> Supplemented m ()+supplement supplement =+ Supplemented (Left ((), supplement))++{-# INLINE [2] essenceAndSupplement #-}+essenceAndSupplement :: Monad m => m a -> m () -> Supplemented m a+essenceAndSupplement essence supplement =+ Supplemented (Right (fmap (\r -> (r, supplement)) essence))++{-# INLINE [2] mapSupplement #-}+mapSupplement :: Monad m => (m () -> m ()) -> Supplemented m a -> Supplemented m a+mapSupplement mapping (Supplemented either1) =+ Supplemented $+ case either1 of+ Left (result1, supplement1) ->+ Left (result1, mapping supplement1)+ Right m1 ->+ Right $+ fmap (\(result1, supplement1) -> (result1, mapping supplement1)) $+ m1
+ library/Supplemented/Prelude.hs view
@@ -0,0 +1,20 @@+module Supplemented.Prelude+( + module Exports,+)+where+++-- base-prelude+-------------------------+import BasePrelude as Exports++-- transformers+-------------------------+import Control.Monad.IO.Class as Exports+import Control.Monad.Trans.Class as Exports+import Control.Monad.Trans.Except as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)+import Control.Monad.Trans.Reader as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)+import Control.Monad.Trans.State.Strict as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)+import Control.Monad.Trans.Writer.Strict as Exports+import Control.Monad.Trans.Maybe as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)
+ supplemented.cabal view
@@ -0,0 +1,79 @@+name:+ supplemented+version:+ 0.5.0.1+synopsis:+ Attoparsec extension for early termination+description:+category:+ Parsing+homepage:+ https://github.com/nikita-volkov/supplemented +bug-reports:+ https://github.com/nikita-volkov/supplemented/issues +author:+ Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+ Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+ (c) 2016, Nikita Volkov+license:+ MIT+license-file:+ LICENSE+build-type:+ Simple+cabal-version:+ >=1.10+++source-repository head+ type:+ git+ location:+ git://github.com/nikita-volkov/supplemented.git+++library+ hs-source-dirs:+ library+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ other-modules:+ Supplemented.Prelude+ exposed-modules:+ Supplemented+ build-depends:+ -- + attoparsec >= 0.13 && < 0.14,+ -- + transformers >= 0.4 && < 0.6,+ base-prelude < 2+++test-suite test+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ test+ main-is:+ Main.hs+ other-modules:+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ build-depends:+ --+ supplemented,+ -- testing:+ tasty == 0.11.*,+ tasty-quickcheck == 0.8.*,+ tasty-smallcheck == 0.8.*,+ tasty-hunit == 0.9.*,+ quickcheck-instances >= 0.3.11 && < 0.4,+ QuickCheck >= 2.8.1 && < 2.9,+ --+ rebase >= 0.4 && < 0.5
+ test/Main.hs view
@@ -0,0 +1,29 @@+module Main where++import Rebase.Prelude hiding (takeWhile)+import Test.Tasty+import Test.Tasty.Runners+import Test.Tasty.HUnit+import Supplemented+++main =+ defaultMain $+ testGroup "All tests"+ [+ testCase "Supplements unite" $+ let+ result :: [Int]+ result =+ execWriter $+ runSupplemented $+ do+ essence (tell (pure 1))+ supplement (tell (pure 2))+ essence (tell (pure 3))+ supplement (tell (pure 4))+ supplement (tell (pure 5))+ pure ()+ supplement (tell (pure 6))+ in assertEqual (show result) [1, 2, 3] result+ ]