kleene 0.1 → 0.2

raw patch · 17 files changed

+372/−226 lines, 17 filesdep +kleenedep +tastydep +tasty-hunitdep −attoparsecdep −base-compatdep −semigroupsdep ~QuickCheckdep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: kleene, tasty, tasty-hunit, tasty-quickcheck

Dependencies removed: attoparsec, base-compat, semigroups, text, transformers

Dependency ranges changed: QuickCheck, base, bytestring, containers, regex-applicative, step-function

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• kleene.cabal +46/−25
• src/Kleene.hs +5/−4
• src/Kleene/Classes.hs +0/−3
• src/Kleene/DFA.hs +30/−24
• src/Kleene/ERE.hs +23/−27
• src/Kleene/Equiv.hs +9/−7
• src/Kleene/Functor.hs +1/−1
• src/Kleene/Functor/NonEmpty.hs +13/−12
• src/Kleene/Internal/Functor.hs +17/−13
• src/Kleene/Internal/Partition.hs +12/−16
• src/Kleene/Internal/Pretty.hs +1/−3
• src/Kleene/Internal/RE.hs +32/−30
• src/Kleene/Internal/Sets.hs +2/−1
• src/Kleene/Monad.hs +34/−59
• src/Kleene/RE.hs +2/−1
• tests/kleene-utf8.hs +135/−0

@@ -1,3 +1,13 @@+## 0.2++* Remove MChars constructor from Monad variant++## 0.1.1++* Export `Kleene.Functor.NonEmpty.few1`+* Export `Kleene.RE.everything` and `Kleene.ERE.everything`+* Export `Equivalent` from `Kleene`+ ## 0.1  * Drop superclasses from `Kleene`.

@@ -1,6 +1,6 @@-cabal-version:      1.24+cabal-version:      2.4 name:               kleene-version:            0.1+version:            0.2 synopsis:           Kleene algebra category:           Math description:@@ -16,41 +16,48 @@ bug-reports:        https://github.com/phadej/kleene/issues author:             Oleg Grenrus <oleg.grenrus@iki.fi> maintainer:         Oleg Grenrus <oleg.grenrus@iki.fi>-license:            BSD3+license:            BSD-3-Clause license-file:       LICENSE build-type:         Simple extra-source-files: CHANGELOG.md extra-doc-files:    example.png tested-with:-  GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1+  GHC ==8.6.5+   || ==8.8.4+   || ==8.10.7+   || ==9.0.2+   || ==9.2.8+   || ==9.4.8+   || ==9.6.7+   || ==9.8.4+   || ==9.10.3+   || ==9.12.4+   || ==9.14.1  source-repository head   type:     git   location: https://github.com/phadej/kleene  library+  default-language:  Haskell2010+  ghc-options:       -Wall+  hs-source-dirs:    src+   -- GHC boot libraries   build-depends:-      base          >=4.7.0.2  && <4.13-    , bytestring    >=0.10.4.0 && <0.11-    , containers    >=0.5.5.1  && <0.7-    , text          >=1.2.3.0  && <1.3-    , transformers  >=0.3.0.0  && <0.6--  if !impl(ghc >=8.0)-    build-depends: semigroups >=0.18.5 && <0.19+    , base          >=4.7.0.2  && <4.23+    , bytestring    >=0.10.8.2 && <0.13+    , containers    >=0.6.0.1  && <0.9    -- Other dependencies   build-depends:-      attoparsec-    , base-compat        >=0.10.5   && <0.11-    , lattices           >=2        && <2.1+    , lattices           >=2        && <2.3     , MemoTrie           >=0.6.9    && <0.7-    , QuickCheck         >=2.12.6.1 && <2.13+    , QuickCheck         >=2.16.0.0 && <2.19     , range-set-list     >=0.1.3    && <0.2-    , regex-applicative  >=0.3.3    && <0.4-    , semigroupoids      >=5.3.2    && <5.4-    , step-function      >=0.2      && <0.3+    , regex-applicative  >=0.3.4    && <0.4+    , semigroupoids      >=5.3.2    && <6.1+    , step-function      >=0.2.1    && <0.3    other-extensions:     CPP@@ -70,8 +77,8 @@     Kleene     Kleene.Classes     Kleene.DFA-    Kleene.ERE     Kleene.Equiv+    Kleene.ERE     Kleene.Functor     Kleene.Functor.NonEmpty     Kleene.Monad@@ -79,14 +86,28 @@    -- "Internal-ish" modules   exposed-modules:+    Kleene.Internal.Functor     Kleene.Internal.Partition     Kleene.Internal.Pretty+    Kleene.Internal.RE     Kleene.Internal.Sets -  other-modules:-    Kleene.Internal.Functor-    Kleene.Internal.RE+  x-docspec-options:+    -XOverloadedStrings --check-properties "--property-variables=c p r s t q" -  ghc-options:      -Wall-  hs-source-dirs:   src+test-suite kleene-utf8   default-language: Haskell2010+  ghc-options:      -Wall+  hs-source-dirs:   tests+  type:             exitcode-stdio-1.0+  main-is:          kleene-utf8.hs+  build-depends:+    , base+    , bytestring+    , kleene++  -- test dependencies+  build-depends:+    , tasty             ^>=1.4.0.3  || ^>=1.5+    , tasty-hunit       ^>=0.10.0.3+    , tasty-quickcheck  ^>=0.11.1

@@ -78,11 +78,11 @@ -- >>> import Kleene.RE (generate) -- -- >>> traverse_ print $ take 5 $ generate (curry QC.choose) 42 re--- "abcabcabcabcabcabcdefyz"--- "abcabcabcabcdefyz"--- "abcabcabcabcabcabcabcabcabcdefx"+-- "abcdefx" -- "abcabcdefx"--- "abcabcabcabcabcabcdefyz"+-- "abcdefyz"+-- "abcabcabcabcabcabcabcdefyz"+-- "abcabcabcabcabcabcabcdefyz" -- -- In addition to the "normal" regular expressions, there are /extended regular expressions/. -- Regular expressions which we can 'complement', and therefore intersect:@@ -164,6 +164,7 @@     FiniteKleene (..),     Derivate (..),     Match (..),+    Equivalent (..),     TransitionMap (..),     Complement (..),     ToLatin1 (..),

@@ -3,9 +3,6 @@ {-# LANGUAGE GADTs                  #-} module Kleene.Classes where -import Prelude ()-import Prelude.Compat- import Data.Char                          (ord) import Data.Foldable                      (toList) import Data.Function.Step.Discrete.Closed (SF)

@@ -1,9 +1,9 @@-{-# LANGUAGE BangPatterns           #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE GADTs                  #-}-{-# LANGUAGE Safe                   #-}-{-# LANGUAGE ScopedTypeVariables    #-}+{-# LANGUAGE BangPatterns          #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Safe                  #-}+{-# LANGUAGE ScopedTypeVariables   #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Kleene.DFA (     DFA (..),@@ -19,9 +19,6 @@     toDot',     ) where -import Prelude ()-import Prelude.Compat- import Algebra.Lattice        (BoundedJoinSemiLattice (..), BoundedMeetSemiLattice (..), Lattice (..)) import Data.IntMap       (IntMap)@@ -44,6 +41,29 @@ import           Kleene.Internal.Pretty import qualified Kleene.Internal.RE     as RE +-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Data.Foldable (traverse_)+-- >>> import Data.Semigroup (Semigroup (..))+-- >>> import Algebra.Lattice ((/\))+-- >>> import Kleene.Classes+-- >>> import Kleene.Internal.Pretty (putPretty)+-- >>> import Test.QuickCheck ((===))+-- >>> import qualified Test.QuickCheck as QC+-- >>> import qualified Kleene.RE as RE+-- >>> import qualified Kleene.ERE as ERE+-- >>> import qualified Data.RangeSet.Map as RSet+--+-- >>> newtype Smaller a = Smaller a deriving (Show)+-- >>> let intLog2 = (`div` 10)+-- >>> instance QC.Arbitrary a => QC.Arbitrary (Smaller a) where arbitrary = QC.scale intLog2 QC.arbitrary; shrink (Smaller a) = map Smaller (QC.shrink a)+--+-- >>> let asREChar :: RE.RE Char -> RE.RE Char; asREChar = id++-------------------------------------------------------------------------------+-- DFA+-------------------------------------------------------------------------------+ -- | Deterministic finite automaton. -- -- A deterministic finite automaton (DFA) over an alphabet \(\Sigma\) (type@@ -234,7 +254,7 @@ -- -- For 'RE.string' regular expressions, @'toRE' . 'fromRE' = 'id'@: ----- prop> let s = take 5 s' in RE.string (s :: String) === toRE (fromRE (RE.string s))+-- prop> let s' = take 5 s in RE.string (s' :: String) === toRE (fromRE (RE.string s')) -- -- But in general it isn't: --@@ -541,17 +561,3 @@         , let acc = if IntSet.member i (dfaAcceptable dfa) then "+" else ""         , let bh = if IntSet.member i $ dfaBlackholes dfa then " -- black hole" else ""         ]---- $setup--- >>> :set -XOverloadedStrings--- >>> import Data.Foldable (traverse_)--- >>> import Algebra.Lattice ((/\))------ >>> import Test.QuickCheck ((===))--- >>> import qualified Test.QuickCheck as QC------ >>> newtype Smaller a = Smaller a deriving (Show)--- >>> let intLog2 = (`div` 10)--- >>> instance QC.Arbitrary a => QC.Arbitrary (Smaller a) where arbitrary = QC.scale intLog2 QC.arbitrary; shrink (Smaller a) = map Smaller (QC.shrink a)------ >>> let asREChar :: RE.RE Char -> RE.RE Char; asREChar = id

@@ -1,9 +1,9 @@-{-# LANGUAGE BangPatterns           #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE GADTs                  #-}-{-# LANGUAGE Safe                   #-}-{-# LANGUAGE ScopedTypeVariables    #-}+{-# LANGUAGE BangPatterns          #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Safe                  #-}+{-# LANGUAGE ScopedTypeVariables   #-} module Kleene.ERE (     ERE (..),     -- * Construction@@ -16,6 +16,7 @@     --     empty,     eps,+    everything,     char,     charRange,     anyChar,@@ -40,10 +41,6 @@     isEverything,     ) where -import Data.Semigroup (Semigroup (..))-import Prelude ()-import Prelude.Compat- import Algebra.Lattice        (BoundedJoinSemiLattice (..), BoundedMeetSemiLattice (..), Lattice (..)) import Control.Applicative (liftA2)@@ -65,6 +62,21 @@ import           Kleene.Internal.Pretty import qualified Kleene.Internal.RE        as RE +-- $setup+-- >>> import Algebra.Lattice ((/\), (\/), top, bottom)+-- >>> import Data.Semigroup (Semigroup (..))+-- >>> import Control.Monad (void)+-- >>> import Data.Foldable (traverse_)+-- >>> import Data.List (sort)+-- >>> import Test.QuickCheck ((===))+-- >>> import qualified Test.QuickCheck as QC+-- >>> import qualified Data.Map as Map+-- >>> import qualified Data.Function.Step.Discrete.Closed as SF+--+-- >>> import Kleene.Classes (match)+-- >>> import Kleene.Internal.Pretty (putPretty, pretty)+-- >>> let asEREChar :: ERE Char -> ERE Char; asEREChar = id+ -- | Extended regular expression -- -- It's both, /Kleene/ and /Boolean/ algebra. (If we add only intersections, it@@ -185,7 +197,7 @@     rs1 = concatMap f rs0      f (EREAppend rs) = rs-    f r             = [r]+    f r              = [r]  -- | Union of regular expressions. --@@ -614,19 +626,3 @@     toLatin1 (EREUnion rs xs) = C.fromRSet (C.toLatin1 rs) \/ unions (map C.toLatin1 (Set.toList  xs))     toLatin1 (EREStar r)      = star (C.toLatin1 r)     toLatin1 (ERENot r)       = complement (C.toLatin1 r)------------------------------------------------------------------------------------ Doctest------------------------------------------------------------------------------------ $setup--- >>> :set -XOverloadedStrings--- >>> import Control.Monad (void)--- >>> import Data.Foldable (traverse_)--- >>> import Data.List (sort)------ >>> import Test.QuickCheck ((===))--- >>> import qualified Test.QuickCheck as QC------ >>> import Kleene.Classes (match)--- >>> let asEREChar :: ERE Char -> ERE Char; asEREChar = id

@@ -7,16 +7,21 @@ {-# LANGUAGE UndecidableInstances       #-} module Kleene.Equiv where -import Prelude ()-import Prelude.Compat--import Algebra.Lattice    (BoundedJoinSemiLattice (..), BoundedMeetSemiLattice (..), Lattice (..), joinLeq)+import Algebra.Lattice+       (BoundedJoinSemiLattice (..), BoundedMeetSemiLattice (..), Lattice (..),+       joinLeq) import Algebra.PartialOrd (PartialOrd (..)) import Data.Semigroup     (Semigroup (..))  import Kleene.Classes import Kleene.Internal.Pretty +-- $setup+-- >>> import Kleene.RE (RE)+-- >>> import Kleene.Classes+-- >>> import Algebra.PartialOrd (leq)+-- >>> import Data.Semigroup (Semigroup (..))+ -- | Regular-expressions for which '==' is 'equivalent'. -- -- >>> let re1 = star "a" <> "a" :: RE Char@@ -56,6 +61,3 @@ deriving instance Match      c (r c) => Match      c (Equiv r c) deriving instance Equivalent c (r c) => Equivalent c (Equiv r c) deriving instance Complement c (r c) => Complement c (Equiv r c)---- $setup--- >>> import Kleene.RE (RE)

@@ -1,4 +1,4 @@-{-# LANGUAGE Safe  #-}+{-# LANGUAGE Safe #-} module Kleene.Functor (     K,     Greediness (..),

@@ -6,6 +6,7 @@     Greediness (..),     -- * Constructors     some1,+    few1,     anyChar,     oneof,     char,@@ -25,9 +26,6 @@     nullableProof,     ) where -import Prelude ()-import Prelude.Compat- import Control.Applicative (Alternative (..), liftA2) import Data.Foldable       (toList) import Data.Functor.Alt    ((<!>))@@ -46,6 +44,18 @@ import           Kleene.Internal.Sets import qualified Kleene.RE               as RE +-- $setup+--+-- >>> import Control.Applicative (optional, Alternative (..))+-- >>> import Data.Functor.Apply (Apply (..))+-- >>> import Data.List.NonEmpty (NonEmpty (..))+-- >>> import Kleene.Functor (Greediness (..), K (..))+-- >>> import Data.Foldable (toList)+-- >>> import Kleene.Internal.Pretty (putPretty)+-- >>> import qualified Kleene.RE as RE+-- >>> import qualified Kleene.Classes as C+-- >>> import qualified Text.Regex.Applicative as R+ -- | 'Applicative' 'Functor' regular expression. data K1 c a where     K1Empty  :: K1 c a@@ -276,12 +286,3 @@ -- instance c ~ Char => Pretty (K1 c a) where     pretty = pretty . toRE------------------------------------------------------------------------------------ Doctest------------------------------------------------------------------------------------ $setup------ >>> :set -XOverloadedStrings--- >>> import Control.Applicative (optional)

@@ -1,6 +1,7 @@ {-# LANGUAGE CPP   #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Safe  #-}+{-# OPTIONS_HADDOCK not-home #-} module Kleene.Internal.Functor (     K (..),     Greediness (..),@@ -25,24 +26,35 @@     toRA,     ) where -import Prelude ()-import Prelude.Compat- import Control.Applicative (Alternative (..), liftA2) import Data.Foldable       (toList) import Data.Functor.Apply  (Apply (..)) import Data.RangeSet.Map   (RSet) import Data.String         (IsString (..)) +import qualified Data.Functor.Alt       as Alt import qualified Data.RangeSet.Map      as RSet import qualified Text.Regex.Applicative as R-import qualified Data.Functor.Alt       as Alt  import qualified Kleene.Classes         as C import           Kleene.Internal.Pretty import           Kleene.Internal.Sets import qualified Kleene.RE              as RE ++-- $setup+--+-- >>> import Control.Applicative (Alternative (..), liftA2)+-- >>> import Data.Semigroup (Semigroup (..))+-- >>> import Kleene.Internal.Pretty (putPretty)+-- >>> import qualified Kleene.Classes as C+-- >>> import qualified Kleene.RE as RE+-- >>> import qualified Text.Regex.Applicative as R++-------------------------------------------------------------------------------+-- Functor RE+-------------------------------------------------------------------------------+ -- | Star behaviour data Greediness     = Greedy    -- ^ 'many'@@ -70,7 +82,7 @@     fmap f (KPure x)       = KPure (f x)     fmap f (KMap g k)      = KMap (f . g) k     fmap f (KAppend g a b) = KAppend (\x y -> f (g x y)) a b-    fmap f k                    = KMap f k+    fmap f k               = KMap f k  instance Apply (K c) where     KEmpty <.> _ = KEmpty@@ -272,11 +284,3 @@ -- instance c ~ Char => Pretty (K c a) where     pretty = pretty . toRE------------------------------------------------------------------------------------ Doctest------------------------------------------------------------------------------------ $setup------ >>> :set -XOverloadedStrings

@@ -1,22 +1,29 @@ {-# LANGUAGE Safe #-}+{-# OPTIONS_HADDOCK not-home #-} module Kleene.Internal.Partition where -import Prelude ()-import Prelude.Compat-import Data.Semigroup (Semigroup (..))- import Data.Foldable      (toList) import Data.List.NonEmpty (NonEmpty (..)) import Data.RangeSet.Map  (RSet) import Data.Set           (Set)  import qualified Data.Function.Step.Discrete.Closed as SF-import qualified Data.List.NonEmpty          as NE+import qualified Data.List.NonEmpty                 as NE import qualified Data.RangeSet.Map                  as RSet import qualified Data.Set                           as Set  import Test.QuickCheck +-- $setup+-- >>> import Data.Word+-- >>> import Data.Semigroup (Semigroup (..))+-- >>> import Test.QuickCheck (Arbitrary (..), (===), (==>))+-- >>> import Data.RangeSet.Map (RSet)+-- >>> import qualified Data.RangeSet.Map as RSet+--+-- >>> let asPartitionChar :: Partition Char -> Partition Char; asPartitionChar = id+-- >>> instance (Ord a, Enum a, Arbitrary a) => Arbitrary (RSet a) where arbitrary = fmap RSet.fromRangeList arbitrary+ -- | 'Partition' devides type into disjoint connected partitions. -- -- /Note:/ we could have non-connecter partitions too,@@ -172,14 +179,3 @@     (f maxBound)   where     as = toList p------------------------------------------------------------------------------------ Doctest------------------------------------------------------------------------------------ $setup--- >>> import Data.Word--- >>> import Test.QuickCheck ((===))------ >>> let asPartitionChar :: Partition Char -> Partition Char; asPartitionChar = id--- >>> instance (Ord a, Enum a, Arbitrary a) => Arbitrary (RSet a) where arbitrary = fmap RSet.fromRangeList arbitrary

@@ -1,12 +1,10 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE Safe  #-}+{-# OPTIONS_HADDOCK not-home #-} module Kleene.Internal.Pretty (     Pretty (..),     putPretty,     ) where--import Prelude ()-import Prelude.Compat  import Data.Monoid          (Endo (..)) import Data.RangeSet.Map    (RSet)

@@ -4,6 +4,7 @@ {-# LANGUAGE GADTs                  #-} {-# LANGUAGE Safe                   #-} {-# LANGUAGE ScopedTypeVariables    #-}+{-# OPTIONS_HADDOCK not-home #-} module Kleene.Internal.RE (     RE (..),     -- * Construction@@ -15,6 +16,7 @@     --     empty,     eps,+    everything,     char,     charRange,     anyChar,@@ -37,10 +39,6 @@     nullableProof,     ) where -import Prelude ()-import Prelude.Compat-import Data.Semigroup (Semigroup (..))- import Control.Applicative (liftA2) import Data.Foldable       (toList) import Data.List           (foldl')@@ -61,6 +59,30 @@ import qualified Kleene.Internal.Partition as P import           Kleene.Internal.Pretty +-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Control.Monad (void)+-- >>> import Data.Foldable (traverse_)+-- >>> import Data.List (sort)+-- >>> import Data.Maybe (isJust)+-- >>> import Data.Semigroup (Semigroup (..))+--+-- >>> import Test.QuickCheck ((===))+-- >>> import qualified Test.QuickCheck as QC+-- >>> import qualified Data.Map as Map+-- >>> import qualified Data.Function.Step.Discrete.Closed as SF+--+-- >>> import Kleene.Classes (match)+-- >>> import Kleene.Internal.Pretty (putPretty, pretty)+-- >>> import Algebra.Lattice (bottom, (\/))+-- >>> import Kleene.RE ()+--+-- >>> let asREChar :: RE Char -> RE Char; asREChar = id++-------------------------------------------------------------------------------+-- RE+-------------------------------------------------------------------------------+ -- | Regular expression -- -- Constructors are exposed, but you should use@@ -165,10 +187,10 @@         [r] -> r         rs  -> REAppend rs   where-    -- flatten one level of REAppend     rs1 = concatMap f rs0 -    f (REAppend rs) = rs+    f :: RE c -> [RE c]+    f (REAppend rs) = concatMap f rs     f r             = [r]  -- | Union of regular expressions.@@ -368,7 +390,7 @@  nullableProof (REStar r)     | Just r' <- nullableProof r = Just (r' <> REStar r')-    | otherwise                  = Just (r <> REStar r) +    | otherwise                  = Just (r <> REStar r)  ------------------------------------------------------------------------------- -- isEmpty@@ -527,9 +549,9 @@ -- "abc" -- -- >>> example $ star $ "a" \/ "b"--- "aaaaba"--- "bbba"--- "abbbbaaaa"+-- ""+-- "bbaabbaaba"+-- "b" -- -- >>> example empty --@@ -654,23 +676,3 @@     toLatin1 (REAppend xs)   = appends (map C.toLatin1 xs)     toLatin1 (REUnion rs xs) = C.fromRSet (C.toLatin1 rs) \/ unions (map C.toLatin1 (Set.toList  xs))     toLatin1 (REStar r)      = star (C.toLatin1 r)------------------------------------------------------------------------------------ Doctest------------------------------------------------------------------------------------ $setup--- >>> :set -XOverloadedStrings--- >>> import Control.Monad (void)--- >>> import Data.Foldable (traverse_)--- >>> import Data.List (sort)--- >>> import Data.Maybe (isJust)------ >>> import Test.QuickCheck ((===))--- >>> import qualified Test.QuickCheck as QC------ >>> import Kleene.Classes (match)--- >>> import Algebra.Lattice (bottom)--- >>> import Kleene.RE ()------ >>> let asREChar :: RE Char -> RE Char; asREChar = id

@@ -1,8 +1,9 @@ {-# LANGUAGE Safe #-}+{-# OPTIONS_HADDOCK not-home #-} -- | Character sets. module Kleene.Internal.Sets (     dotRSet,-    ) where+) where  import Data.RangeSet.Map (RSet) 

@@ -37,10 +37,6 @@     isEps,     ) where -import Prelude ()-import Prelude.Compat-import Data.Semigroup (Semigroup (..))- import Control.Applicative (liftA2) import Control.Monad       (ap) import Data.Foldable       (toList)@@ -54,8 +50,21 @@ import qualified Kleene.Classes         as C import           Kleene.Internal.Pretty +-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Data.Foldable (traverse_)+-- >>> import Data.List (sort)+-- >>> import Kleene.Internal.Pretty (putPretty)+--+-- >>> import Test.QuickCheck ((===))+-- >>> import qualified Test.QuickCheck as QC+--+-- >>> import Kleene.RE (RE)+-- >>> import Kleene.Classes (match)+-- >>> let asMBool :: M Bool -> M Bool; asMBool = id+ -- | Regular expression which has no restrictions on the elements.--- Therefore we can have 'Monad' instance, i.e. have a regexp where +-- Therefore we can have 'Monad' instance, i.e. have a regexp where -- characters are regexps themselves. -- -- Because there are no optimisations, it's better to work over small alphabets.@@ -71,23 +80,20 @@ -- ^..*.$ -- data M c-    = MChars [c]        -- ^ One of the characters-    | MAppend [M c]     -- ^ Concatenation+    = MAppend [M c]     -- ^ Concatenation     | MUnion [c] [M c]  -- ^ Union     | MStar (M c)       -- ^ Kleene star   deriving (Eq, Ord, Show, Functor, Foldable, Traversable)  instance Applicative M where-    pure = MChars . pure+    pure = char     (<*>) = ap  instance Monad M where     return = pure -    MChars []    >>= _  = MChars []-    MChars cs    >>= k  = appends (map k cs)     MAppend rs   >>= k  = appends (map (>>= k) rs)-    MUnion cs rs >>= k  = unions (map (>>= k) (MChars cs : rs))+    MUnion cs rs >>= k  = unions (appends (map k cs) : map (>>= k) rs)     MStar r      >>= k  = star (r >>= k)  -------------------------------------------------------------------------------@@ -102,7 +108,7 @@ -- prop> match (empty :: M Char) (s :: String) === False -- empty :: M c-empty = MChars []+empty = MUnion [] []  -- | Empty string. /Note:/ different than 'empty'. --@@ -123,7 +129,7 @@ -- ^x$ -- char :: c -> M c-char = MChars . pure+char c = MUnion [c] []  -- | /Note:/ we know little about @c@. --@@ -131,7 +137,7 @@ -- ^[abcdefghijklmnopqrstuvwxyz]$ -- charRange :: Enum c => c -> c -> M c-charRange c c' = MChars [c .. c']+charRange c c' = MUnion [c .. c'] []   -- | Any character. /Note:/ different than dot!@@ -140,7 +146,7 @@ -- ^[01]$ -- anyChar :: (Bounded c, Enum c) => M c-anyChar = MChars [minBound .. maxBound]+anyChar = MUnion [minBound .. maxBound] []  -- | Concatenate regular expressions. --@@ -163,27 +169,19 @@ -- unions :: [M c] -> M c unions = uncurry mk . foldMap f where-    mk cs rss-        | null rss = MChars cs-        | null cs = case rss of-            []  -> empty-            [r] -> r-            _   -> MUnion cs rss-        | otherwise    = MUnion cs rss-     f (MUnion cs rs) = (cs, rs)-    f (MChars cs)    = (cs, [])     f r              = ([], [r]) +    mk [] [r] = r+    mk cs rs = MUnion cs rs+ -- | Kleene star. -- star :: M c -> M c star r = case r of     MStar _                    -> r     MAppend []                 -> eps-    MChars cs | null cs        -> eps     MUnion cs rs | any isEps rs -> case rs' of-        []             -> star (MChars cs)         [r'] | null cs -> star r'         _              -> MStar (MUnion cs rs')       where@@ -203,8 +201,8 @@ -- string :: [c] -> M c string []  = eps-string [c] = MChars [c]-string cs  = MAppend $ map (MChars . pure) cs+string [c] = char c+string cs  = MAppend $ map char cs  instance C.Kleene  (M c) where     empty      = empty@@ -233,7 +231,6 @@ -- False -- nullable :: M c -> Bool-nullable (MChars _)      = False nullable (MAppend rs)    = all nullable rs nullable (MUnion _cs rs) = any nullable rs nullable (MStar _)       = True@@ -252,7 +249,6 @@ -- ^yz(xyz)*$ -- derivate :: (Eq c, Enum c, Bounded c) => c -> M c -> M c-derivate c (MChars cs)     = derivateChars c cs derivate c (MUnion cs rs)  = unions $ derivateChars c cs : [ derivate c r | r <- toList rs] derivate c (MAppend rs)    = derivateAppend c rs derivate c rs@(MStar r)    = derivate c r <> rs@@ -285,8 +281,8 @@  -- | Whether 'M' is (structurally) equal to 'empty'. isEmpty :: M c -> Bool-isEmpty (MChars rs) = null rs-isEmpty _           = False+isEmpty (MUnion cs rs) = null cs && null rs+isEmpty _              = False  -- | Whether 'M' is (structurally) equal to 'eps'. isEps :: M c -> Bool@@ -306,9 +302,9 @@ -- "abc" -- -- >>> example $ star $ unions ["a", "b"]--- "ababbb"--- "baab"--- "abbababaa"+-- ""+-- "aaababaaab"+-- "a" -- -- xx >>> example empty --@@ -324,7 +320,6 @@  generator :: M c -> QC.Gen [c] generator = go where-    go (MChars cs)    = goChars cs     go (MAppend rs)   = concat <$> traverse go rs     go (MUnion cs rs)         | null cs   = QC.oneof [ go r | r <- toList rs ]@@ -349,7 +344,6 @@ -- ^[a-z]$ -- toKleene :: C.CharKleene c k => M c -> k-toKleene (MChars cs)    = C.oneof cs toKleene (MAppend rs)   = C.appends (map toKleene rs) toKleene (MUnion cs rs) = C.unions (C.oneof cs : map toKleene rs) toKleene (MStar r)      = C.star (toKleene r)@@ -372,7 +366,7 @@ instance (Eq c, Enum c, Bounded c, QC.Arbitrary c) => QC.Arbitrary (M c) where     arbitrary = QC.sized arb where         c :: QC.Gen (M c)-        c = MChars <$> QC.arbitrary+        c = char <$> QC.arbitrary          arb :: Int -> QC.Gen (M c)         arb n | n <= 0    = QC.oneof [c, fmap char QC.arbitrary, pure eps]@@ -388,7 +382,6 @@             n2 = n `div` 2  instance (QC.CoArbitrary c) => QC.CoArbitrary (M c) where-    coarbitrary (MChars cs)    = QC.variant (0 :: Int) . QC.coarbitrary cs     coarbitrary (MAppend rs)   = QC.variant (1 :: Int) . QC.coarbitrary rs     coarbitrary (MUnion cs rs) = QC.variant (2 :: Int) . QC.coarbitrary (cs, rs)     coarbitrary (MStar r)      = QC.variant (3 :: Int) . QC.coarbitrary r@@ -407,11 +400,9 @@         go p (MAppend rs)             = parens p $ goMany id rs         go p (MUnion cs rs)-            | null cs   = goUnion p rs             | null rs   = prettySList cs-            | otherwise = goUnion p (MChars cs : rs)-        go _ (MChars cs)-            = prettySList cs+            | null cs   = goUnion p rs+            | otherwise = goUnion p (MUnion cs [] : rs)          goUnion p rs             | elem eps rs = parens p $ goUnion' True . showChar '?'@@ -435,19 +426,3 @@         prettySList :: [c] -> ShowS         prettySList [c] = prettyS c         prettySList xs  = showChar '[' . foldr (\a b -> prettyS a . b) (showChar ']') xs------------------------------------------------------------------------------------ Doctest------------------------------------------------------------------------------------ $setup--- >>> :set -XOverloadedStrings--- >>> import Data.Foldable (traverse_)--- >>> import Data.List (sort)------ >>> import Test.QuickCheck ((===))--- >>> import qualified Test.QuickCheck as QC------ >>> import Kleene.RE (RE)--- >>> import Kleene.Classes (match)--- >>> let asMBool :: M Bool -> M Bool; asMBool = id

@@ -9,6 +9,7 @@     --     empty,     eps,+    everything,     char,     charRange,     anyChar,@@ -32,5 +33,5 @@     ) where  -- This to include orphans.-import Kleene.Internal.RE import Kleene.DFA ()+import Kleene.Internal.RE

@@ -0,0 +1,135 @@+{-# LANGUAGE CPP #-}+module Main (main) where++import Data.Bits        (shiftR, (.&.), (.|.))+import Data.Char        (ord)+import Data.Semigroup   ((<>))+import Data.Word        (Word8)+import Test.Tasty       (defaultMain, testGroup)+import Test.Tasty.HUnit (assertBool, testCase)++import Kleene+import Kleene.DFA (fromRE, toRE)++#if MIN_VERSION_bytestring(0,11,2)+import Test.Tasty.QuickCheck (label, testProperty, (===))++import qualified Data.ByteString as BS+#endif++main :: IO ()+main = do+    -- print utf8char2+    -- print utf8char3+    -- print utf8char4+    defaultMain $ testGroup "kleene-utf8"+        [ testCase "brute ≃ brute'" $ do+            assertBool "not equiv" (equivalent utf8char1 utf8char2)+        , testCase "brute' ≃ manual1" $ do+            assertBool "not equiv" (equivalent utf8char2 utf8char3)+        , testCase "manual1 ≃ manual2" $ do+            assertBool "not equiv" (equivalent utf8char3 utf8char4)+        , testCase "brute ≃ manual2" $ do+            assertBool "not equiv" (equivalent utf8char1 utf8char4)++#if MIN_VERSION_bytestring(0,11,2)+        , testProperty "isValidUtf8" $ \w8s ->+            let bs = BS.pack w8s+                isValid = BS.isValidUtf8 bs+            in label (show isValid) $ isValid === match (star utf8char4) w8s+#endif+        ]++-------------------------------------------------------------------------------+-- Bruteforce definition+-------------------------------------------------------------------------------++utf8char1 :: RE Word8+utf8char1 = unions+    [ string (encodeStringUtf8 [c])+    | c <- [ '\0' .. maxBound ]+    ]++-------------------------------------------------------------------------------+-- Derived definition+-------------------------------------------------------------------------------++utf8charDFA1 :: DFA Word8+utf8charDFA1 = fromRE utf8char1++utf8char2 :: RE Word8+utf8char2 = toRE utf8charDFA1++-------------------------------------------------------------------------------+-- Written out definition+-------------------------------------------------------------------------------++utf8char3 :: RE Word8+utf8char3 = unions+    [ charRange 0x00 0x7F+    , sub1 <> charRange 0x80 0xBF+    ]+  where+    sub1 = unions+        [ charRange 0xC2 0xDF+        , charRange 0xE0 0xE0 <> charRange 0xa0 0xBF+        , charRange 0xED 0xED <> charRange 0x80 0x9F+        , sub2 <> charRange 0x80 0xBF+        ]++    sub2 = unions+        [ charRange 0xE1 0xEC+        , charRange 0xEE 0xEF+        , charRange 0xF0 0xF0 <> charRange 0x90 0xBF+        , charRange 0xF1 0xF3 <> charRange 0x80 0xBF+        , charRange 0xF4 0xF4 <> charRange 0x80 0x8f+        ]++-------------------------------------------------------------------------------+-- Manual definition, how human would written it+-------------------------------------------------------------------------------++utf8char4 :: RE Word8+utf8char4 = unions+    [ charRange 0x00 0x7F+    , charRange 0xC2 0xDF <> charRange 0x80 0xBF+    , charRange 0xE0 0xE0 <> charRange 0xa0 0xBF <> charRange 0x80 0xBF+    , charRange 0xE1 0xEC <> charRange 0x80 0xBF <> charRange 0x80 0xBF+    , charRange 0xED 0xED <> charRange 0x80 0x9F <> charRange 0x80 0xBF+    , charRange 0xEE 0xEF <> charRange 0x80 0xBF <> charRange 0x80 0xBF+    , charRange 0xF0 0xF0 <> charRange 0x90 0xBF <> charRange 0x80 0xBF <> charRange 0x80 0xBF+    , charRange 0xF1 0xF3 <> charRange 0x80 0xBF <> charRange 0x80 0xBF <> charRange 0x80 0xBF+    , charRange 0xF4 0xF4 <> charRange 0x80 0x8f <> charRange 0x80 0xBF <> charRange 0x80 0xBF+    ]++-------------------------------------------------------------------------------+-- UTF8 encoding+-------------------------------------------------------------------------------++encodeStringUtf8 :: String -> [Word8]+encodeStringUtf8 []        = []+encodeStringUtf8 (c:cs)+  | c <= '\x07F' = w8+                 : encodeStringUtf8 cs+  | c <= '\x7FF' = (0xC0 .|.  w8ShiftR  6          )+                 : (0x80 .|. (w8          .&. 0x3F))+                 : encodeStringUtf8 cs+  | c <= '\xD7FF'= (0xE0 .|.  w8ShiftR 12          )+                 : (0x80 .|. (w8ShiftR  6 .&. 0x3F))+                 : (0x80 .|. (w8          .&. 0x3F))+                 : encodeStringUtf8 cs+  | c <= '\xDFFF'= 0xEF : 0xBF : 0xBD -- U+FFFD+                 : encodeStringUtf8 cs+  | c <= '\xFFFF'= (0xE0 .|.  w8ShiftR 12          )+                 : (0x80 .|. (w8ShiftR  6 .&. 0x3F))+                 : (0x80 .|. (w8          .&. 0x3F))+                 : encodeStringUtf8 cs+  | otherwise    = (0xf0 .|.  w8ShiftR 18          )+                 : (0x80 .|. (w8ShiftR 12 .&. 0x3F))+                 : (0x80 .|. (w8ShiftR  6 .&. 0x3F))+                 : (0x80 .|. (w8          .&. 0x3F))+                 : encodeStringUtf8 cs+  where+    w8 = fromIntegral (ord c) :: Word8+    w8ShiftR :: Int -> Word8+    w8ShiftR = fromIntegral . shiftR (ord c)