haskus-utils 1.0 → 1.1

raw patch · 5 files changed

+40/−199 lines, 5 filesdep ~haskus-utils-datadep ~haskus-utils-typesdep ~haskus-utils-variantPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: haskus-utils-data, haskus-utils-types, haskus-utils-variant

API changes (from Hackage documentation)

Files

• CHANGES +0/−8
• haskus-utils.cabal +19/−38
• src/lib/Haskus/Utils/Parser.hs +21/−20
• src/tests/Haskus/Tests/Utils.hs +0/−4
• src/tests/Haskus/Tests/Utils/Variant.hs +0/−129

@@ -1,8 +0,0 @@-0.9.0.0 - TBA-=============---0.8.0.0 - 2018-02-21-====================--* Enhanced Variant API

@@ -1,19 +1,17 @@-name: haskus-utils-version: 1.0 cabal-version: >=1.21-build-type: Simple+name: haskus-utils+version: 1.1 license: BSD3 license-file: LICENSE copyright: Sylvain Henry 2018 maintainer: sylvain@haskus.fr-homepage: http://www.haskus.org/system+author: Sylvain Henry+homepage: http://docs.haskus.org/ synopsis: Haskus utility modules description:-    Haskus utility modules. Reexport all other utility modules+    Haskus utility modules. category: System-author: Sylvain Henry-extra-source-files:-    CHANGES+build-type: Simple  source-repository head     type: git@@ -35,27 +33,14 @@         Haskus.Utils.STM.TTree         Haskus.Utils.STM.Future         Haskus.Utils.STM.TGraph-    reexported-modules: Haskus.Utils.Types,-                        Haskus.Utils.Types.Generics,-                        Haskus.Utils.Types.List,-                        Haskus.Utils.Monad,-                        Haskus.Utils.HList,-                        Haskus.Utils.Functor,-                        Haskus.Utils.List,-                        Haskus.Utils.Map,-                        Haskus.Utils.Map.Strict,-                        Haskus.Utils.Maybe,-                        Haskus.Utils.Tuple,-                        Haskus.Utils.ContFlow,-                        Haskus.Utils.Variant,-                        Haskus.Utils.Variant.Flow,-                        Haskus.Utils.Variant.Cont,-                        Haskus.Utils.EADT+    hs-source-dirs: src/lib+    default-language: Haskell2010+    ghc-options: -Wall     build-depends:         base >=4.9 && <4.12,-        haskus-utils-types ==1.0.*,-        haskus-utils-data ==1.0.*,-        haskus-utils-variant ==1.0.*,+        haskus-utils-types ==1.1.*,+        haskus-utils-data ==1.1.*,+        haskus-utils-variant ==2.0.*,         containers ==0.5.*,         list-t >=0.4 && <1.1,         stm ==2.4.*,@@ -67,23 +52,19 @@         file-embed >=0.0.10 && <0.1,         extra >=1.4 && <1.7,         recursion-schemes ==5.0.*-    default-language: Haskell2010-    hs-source-dirs: src/lib-    ghc-options: -Wall -test-suite  tests+test-suite tests     type: exitcode-stdio-1.0     main-is: Main.hs-    build-depends:-        base >=4.11.1.0 && <4.12,-        haskus-utils -any,-        tasty >=0.11 && <1.2,-        tasty-quickcheck >=0.8 && <0.11-    default-language: Haskell2010     hs-source-dirs: src/tests     other-modules:         Haskus.Tests.Utils         Haskus.Tests.Utils.HArray-        Haskus.Tests.Utils.Variant         Haskus.Tests.Utils.Solver+    default-language: Haskell2010     ghc-options: -Wall -threaded+    build-depends:+        base >=4.11.1.0 && <4.12,+        haskus-utils -any,+        tasty >=0.11 && <1.2,+        tasty-quickcheck >=0.8 && <0.11

@@ -8,6 +8,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeOperators #-}  -- | Tools to write parsers using Flows module Haskus.Utils.Parser@@ -54,7 +55,7 @@       ( x ~ Flow m xs       , y ~ Flow m ys       , z ~ Flow m zs-      , Popable a xs+      , a :< xs       , Liftable ys zs       , Liftable (Filter a xs) zs       , zs ~ Union (Filter a xs) ys@@ -86,8 +87,8 @@ many ::    ( zs ~ Filter ParseError xs    , Monad m-   , Popable ParseError xs-   ) => Flow m xs -> Flow m '[[Variant zs]]+   , ParseError :< xs+   ) => Flow m xs -> Flow m '[[V zs]] many f = manyBounded Nothing Nothing f             >%~^> \(_ :: ParseError) -> flowSingle [] @@ -96,8 +97,8 @@ manyAtMost ::    ( zs ~ Filter ParseError xs    , Monad m-   , Popable ParseError xs-   ) => Word -> Flow m xs -> Flow m '[[Variant zs]]+   , ParseError :< xs+   ) => Word -> Flow m xs -> Flow m '[[V zs]] manyAtMost max f = manyBounded Nothing (Just max) f                      >%~^> \(_ :: ParseError) -> flowSingle [] @@ -106,8 +107,8 @@ manyAtMost' ::    ( zs ~ Filter ParseError xs    , Monad m-   , Popable ParseError xs-   ) => Word -> Flow m xs -> m [Variant zs]+   , ParseError :< xs+   ) => Word -> Flow m xs -> m [V zs] manyAtMost' max f = variantToValue <$> manyAtMost max f  -- | Apply the action zero or more times (up to max) until a ParseError result@@ -115,7 +116,7 @@ manyAtMost'' ::    ( '[x] ~ Filter ParseError xs    , Monad m-   , Popable ParseError xs+   , ParseError :< xs    ) => Word -> Flow m xs -> m [x] manyAtMost'' max f = fmap variantToValue <$> manyAtMost' max f @@ -124,8 +125,8 @@ manyAtLeast ::    ( zs ~ Filter ParseError xs    , Monad m-   , Popable ParseError xs-   ) => Word -> Flow m xs -> Flow m '[[Variant zs],ParseError]+   , ParseError :< xs+   ) => Word -> Flow m xs -> Flow m '[[V zs],ParseError] manyAtLeast min = manyBounded (Just min) Nothing  -- | Apply the first action zero or more times until the second succeeds.@@ -136,9 +137,9 @@    ( zs ~ Filter ParseError xs    , zs' ~ Filter ParseError ys    , Monad m-   , MaybePopable ParseError xs-   , Popable ParseError ys-   ) => Flow m xs -> Flow m ys -> Flow m '[([Variant zs],Variant zs'),ParseError]+   , ParseError :<? xs+   , ParseError :< ys+   ) => Flow m xs -> Flow m ys -> Flow m '[([V zs],V zs'),ParseError] manyTill f g = go []    where       go xs = do@@ -159,9 +160,9 @@ manyTill' ::    ( zs ~ Filter ParseError xs    , Monad m-   , MaybePopable ParseError xs-   , Popable ParseError ys-   ) => Flow m xs -> Flow m ys -> Flow m '[[Variant zs],ParseError]+   , ParseError :<? xs+   , ParseError :< ys+   ) => Flow m xs -> Flow m ys -> Flow m '[[V zs],ParseError] manyTill' f g = manyTill f g >.-.> fst  -- | Apply the given action at least 'min' times and at most 'max' time@@ -170,16 +171,16 @@ manyBounded :: forall zs xs m.    ( zs ~ Filter ParseError xs    , Monad m-   , MaybePopable ParseError xs-   ) => Maybe Word -> Maybe Word -> Flow m xs -> Flow m '[[Variant zs],ParseError]-manyBounded _ (Just 0) _   = flowSet ([] :: [Variant zs])+   , ParseError :<? xs+   ) => Maybe Word -> Maybe Word -> Flow m xs -> Flow m '[[V zs],ParseError]+manyBounded _ (Just 0) _   = flowSet ([] :: [V zs]) manyBounded (Just 0) max f = manyBounded Nothing max f manyBounded min max f      = do    v <- f    case popVariantMaybe v of       Right (e :: ParseError) -> case min of          Just n | n > 0 -> flowSet e-         _              -> flowSet ([] :: [Variant zs])+         _              -> flowSet ([] :: [V zs])       Left x           -> do          let minus1 = fmap (\k -> k - 1)          xs <- manyBounded (minus1 min) (minus1 max) f

@@ -3,14 +3,10 @@ import Test.Tasty  import Haskus.Tests.Utils.HArray-import Haskus.Tests.Utils.Variant import Haskus.Tests.Utils.Solver  testsUtils :: TestTree testsUtils = testGroup "Utils"    [ testsHArray-   , testsVariant    , testsSolver    ]--

@@ -1,129 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}--module Haskus.Tests.Utils.Variant-   ( testsVariant-   )-where--import Test.Tasty-import Test.Tasty.QuickCheck as QC-import Data.Either--import Haskus.Utils.Variant--data A = A deriving (Show,Eq)-data B = B deriving (Show,Eq)-data C = C deriving (Show,Eq)-data D = D deriving (Show,Eq)-data E = E deriving (Show,Eq)-data F = F deriving (Show,Eq)--type ABC = Variant '[A,B,C]-type DEF = Variant '[D,E,F]--b :: ABC-b = toVariantAt @1 B--b2d :: B -> D-b2d = const D--c2d :: C -> D-c2d = const D--b2def :: B -> DEF-b2def = const (toVariant E)--c2def :: C -> DEF-c2def = const (toVariant E)---testsVariant :: TestTree-testsVariant = testGroup "Variant" $-   [ testProperty "set/get by index (match)"-         (fromVariantAt @1 b == Just B)-   , testProperty "set/get by index (dont' match)"-         (fromVariantAt @0 b == Nothing)-   , testProperty "set/get by type (match)"-         (fromVariant    (toVariant B :: ABC) == Just B)-   , testProperty "set/get by type (don't match)"-         (fromVariant @C (toVariant B :: ABC) == Nothing)--   , testProperty "variant equality (match)"-         (b == b)-   , testProperty "variant equality (don't match)"-         (b /= toVariant C)--   , testProperty "update by index (match)"-         (updateVariantAt @1 (const D) b == toVariantAt @1 D)-   , testProperty "update by index (don't match)"-         (updateVariantAt @0 (const F) b == toVariantAt @1 B)-   , testProperty "update by type (match)"-         (updateVariantFirst b2d b == toVariantAt @1 D)-   , testProperty "update by type (don't match)"-         (updateVariantFirst c2d b == toVariant B)-   , testProperty "update/fold by index (match)"-         (foldMapVariantAt @1 b2def b == toVariant E)-   , testProperty "update/fold by index (don't match)"-         (foldMapVariantAt @2 c2def b == toVariant B)--   , testProperty "Convert into tuple"-         (variantToTuple b == (Nothing, Just B, Nothing))-   , testProperty "Convert single variant"-         (variantToValue (toVariant A :: Variant '[A]) == A)--   , testProperty "Lift Either: Left"-         (variantFromEither (Left A :: Either A B) == toVariant A)-   , testProperty "Lift Either: Right"-         (variantFromEither (Right B :: Either A B) == toVariant B)--   , testProperty "To Either: Left"-         (variantToEither (toVariant B :: Variant '[A,B]) == Left B)-   , testProperty "To Either: Right"-         (variantToEither (toVariant A :: Variant '[A,B]) == Right A)--   , testProperty "popVariantHead (match)"-         (popVariantHead (toVariant A :: ABC) == Right A)-   , testProperty "popVariantHead (don't match)"-         (isLeft (popVariantHead b))--   , testProperty "popVariantAt (match)"-         (popVariantAt @1 b == Right B)-   , testProperty "popVariantAt (don't match)"-         (isLeft (popVariantAt @2 b))--   , testProperty "popVariant (match)"-         (popVariant @D (toVariantAt @4 D :: Variant '[A,B,C,B,D,E,D]) == Right D)-   , testProperty "popVariant (match)"-         (popVariant @D (toVariantAt @6 D :: Variant '[A,B,C,B,D,E,D]) == Right D)-   , testProperty "popVariant (don't match)"-         (popVariant @B (toVariantAt @4 D :: Variant '[A,B,C,B,D,E,D]) == Left (toVariantAt @2 D))--   , testProperty "prependVariant"-         (fromVariantAt @4 (prependVariant @'[D,E,F] b) == Just B)-   , testProperty "appendVariant"-         (fromVariantAt @1 (appendVariant @'[D,E,F] b)  == Just B)--   , testProperty "alterVariant"-         (alterVariant @Num (+1) (toVariant (1.0 :: Float) :: Variant '[Int,Float]) == toVariant (2.0 :: Float))-   , testProperty "alterVariant"-         (alterVariant @Num (+1) (toVariant (1.0 :: Float) :: Variant '[Float,Int]) == toVariant (2.0 :: Float))--   , testProperty "traverseVariant"-         (traverseVariant @OrdNum (\x -> if x > 1 then Just x else Nothing)-            (toVariant (2.0 :: Float) :: Variant '[Float,Int]) == Just (toVariant (2.0 :: Float)))-   , testProperty "traverseVariant"-         (traverseVariant @OrdNum (\x -> if x > 1 then Just x else Nothing)-            (toVariant (0.5 :: Float) :: Variant '[Float,Int]) == Nothing)--   , testProperty "liftVariant"-         (fromVariant (liftVariant b :: Variant '[D,A,E,B,F,C])  == Just B)-   ]--class (Ord a, Num a) => OrdNum a-instance (Ord a, Num a) => OrdNum a