August 2017 - openSUSE Commits - openSUSE Mailing Lists

commit ghc-threads for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-threads for openSUSE:Factory checked in at 2017-08-31 21:00:42 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-threads (Old) and /work/SRC/openSUSE:Factory/.ghc-threads.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-threads" Thu Aug 31 21:00:42 2017 rev:2 rq:513519 version:0.5.1.5 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-threads/ghc-threads.changes 2017-01-18 21:33:44.964958009 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-threads.new/ghc-threads.changes 2017-08-31 21:00:43.831444750 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:08:03 UTC 2017 - psimons(a)suse.com + +- Update to version 0.5.1.5. + +------------------------------------------------------------------- Old: ---- threads-0.5.1.4.tar.gz New: ---- threads-0.5.1.5.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-threads.spec ++++++ --- /var/tmp/diff_new_pack.GGDbI7/_old 2017-08-31 21:00:45.391225597 +0200 +++ /var/tmp/diff_new_pack.GGDbI7/_new 2017-08-31 21:00:45.407223350 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-threads # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,16 +19,15 @@ %global pkg_name threads %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.5.1.4 +Version: 0.5.1.5 Release: 0 Summary: Fork threads and wait for their result License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… BuildRequires: ghc-Cabal-devel BuildRequires: ghc-rpm-macros -# Begin cabal-rpm deps: BuildRequires: ghc-stm-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build %if %{with tests} @@ -37,7 +36,6 @@ BuildRequires: ghc-test-framework-devel BuildRequires: ghc-test-framework-hunit-devel %endif -# End cabal-rpm deps %description This package provides functions to fork threads and wait for their result, @@ -73,20 +71,14 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache ++++++ threads-0.5.1.4.tar.gz -> threads-0.5.1.5.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/threads-0.5.1.4/threads.cabal new/threads-0.5.1.5/threads.cabal --- old/threads-0.5.1.4/threads.cabal 2016-06-10 11:43:17.000000000 +0200 +++ new/threads-0.5.1.5/threads.cabal 2017-07-25 00:27:00.000000000 +0200 @@ -1,5 +1,5 @@ name: threads -version: 0.5.1.4 +version: 0.5.1.5 cabal-version: >= 1.9.2 build-type: Custom stability: experimental @@ -50,10 +50,13 @@ Type: git Location: git://github.com/basvandijk/threads.git +custom-setup + setup-depends: base >= 4.4 && < 4.11, Cabal >= 1.12 && < 2.1 + ------------------------------------------------------------------------------- library - build-depends: base >= 4.4 && < 4.10 + build-depends: base >= 4.4 && < 4.11 , stm >= 2.1 && < 2.5 exposed-modules: Control.Concurrent.Thread , Control.Concurrent.Thread.Group @@ -69,9 +72,9 @@ ghc-options: -Wall -threaded build-depends: threads - , base >= 4.4 && < 4.10 + , base >= 4.4 && < 4.11 , stm >= 2.1 && < 2.5 , concurrent-extra >= 0.5.1 && < 0.8 - , HUnit >= 1.2.2 && < 1.4 + , HUnit >= 1.2.2 && < 1.7 , test-framework >= 0.2.4 && < 0.9 , test-framework-hunit >= 0.2.4 && < 0.4

1 0

commit ghc-text-show-instances for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-text-show-instances for openSUSE:Factory checked in at 2017-08-31 21:00:39 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-text-show-instances (Old) and /work/SRC/openSUSE:Factory/.ghc-text-show-instances.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-text-show-instances" Thu Aug 31 21:00:39 2017 rev:3 rq:513518 version:3.6 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-text-show-instances/ghc-text-show-instances.changes 2017-06-22 10:39:21.322400243 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-text-show-instances.new/ghc-text-show-instances.changes 2017-08-31 21:00:41.855722344 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:44 UTC 2017 - psimons(a)suse.com + +- Update to version 3.6 revision 1. + +------------------------------------------------------------------- Old: ---- text-show-instances-3.5.tar.gz New: ---- text-show-instances-3.6.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-text-show-instances.spec ++++++ --- /var/tmp/diff_new_pack.iCLZEN/_old 2017-08-31 21:00:43.031557136 +0200 +++ /var/tmp/diff_new_pack.iCLZEN/_new 2017-08-31 21:00:43.075550955 +0200 @@ -19,7 +19,7 @@ %global pkg_name text-show-instances %bcond_with tests Name: ghc-%{pkg_name} -Version: 3.5 +Version: 3.6 Release: 0 Summary: Additional instances for text-show License: BSD-3-Clause @@ -41,6 +41,7 @@ BuildRequires: ghc-old-locale-devel BuildRequires: ghc-old-time-devel BuildRequires: ghc-pretty-devel +BuildRequires: ghc-process-devel BuildRequires: ghc-random-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-semigroups-devel ++++++ text-show-instances-3.5.tar.gz -> text-show-instances-3.6.tar.gz ++++++ ++++ 4138 lines of diff (skipped) ++++++ text-show-instances.cabal ++++++ ++++ 643 lines (skipped) ++++ between /work/SRC/openSUSE:Factory/ghc-text-show-instances/text-show-instances.cabal ++++ and /work/SRC/openSUSE:Factory/.ghc-text-show-instances.new/text-show-instances.cabal

1 0

commit ghc-text-show for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-text-show for openSUSE:Factory checked in at 2017-08-31 21:00:36 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-text-show (Old) and /work/SRC/openSUSE:Factory/.ghc-text-show.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-text-show" Thu Aug 31 21:00:36 2017 rev:2 rq:513517 version:3.6 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-text-show/ghc-text-show.changes 2017-05-09 18:04:22.642485706 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-text-show.new/ghc-text-show.changes 2017-08-31 21:00:38.872141544 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:08:12 UTC 2017 - psimons(a)suse.com + +- Update to version 3.6 revision 1. + +------------------------------------------------------------------- Old: ---- text-show-3.4.1.1.tar.gz New: ---- text-show-3.6.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-text-show.spec ++++++ --- /var/tmp/diff_new_pack.00ONeH/_old 2017-08-31 21:00:40.835865636 +0200 +++ /var/tmp/diff_new_pack.00ONeH/_new 2017-08-31 21:00:40.879859455 +0200 @@ -19,14 +19,14 @@ %global pkg_name text-show %bcond_with tests Name: ghc-%{pkg_name} -Version: 3.4.1.1 +Version: 3.6 Release: 0 Summary: Efficient conversion of values into Text License: BSD-3-Clause Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/2.cabal… +Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal… BuildRequires: ghc-Cabal-devel BuildRequires: ghc-array-devel BuildRequires: ghc-base-compat-devel ++++++ text-show-3.4.1.1.tar.gz -> text-show-3.6.tar.gz ++++++ ++++ 12987 lines of diff (skipped) ++++++ text-show.cabal ++++++ --- /var/tmp/diff_new_pack.00ONeH/_old 2017-08-31 21:00:41.751736954 +0200 +++ /var/tmp/diff_new_pack.00ONeH/_new 2017-08-31 21:00:41.751736954 +0200 @@ -1,6 +1,6 @@ name: text-show -version: 3.4.1.1 -x-revision: 2 +version: 3.6 +x-revision: 1 synopsis: Efficient conversion of values into Text description: @text-show@ offers a replacement for the @Show@ typeclass intended for use with @Text@ instead of @String@s. This package was created @@ -42,7 +42,7 @@ author: Ryan Scott maintainer: Ryan Scott <ryan.gl.scott(a)gmail.com> stability: Provisional -copyright: (C) 2014-2016 Ryan Scott +copyright: (C) 2014-2017 Ryan Scott category: Text build-type: Simple tested-with: GHC == 7.0.4 @@ -51,7 +51,7 @@ , GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3 - , GHC == 8.0.1 + , GHC == 8.0.2 extra-source-files: CHANGELOG.md, README.md, include/*.h cabal-version: >=1.10 @@ -186,8 +186,8 @@ build-depends: base >= 4.3 && < 4.9 if flag(template-haskell-2-11) - build-depends: template-haskell >= 2.11 && < 2.12 - , ghc-boot-th + build-depends: template-haskell >= 2.11 && < 2.13 + , ghc-boot-th >= 8.0 && < 8.3 else build-depends: template-haskell >= 2.5 && < 2.11 @@ -198,12 +198,10 @@ else build-depends: transformers == 0.4.* - hs-source-dirs: src + hs-source-dirs: src, shared default-language: Haskell2010 ghc-options: -Wall include-dirs: include - includes: inline.h - , utils.h test-suite spec type: exitcode-stdio-1.0 @@ -229,7 +227,6 @@ Instances.Data.Functor.Compose Instances.Data.Functor.Product Instances.Data.Functor.Sum - Instances.Data.List.NonEmpty Instances.Data.Ord Instances.Data.Proxy Instances.Data.Semigroup @@ -247,6 +244,7 @@ Instances.System.Posix.Types Instances.Text.Read Instances.Utils + Instances.Utils.GenericArbitrary -- Only exports instances if using Windows Instances.GHC.Conc.Windows @@ -360,7 +358,7 @@ Spec.GHC.StackSpec build-depends: array >= 0.3 && < 0.6 , base-compat >= 0.8.2 && < 1 - , base-orphans >= 0.5.2 && < 0.6 + , base-orphans >= 0.6 && < 0.7 , bifunctors >= 5.1 && < 6 , bytestring >= 0.9 && < 0.11 , bytestring-builder @@ -372,9 +370,9 @@ , hspec >= 2 && < 3 , integer-gmp , nats >= 0.1 && < 2 - , QuickCheck >= 2.9 && < 3 + , QuickCheck >= 2.9 && < 2.10 , quickcheck-instances >= 0.1 && < 0.4 - , semigroups >= 0.17 && < 0.18.3 + , semigroups >= 0.18.3 && < 1 , tagged >= 0.8.3 && < 1 , text >= 0.11.1 && < 1.3 , th-lift >= 0.7.6 && < 1 @@ -388,8 +386,8 @@ build-depends: base >= 4.3 && < 4.9 if flag(template-haskell-2-11) - build-depends: template-haskell >= 2.11 && < 2.12 - , ghc-boot-th + build-depends: template-haskell >= 2.11 && < 2.13 + , ghc-boot-th >= 8.0 && < 8.3 else build-depends: template-haskell >= 2.5 && < 2.11 @@ -402,15 +400,14 @@ if flag(developer) hs-source-dirs: src else - build-depends: text-show == 3.4.1.1 + build-depends: text-show - hs-source-dirs: tests + hs-source-dirs: tests, shared default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts include-dirs: include includes: generic.h , overlap.h - , utils.h benchmark bench if impl(ghc < 7.4) @@ -444,8 +441,8 @@ build-depends: base >= 4.5 && < 4.9 if flag(template-haskell-2-11) - build-depends: template-haskell >= 2.11 && < 2.12 - , ghc-boot-th + build-depends: template-haskell >= 2.11 && < 2.13 + , ghc-boot-th >= 8.0 && < 8.3 else build-depends: template-haskell >= 2.5 && < 2.11 @@ -459,11 +456,9 @@ if flag(developer) hs-source-dirs: src else - build-depends: text-show == 3.4.1.1 + build-depends: text-show - hs-source-dirs: benchmarks + hs-source-dirs: benchmarks, shared default-language: Haskell2010 ghc-options: -Wall include-dirs: include - includes: inline.h - , utils.h

1 0

commit ghc-text-region for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-text-region for openSUSE:Factory checked in at 2017-08-31 21:00:33 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-text-region (Old) and /work/SRC/openSUSE:Factory/.ghc-text-region.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-text-region" Thu Aug 31 21:00:33 2017 rev:2 rq:513516 version:0.3.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-text-region/ghc-text-region.changes 2016-11-02 12:44:14.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-text-region.new/ghc-text-region.changes 2017-08-31 21:00:34.852706285 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:37 UTC 2017 - psimons(a)suse.com + +- Update to version 0.3.0.0. + +------------------------------------------------------------------- Old: ---- text-region-0.1.0.1.tar.gz New: ---- text-region-0.3.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-text-region.spec ++++++ --- /var/tmp/diff_new_pack.NOCqMm/_old 2017-08-31 21:00:36.496475331 +0200 +++ /var/tmp/diff_new_pack.NOCqMm/_new 2017-08-31 21:00:36.516472521 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-text-region # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,29 +19,25 @@ %global pkg_name text-region %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.1.0.1 +Version: 0.3.0.0 Release: 0 Summary: Marking text regions License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-aeson-devel BuildRequires: ghc-base-unicode-symbols-devel BuildRequires: ghc-bytestring-devel -BuildRequires: ghc-containers-devel BuildRequires: ghc-groups-devel BuildRequires: ghc-lens-devel -BuildRequires: ghc-mtl-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-text-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build %if %{with tests} BuildRequires: ghc-hspec-devel %endif -# End cabal-rpm deps %description Provides functions to update text region positions according to text edit @@ -61,20 +57,14 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache ++++++ text-region-0.1.0.1.tar.gz -> text-region-0.3.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-region-0.1.0.1/src/Data/Text/Region/Types.hs new/text-region-0.3.0.0/src/Data/Text/Region/Types.hs --- old/text-region-0.1.0.1/src/Data/Text/Region/Types.hs 2016-05-24 00:28:40.000000000 +0200 +++ new/text-region-0.3.0.0/src/Data/Text/Region/Types.hs 2017-04-26 03:18:31.000000000 +0200 @@ -1,17 +1,14 @@ {-# LANGUAGE TemplateHaskell, RankNTypes, TypeSynonymInstances, FlexibleInstances, OverloadedStrings, GeneralizedNewtypeDeriving, FlexibleContexts #-} module Data.Text.Region.Types ( - Point(..), pointLine, pointColumn, Size, (.-.), (.+.), + Point(..), pointLine, pointColumn, pointRegion, Size, (.-.), (.+.), Region(..), regionFrom, regionTo, Map(..), Contents, emptyContents, concatCts, splitCts, splitted, Editable(..), contents, by, measure, - Replace(..), replaceRegion, replaceWith, Chain(..), chain, Edit, - ActionIso(..), action, actionBack, - ActionStack(..), undoStack, redoStack, emptyStack, - EditState(..), editState, history, edited, regions, - EditM(..), + Replace(..), replaceRegion, replaceWith, Edit(..), replaces, + Regioned(..), module Data.Group ) where @@ -21,7 +18,6 @@ import Control.Category import Control.Lens hiding ((.=)) -import Control.Monad.State import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as L import Data.Group @@ -37,6 +33,10 @@ makeLenses ''Point +-- | As empty region +pointRegion ∷ Iso' Point Region +pointRegion = iso (\p → Region p p) _regionFrom + instance ToJSON Point where toJSON (Point l c) = object ["line" .= l, "column" .= c] @@ -66,7 +66,9 @@ | bl ≡ l = Point 0 (max 0 (c - bc)) | otherwise = Point 0 0 --- | Opposite to ".-.", @(pt .-. base) .+. base = pt@ +-- | Opposite to '.-.' +-- +-- prop> (pt .-. base) .+. base = pt (.+.) ∷ Point → Point → Point (Point l c) .+. (Point bl bc) | l ≡ 0 = Point bl (c + bc) @@ -94,6 +96,7 @@ -- Combining this functions while edit, we get function, that maps regions from source data to edited one -- To get back function, we must also combine opposite actions, or we can represent actions as 'Iso' -- Same idea goes for modifying contents, represent each action as isomorphism and combine them together +-- This works if we don't use overlapped regions newtype Map = Map { mapIso :: Iso' Region Region } instance Monoid Map where @@ -179,75 +182,30 @@ instance (Editable s, ToJSON s) ⇒ Show (Replace s) where show = L.unpack ∘ encode --- | Chain of edit actions -newtype Chain e s = Chain { - _chain ∷ [e s] } deriving (Eq, Show, Monoid) - -makeLenses ''Chain - -instance ToJSON (e s) ⇒ ToJSON (Chain e s) where - toJSON = toJSON ∘ _chain - -instance FromJSON (e s) ⇒ FromJSON (Chain e s) where - parseJSON = fmap Chain ∘ parseJSON - -type Edit s = Chain Replace s - --- | Some action with its inverse -data ActionIso e = ActionIso { - _action ∷ e, - _actionBack ∷ e } - -makeLenses ''ActionIso - -instance Monoid e ⇒ Monoid (ActionIso e) where - mempty = ActionIso mempty mempty - ActionIso l l' `mappend` ActionIso r r' = ActionIso (l `mappend` r) (r' `mappend` l') - -instance Monoid e ⇒ Group (ActionIso e) where - invert (ActionIso f b) = ActionIso b f - -instance ToJSON e ⇒ ToJSON (ActionIso e) where - toJSON (ActionIso f b) = object ["fore" .= f, "back" .= b] - -instance FromJSON e ⇒ FromJSON (ActionIso e) where - parseJSON = withObject "action-iso" $ \v → ActionIso <$> v .: "fore" <*> v .: "back" - --- | Stack of undo/redo actions -data ActionStack e = ActionStack { - _undoStack ∷ [ActionIso e], - _redoStack ∷ [ActionIso e] } - -makeLenses ''ActionStack - -instance ToJSON e ⇒ ToJSON (ActionStack e) where - toJSON (ActionStack u r) = object ["undo" .= u, "redo" .= r] +-- | Edit is several replace actions, applied simultaneously, must not overlap +newtype Edit s = Edit { + _replaces ∷ [Replace s] } + deriving (Eq, Show, Monoid) -instance FromJSON e ⇒ FromJSON (ActionStack e) where - parseJSON = withObject "action-stack" $ \v → ActionStack <$> v .: "undo" <*> v .: "redo" +makeLenses ''Edit -emptyStack ∷ ActionStack e -emptyStack = ActionStack [] [] +instance (Editable s, ToJSON s) ⇒ ToJSON (Edit s) where + toJSON = toJSON ∘ _replaces --- | Edit state -data EditState s r = EditState { - -- | Edit history is stack of edit actions - _history ∷ ActionStack (Edit s), - -- | Currently edited data - _edited ∷ Contents s, - -- | Some region-based state, that will be updated on each edit - _regions ∷ r } +instance (Editable s, FromJSON s) ⇒ FromJSON (Edit s) where + parseJSON = fmap Edit ∘ parseJSON -makeLenses ''EditState +class Regioned a where + regions ∷ Traversal' a Region -instance (Editable s, ToJSON s, ToJSON r) ⇒ ToJSON (EditState s r) where - toJSON (EditState h e rs) = object ["history" .= h, "contents" .= view (from contents) e, "regions" .= rs ] +instance Regioned Point where + regions = pointRegion -instance (Editable s, FromJSON s, FromJSON r) ⇒ FromJSON (EditState s r) where - parseJSON = withObject "edit-state" $ \v → EditState <$> v .: "history" <*> fmap (view contents) (v .: "contents") <*> v .: "regions" +instance Regioned Region where + regions = id --- | Make edit state for contents -editState ∷ Editable s ⇒ s → r → EditState s r -editState x = EditState emptyStack (x ^. contents) +instance Regioned (Replace s) where + regions = replaceRegion -newtype EditM s r a = EditM { runEditM ∷ State (EditState s r) a } deriving (Applicative, Functor, Monad, MonadState (EditState s r)) +instance Regioned (Edit s) where + regions = replaces . each . replaceRegion diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-region-0.1.0.1/src/Data/Text/Region.hs new/text-region-0.3.0.0/src/Data/Text/Region.hs --- old/text-region-0.1.0.1/src/Data/Text/Region.hs 2016-05-24 00:28:40.000000000 +0200 +++ new/text-region-0.3.0.0/src/Data/Text/Region.hs 2017-04-26 03:18:31.000000000 +0200 @@ -2,10 +2,9 @@ module Data.Text.Region ( pt, start, lineStart, regionLength, till, linesSize, regionLines, emptyRegion, line, - regionSize, expandLines, atRegion, ApplyMap(..), updateMap, cutMap, insertMap, + regionSize, expandLines, atRegion, overlaps, applyMap, cutMap, insertMap, cutRegion, insertRegion, - EditAction(..), cut, paste, overwrite, inverse, applyEdit, apply, - edit, edit_, push, run_, run, runGroup, undo, redo, + EditAction(..), replace, cut, paste, overwrite, apply, update, undo, module Data.Text.Region.Types ) where @@ -13,10 +12,8 @@ import Prelude hiding (id, (.)) import Prelude.Unicode -import Control.Arrow import Control.Category import Control.Lens -import Control.Monad.State import Data.Text.Region.Types @@ -74,33 +71,15 @@ fromc cts = cts ^. splitted (r ^. regionTo) . _1 . splitted (r ^. regionFrom) . _2 toc cts cts' = (cts ^. splitted (r ^. regionFrom) . _1) `concatCts` cts' `concatCts` (cts ^. splitted (r ^. regionTo) . _2) -class ApplyMap a where - applyMap ∷ Map → a → a +-- | Does regions overlaps +overlaps ∷ Region → Region → Bool +overlaps l r + | r ^. regionFrom ≥ l ^. regionTo = False + | r ^. regionTo ≤ l ^. regionFrom = False + | otherwise = True -instance ApplyMap () where - applyMap _ = id - -instance ApplyMap a ⇒ ApplyMap [a] where - applyMap m = map (applyMap m) - -instance ApplyMap Map where - applyMap = mappend - -instance ApplyMap Region where - applyMap = view ∘ mapIso - -instance ApplyMap Point where - applyMap m p = view regionFrom $ applyMap m (p `till` p) - -instance ApplyMap (Replace s) where - applyMap m (Replace r w) = Replace (applyMap m r) w - -instance ApplyMap (e s) ⇒ ApplyMap (Chain e s) where - applyMap m (Chain rs) = Chain (map (applyMap m) rs) - --- | Update 'Region' after some action -updateMap ∷ (EditAction e s, ApplyMap a) ⇒ e s → a → a -updateMap = applyMap ∘ actionMap +applyMap ∷ Map → Region → Region +applyMap = view ∘ mapIso -- | Cut 'Region' mapping cutMap ∷ Region → Map @@ -116,106 +95,67 @@ (if is < s then (s .-. ie) .+. is else s) (if is < e then (e .-. ie) .+. is else e) --- | Update second region position as if it was data inserted at first region +-- | Update second region position as if it was data inserted at first region (region sets insertion point and data size) +-- Region tries not to extend if data inserted at region bound except when region is empty +-- This allows define replace as cut and insert in special case when we replace region itself insertRegion ∷ Region → Region → Region -insertRegion (Region is ie) (Region s e) = Region - (if is < s then (s .-. is) .+. ie else s) - (if is < e then (e .-. is) .+. ie else e) +insertRegion (Region is ie) (Region s e) + | (s ≡ e) ∧ (is ≡ s) = Region is ie + | otherwise = Region + (if is ≤ s then (s .-. is) .+. ie else s) + (if is < e then (e .-. is) .+. ie else e) -class (Editable s, ApplyMap (e s)) ⇒ EditAction e s where +class Editable s ⇒ EditAction e s where -- | Make replace action over 'Region' and 'Contents' - replace ∷ Region → Contents s → e s + replaceAction ∷ Region → Contents s → e s -- | Make 'Map' from action actionMap ∷ e s → Map - -- | Perform action, modifying 'Contents' and returning inverse (undo) action - perform ∷ e s → State (Contents s) (e s) + -- | Perform action, modifying 'Contents' + perform ∷ e s → Contents s → Contents s + -- | Get action undo + inversed ∷ e s → Contents s → e s + +-- | Replace region with data +replace ∷ EditAction e s ⇒ Region → s → e s +replace r = replaceAction r ∘ view contents -- | Cuts region cut ∷ EditAction e s ⇒ Region → e s -cut r = replace r emptyContents +cut r = replaceAction r emptyContents -- | Pastes 'Contents' at some 'Point' -paste ∷ EditAction e s ⇒ Point → Contents s → e s -paste p = replace (p `till` p) +paste ∷ EditAction e s ⇒ Point → s → e s +paste p = replaceAction (p `till` p) ∘ view contents -- | Overwrites 'Contents' at some 'Point' -overwrite ∷ EditAction e s ⇒ Point → Contents s → e s -overwrite p c = replace (p `regionSize` measure c) c - --- | Get undo-action -inverse ∷ EditAction e s ⇒ Contents s → e s → e s -inverse cts act = evalState (perform act) cts - --- | Apply action to 'Contents' -applyEdit ∷ EditAction e s ⇒ e s → Contents s → Contents s -applyEdit act = snd ∘ runState (perform act) - --- | 'applyEdit' for 'Edit' -apply ∷ EditAction Replace s ⇒ Edit s → Contents s → Contents s -apply = applyEdit +overwrite ∷ EditAction e s ⇒ Point → s → e s +overwrite p c = replaceAction (p `regionSize` measure cts) cts where + cts = view contents c + +-- | 'perform' for 'Edit' +apply ∷ Editable s ⇒ Edit s → s → s +apply = over contents ∘ perform + +-- | Get undo +undo ∷ Editable s ⇒ Edit s → s → Edit s +undo e = inversed e ∘ view contents + +-- | Update regions +update ∷ (Editable s, Regioned r) ⇒ Edit s → r → r +update e = over regions (applyMap ∘ actionMap $ e) instance Editable s ⇒ EditAction Replace s where - replace = Replace - actionMap (Replace r w) = insertMap ((r ^. regionFrom) `regionSize` measure w) `mappend` cutMap r - perform (Replace r w) = state $ \cts → (Replace ((r ^. regionFrom) `regionSize` measure w) (cts ^. atRegion r), atRegion r .~ w $ cts) - -instance EditAction e s ⇒ EditAction (Chain e) s where - replace rgn txt = Chain [replace rgn txt] - actionMap (Chain []) = mempty - actionMap (Chain (r : rs)) = actionMap (applyMap (actionMap r) (Chain rs)) `mappend` actionMap r - perform (Chain rs) = (Chain ∘ reverse) <$> go mempty rs where - go _ [] = return [] - go m (c : cs) = (:) <$> perform (applyMap m c) <*> go (actionMap (applyMap m c) `mappend` m) cs - --- | Run edit monad and return result with updated contents -edit ∷ EditAction Replace s ⇒ s → r → EditM s r a → (a, s) -edit txt rs act = second (view $ edited . from contents) $ runState (runEditM act) (editState txt rs) - --- | Run edit monad and return updated contents -edit_ ∷ EditAction Replace s ⇒ s → r → EditM s r a → s -edit_ txt rs = snd ∘ edit txt rs - --- | Push action into history, also drops redo stack -push ∷ ActionIso (Edit s) → EditM s r () -push e = modify (over (history . undoStack) (e :)) >> modify (set (history . redoStack) []) - --- | Run edit action and returns corresponding redo-undo action -run_ ∷ (EditAction Replace s, ApplyMap r) ⇒ Edit s → EditM s r (ActionIso (Edit s)) -run_ e = do - cts ← gets (view edited) - let - (undo', cts') = runState (perform e) cts - modify (set edited cts') - modify (over regions (applyMap $ actionMap e)) - return $ ActionIso e undo' - --- | Run edit action with updating undo/redo stack -run ∷ (EditAction Replace s, ApplyMap r) ⇒ Edit s → EditM s r () -run e = run_ e >>= push - --- | Run edit actions, updating undo/redo stack for each of them, but act like they was applied simultaneously --- For example, cutting 1-st and then 3-rd letter: --- @run (cut first) >> run (cut third) -- 1234 -> 234 -> 23@ --- @runGroup [cut first, cut third] -- 1234 -> 234 -> 24@ -runGroup ∷ (EditAction Replace s, ApplyMap r) ⇒ [Edit s] → EditM s r () -runGroup = go mempty where - go _ [] = return () - go m (e:es) = run e' >> go (applyMap m $ actionMap e') es where - e' = applyMap m e - --- | Undo last action -undo ∷ (EditAction Replace s, ApplyMap r) ⇒ EditM s r () -undo = do - us@(~(u:_)) ← gets (view $ history . undoStack) - unless (null us) $ do - _ ← run_ (u ^. actionBack) - modify (over (history . undoStack) tail) - modify (over (history . redoStack) (u :)) - -redo ∷ (EditAction Replace s, ApplyMap r) ⇒ EditM s r () -redo = do - rs@(~(r:_)) ← gets (view $ history . redoStack) - unless (null rs) $ do - _ ← run_ (r ^. action) - modify (over (history . redoStack) tail) - modify (over (history . undoStack) (r :)) + replaceAction = Replace + actionMap (Replace r w) = insertMap (r & regionLength .~ measure w) `mappend` cutMap r + perform (Replace r w) cts = cts & atRegion r .~ w + inversed (Replace r w) cts = Replace (r & regionLength .~ measure w) (cts ^. atRegion r) + +instance Editable s ⇒ EditAction Edit s where + replaceAction rgn txt = Edit [replaceAction rgn txt] + actionMap = foldr go mempty ∘ view replaces where + go r m = actionMap (over replaceRegion (applyMap m) r) `mappend` m + perform = snd ∘ foldr go (mempty, id) ∘ view replaces where + go r (m, fn) = (actionMap r' `mappend` m, perform r' ∘ fn) where + r' = over replaceRegion (applyMap m) r + inversed e@(Edit rs) cts = Edit [Replace (applyMap m r) (cts ^. atRegion r) | Replace r _ ← rs] where + m = actionMap e diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-region-0.1.0.1/tests/Test.hs new/text-region-0.3.0.0/tests/Test.hs --- old/text-region-0.1.0.1/tests/Test.hs 2016-05-24 00:28:40.000000000 +0200 +++ new/text-region-0.3.0.0/tests/Test.hs 2017-04-26 03:18:31.000000000 +0200 @@ -1,3 +1,5 @@ +{-# LANGUAGE FlexibleContexts #-} + module Main ( main ) where @@ -5,7 +7,6 @@ import Prelude.Unicode import Control.Lens -import Control.Monad.State import Data.Text.Region import Test.Hspec @@ -28,21 +29,18 @@ main = hspec $ do describe "regions are updated" $ do it "should delete correctly" $ - apply (cut quux `mappend` cut bar) (by text) ≡ by "foo baz" - describe "editor monad" $ do - it "should perform undo/redo" $ - (≡ text) $ edit_ text () $ do - runGroup [ - cut bar, - replace quux (by nums), - paste start (by xxx)] - undo >> redo >> undo >> undo >> undo + apply (cut quux `mappend` cut bar) text ≡ "foo baz" + it "should perform undo" $ + let + act' = mconcat [cut bar, replace quux nums, paste start xxx] + undo' = undo act' text + in + (apply undo' ∘ apply act') text ≡ text it "should reverse text" $ - (≡ reverse text) $ edit_ text (pt 0 (length text)) $ replicateM_ (length text) $ do - -- cut first letter and insert at caret - let - l = pt 0 0 `till` pt 0 1 - c ← gets (view regions) - cts ← gets (view edited) - run $ paste c (view (atRegion l) cts) - run $ cut l + let + go 0 _ txt = txt + go n c txt = go (n - 1) (update act' c) (apply act' txt) where + act' = mconcat [cut first, paste c (txt ^. contents . atRegion first . from contents)] + first = pt 0 0 `till` pt 0 1 + in + go (length text) (pt 0 (length text)) text ≡ reverse text diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-region-0.1.0.1/text-region.cabal new/text-region-0.3.0.0/text-region.cabal --- old/text-region-0.1.0.1/text-region.cabal 2016-05-24 00:28:40.000000000 +0200 +++ new/text-region-0.3.0.0/text-region.cabal 2017-04-26 03:18:32.000000000 +0200 @@ -1,5 +1,5 @@ name: text-region -version: 0.1.0.1 +version: 0.3.0.0 synopsis: Marking text regions description: Provides functions to update text region positions according to text edit actions homepage: https://github.com/mvoidex/text-region @@ -28,10 +28,10 @@ base-unicode-symbols >= 0.2, aeson >= 0.9, bytestring >= 0.10, - containers >= 0.5, + -- containers >= 0.5, groups >= 0.4.0, lens >= 4.12, - mtl >= 2.2, + -- mtl >= 2.2, text >= 1.2.1 test-suite test @@ -46,7 +46,7 @@ base-unicode-symbols >= 0.2, text-region, hspec, - containers >= 0.5, + -- containers >= 0.5, lens >= 4.12, - mtl >= 2.2, + -- mtl >= 2.2, text >= 1.2.1

1 0

commit ghc-text-postgresql for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-text-postgresql for openSUSE:Factory checked in at 2017-08-31 21:00:31 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-text-postgresql (Old) and /work/SRC/openSUSE:Factory/.ghc-text-postgresql.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-text-postgresql" Thu Aug 31 21:00:31 2017 rev:3 rq:513515 version:0.0.2.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-text-postgresql/ghc-text-postgresql.changes 2017-01-18 21:44:28.277969563 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-text-postgresql.new/ghc-text-postgresql.changes 2017-08-31 21:00:32.832990060 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:05:43 UTC 2017 - psimons(a)suse.com + +- Update to version 0.0.2.3. + +------------------------------------------------------------------- Old: ---- text-postgresql-0.0.2.2.tar.gz New: ---- text-postgresql-0.0.2.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-text-postgresql.spec ++++++ --- /var/tmp/diff_new_pack.gHoQqK/_old 2017-08-31 21:00:34.108810804 +0200 +++ /var/tmp/diff_new_pack.gHoQqK/_new 2017-08-31 21:00:34.132807432 +0200 @@ -19,7 +19,7 @@ %global pkg_name text-postgresql %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.0.2.2 +Version: 0.0.2.3 Release: 0 Summary: Parser and Printer of PostgreSQL extended types License: BSD-3-Clause ++++++ text-postgresql-0.0.2.2.tar.gz -> text-postgresql-0.0.2.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-postgresql-0.0.2.2/text-postgresql.cabal new/text-postgresql-0.0.2.3/text-postgresql.cabal --- old/text-postgresql-0.0.2.2/text-postgresql.cabal 2017-01-05 09:58:46.000000000 +0100 +++ new/text-postgresql-0.0.2.3/text-postgresql.cabal 2017-07-17 03:07:56.000000000 +0200 @@ -1,5 +1,5 @@ name: text-postgresql -version: 0.0.2.2 +version: 0.0.2.3 synopsis: Parser and Printer of PostgreSQL extended types description: This package involves parser and printer for text expressions of PostgreSQL extended types. @@ -9,12 +9,13 @@ license-file: LICENSE author: Kei Hibino maintainer: ex8k.hibino(a)gmail.com -copyright: Copyright (c) 2015-2016 Kei Hibino +copyright: Copyright (c) 2015-2017 Kei Hibino category: Database build-type: Simple cabal-version: >=1.10 -tested-with: GHC == 8.0.1 +tested-with: GHC == 8.2.1 + , GHC == 8.0.1, GHC == 8.0.2 , GHC == 7.10.1, GHC == 7.10.2, GHC == 7.10.3 , GHC == 7.8.1, GHC == 7.8.2, GHC == 7.8.3, GHC == 7.8.4 , GHC == 7.6.1, GHC == 7.6.2, GHC == 7.6.3

1 0

commit ghc-text-metrics for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-text-metrics for openSUSE:Factory checked in at 2017-08-31 21:00:28 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-text-metrics (Old) and /work/SRC/openSUSE:Factory/.ghc-text-metrics.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-text-metrics" Thu Aug 31 21:00:28 2017 rev:3 rq:513514 version:0.3.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-text-metrics/ghc-text-metrics.changes 2017-06-22 10:39:20.558507940 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-text-metrics.new/ghc-text-metrics.changes 2017-08-31 21:00:30.341340143 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:06:28 UTC 2017 - psimons(a)suse.com + +- Update to version 0.3.0. + +------------------------------------------------------------------- Old: ---- text-metrics-0.2.0.tar.gz text-metrics.cabal New: ---- text-metrics-0.3.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-text-metrics.spec ++++++ --- /var/tmp/diff_new_pack.K6p7GD/_old 2017-08-31 21:00:32.157085026 +0200 +++ /var/tmp/diff_new_pack.K6p7GD/_new 2017-08-31 21:00:32.185081092 +0200 @@ -19,17 +19,18 @@ %global pkg_name text-metrics %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.2.0 +Version: 0.3.0 Release: 0 Summary: Calculate various string metrics efficiently License: BSD-3-Clause Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal… BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-containers-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-text-devel +BuildRequires: ghc-vector-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build %if %{with tests} BuildRequires: ghc-QuickCheck-devel @@ -52,7 +53,6 @@ %prep %setup -q -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ text-metrics-0.2.0.tar.gz -> text-metrics-0.3.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-metrics-0.2.0/CHANGELOG.md new/text-metrics-0.3.0/CHANGELOG.md --- old/text-metrics-0.2.0/CHANGELOG.md 2016-10-09 16:43:02.000000000 +0200 +++ new/text-metrics-0.3.0/CHANGELOG.md 2017-06-13 10:43:59.000000000 +0200 @@ -1,3 +1,13 @@ +## Text Metrics 0.3.0 + +* All functions are now implemented in pure Haskell. + +* All functions return `Int` or `Ratio Int` instead of `Natural` and `Ratio + Natural`. + +* Added `overlap` (returns overlap coefficient) and `jaccard` (returns + Jaccard similarity coefficient). + ## Text Metrics 0.2.0 * Made the `levenshtein`, `levenshteinNorm`, `damerauLevenshtein`, and diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-metrics-0.2.0/Data/Text/Metrics.hs new/text-metrics-0.3.0/Data/Text/Metrics.hs --- old/text-metrics-0.2.0/Data/Text/Metrics.hs 2016-10-09 16:43:02.000000000 +0200 +++ new/text-metrics-0.3.0/Data/Text/Metrics.hs 2017-06-13 10:42:49.000000000 +0200 @@ -1,34 +1,24 @@ -- | -- Module : Data.Text.Metrics --- Copyright : © 2016 Mark Karpov +-- Copyright : © 2016–2017 Mark Karpov -- License : BSD 3 clause -- --- Maintainer : Mark Karpov <markkarpov(a)openmailbox.org> +-- Maintainer : Mark Karpov <markkarpov92(a)gmail.com> -- Stability : experimental -- Portability : portable -- --- The module provides efficient implementations of various strings metrics. --- It works with strict 'Text' values and returns either 'Natural' numbers --- (because the metrics cannot be negative), or @'Ratio' 'Natural'@ values --- because returned values are rational non-negative numbers by definition. --- --- The functions provided here are the fastest implementations available for --- use in Haskell programs. In fact the functions are implemented in C for --- maximal efficiency, but this leads to a minor flaw. When we work with --- 'Text' values in C, they are represented as UTF-16 encoded strings of --- two-byte values. The algorithms treat the strings as if a character --- corresponds to one element in such strings, which is true for almost all --- modern text data. However, there are characters that are represented by --- two adjoined elements in UTF-16: emoji, historic scripts, less used --- Chinese ideographs, and some more. If input 'Text' of the functions --- contains such characters, the functions may return slightly incorrect --- result. Decide for yourself if this is acceptable for your use case, but --- chances are you will never run into situations when the functions produce --- incorrect results. - -{-# LANGUAGE CPP #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE OverloadedStrings #-} +-- The module provides efficient implementations of various strings metric +-- algorithms. It works with strict 'Text' values. +-- +-- __Note__: before version /0.3.0/ the package used C implementations of +-- the algorithms under the hood. Beginning from version /0.3.0/, the +-- implementations are written in Haskell while staying almost as fast, see: +-- +-- <https://markkarpov.com/post/migrating-text-metrics.html> + +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MultiWayIf #-} module Data.Text.Metrics ( -- * Levenshtein variants @@ -36,20 +26,25 @@ , levenshteinNorm , damerauLevenshtein , damerauLevenshteinNorm + -- * Treating inputs like sets + , overlap + , jaccard -- * Other , hamming , jaro , jaroWinkler ) where +import Control.Monad +import Control.Monad.ST +import Data.Map.Strict (Map) import Data.Ratio import Data.Text -import Foreign -import Foreign.C.Types -import Numeric.Natural -import System.IO.Unsafe -import qualified Data.Text as T -import qualified Data.Text.Foreign as TF +import GHC.Exts (inline) +import qualified Data.Map.Strict as M +import qualified Data.Text as T +import qualified Data.Text.Unsafe as TU +import qualified Data.Vector.Unboxed.Mutable as VUM #if !MIN_VERSION_base(4,8,0) import Control.Applicative @@ -59,82 +54,233 @@ -- Levenshtein variants -- | Return Levenshtein distance between two 'Text' values. Classic --- Levenshtein distance between two strings is minimal number of operations --- necessary to transform one string into another. For Levenshtein distance --- allowed operations are: deletion, insertion, and substitution. +-- Levenshtein distance between two strings is the minimal number of +-- operations necessary to transform one string into another. For +-- Levenshtein distance allowed operations are: deletion, insertion, and +-- substitution. -- -- See also: <https://en.wikipedia.org/wiki/Levenshtein_distance>. +-- +-- __Heads up__, before version /0.3.0/ this function returned +-- 'Data.Numeric.Natural'. -levenshtein :: Text -> Text -> Natural -levenshtein = withTwo c_levenshtein - -foreign import ccall unsafe "tmetrics_levenshtein" - c_levenshtein :: CUInt -> Ptr Word16 -> CUInt -> Ptr Word16 -> IO CUInt +levenshtein :: Text -> Text -> Int +levenshtein a b = fst (levenshtein_ a b) -- | Return normalized Levenshtein distance between two 'Text' values. -- Result is a non-negative rational number (represented as @'Ratio' --- 'Natural'@), where 0 signifies no similarity between the strings, while 1 --- means exact match. The operation is virtually as fast as 'levenshtein'. +-- 'Data.Numeric.Natural'@), where 0 signifies no similarity between the +-- strings, while 1 means exact match. -- -- See also: <https://en.wikipedia.org/wiki/Levenshtein_distance>. +-- +-- __Heads up__, before version /0.3.0/ this function returned @'Ratio' +-- 'Data.Numeric.Natural'@. + +levenshteinNorm :: Text -> Text -> Ratio Int +levenshteinNorm = norm levenshtein_ -levenshteinNorm :: Text -> Text -> Ratio Natural -levenshteinNorm = norm levenshtein -{-# INLINE levenshteinNorm #-} +-- | An internal helper, returns Levenshtein distance as the first element +-- of the tuple and max length of the two inputs as the second element of +-- the tuple. + +levenshtein_ :: Text -> Text -> (Int, Int) +levenshtein_ a b + | T.null a = (lenb, lenm) + | T.null b = (lena, lenm) + | otherwise = runST $ do + let v_len = lenb + 1 + v <- VUM.unsafeNew (v_len * 2) + let gov !i = + when (i < v_len) $ do + VUM.unsafeWrite v i i + gov (i + 1) + goi !i !na !v0 !v1 = do + let !(TU.Iter ai da) = TU.iter a na + goj !j !nb = + when (j < lenb) $ do + let !(TU.Iter bj db) = TU.iter b nb + cost = if ai == bj then 0 else 1 + x <- (+ 1) <$> VUM.unsafeRead v (v1 + j) + y <- (+ 1) <$> VUM.unsafeRead v (v0 + j + 1) + z <- (+ cost) <$> VUM.unsafeRead v (v0 + j) + VUM.unsafeWrite v (v1 + j + 1) (min x (min y z)) + goj (j + 1) (nb + db) + when (i < lena) $ do + VUM.unsafeWrite v v1 (i + 1) + goj 0 0 + goi (i + 1) (na + da) v1 v0 + gov 0 + goi 0 0 0 v_len + ld <- VUM.unsafeRead v (lenb + if even lena then 0 else v_len) + return (ld, lenm) + where + lena = T.length a + lenb = T.length b + lenm = max lena lenb +{-# INLINE levenshtein_ #-} -- | Return Damerau-Levenshtein distance between two 'Text' values. The -- function works like 'levenshtein', but the collection of allowed --- operations also includes transposition of two /adjacent/ characters. The --- function is about 20% slower than 'levenshtein', but still pretty fast. +-- operations also includes transposition of two /adjacent/ characters. -- -- See also: <https://en.wikipedia.org/wiki/Damerau%E2%80%93Levenshtein_distance>. +-- +-- __Heads up__, before version /0.3.0/ this function returned +-- 'Data.Numeric.Natural'. -damerauLevenshtein :: Text -> Text -> Natural -damerauLevenshtein = withTwo c_damerau_levenshtein - -foreign import ccall unsafe "tmetrics_damerau_levenshtein" - c_damerau_levenshtein :: CUInt -> Ptr Word16 -> CUInt -> Ptr Word16 -> IO CUInt +damerauLevenshtein :: Text -> Text -> Int +damerauLevenshtein a b = fst (damerauLevenshtein_ a b) -- | Return normalized Damerau-Levenshtein distance between two 'Text' --- values. Result is a non-negative rational number (represented as @'Ratio' --- 'Natural'@), where 0 signifies no similarity between the strings, while 1 --- means exact match. The operation is virtually as fast as --- 'damerauLevenshtein'. +-- values. 0 signifies no similarity between the strings, while 1 means +-- exact match. -- -- See also: <https://en.wikipedia.org/wiki/Damerau%E2%80%93Levenshtein_distance>. +-- +-- __Heads up__, before version /0.3.0/ this function returned @'Ratio' +-- 'Data.Numeric.Natural'@. + +damerauLevenshteinNorm :: Text -> Text -> Ratio Int +damerauLevenshteinNorm = norm damerauLevenshtein_ + +-- | An internal helper, returns Damerau-Levenshtein distance as the first +-- element of the tuple and max length of the two inputs as the second +-- element of the tuple. + +damerauLevenshtein_ :: Text -> Text -> (Int, Int) +damerauLevenshtein_ a b + | T.null a = (lenb, lenm) + | T.null b = (lena, lenm) + | otherwise = runST $ do + let v_len = lenb + 1 + v <- VUM.unsafeNew (v_len * 3) + let gov !i = + when (i < v_len) $ do + VUM.unsafeWrite v i i + gov (i + 1) + goi !i !na !ai_1 !v0 !v1 !v2 = do + let !(TU.Iter ai da) = TU.iter a na + goj !j !nb !bj_1 = + when (j < lenb) $ do + let !(TU.Iter bj db) = TU.iter b nb + cost = if ai == bj then 0 else 1 + x <- (+ 1) <$> VUM.unsafeRead v (v1 + j) + y <- (+ 1) <$> VUM.unsafeRead v (v0 + j + 1) + z <- (+ cost) <$> VUM.unsafeRead v (v0 + j) + let g = min x (min y z) + val <- (+ cost) <$> VUM.unsafeRead v (v2 + j - 1) + VUM.unsafeWrite v (v1 + j + 1) $ + if i > 0 && j > 0 && ai == bj_1 && ai_1 == bj && val < g + then val + else g + goj (j + 1) (nb + db) bj + when (i < lena) $ do + VUM.unsafeWrite v v1 (i + 1) + goj 0 0 'a' + goi (i + 1) (na + da) ai v1 v2 v0 + gov 0 + goi 0 0 'a' 0 v_len (v_len * 2) + ld <- VUM.unsafeRead v (lenb + (lena `mod` 3) * v_len) + return (ld, lenm) + where + lena = T.length a + lenb = T.length b + lenm = max lena lenb +{-# INLINE damerauLevenshtein_ #-} + +---------------------------------------------------------------------------- +-- Treating inputs like sets + +-- | Return overlap coefficient for two 'Text' values. Returned value is in +-- the range from 0 (no similarity) to 1 (exact match). Return 1 if both +-- 'Text' values are empty. +-- +-- See also: <https://en.wikipedia.org/wiki/Overlap_coefficient>. +-- +-- @since 0.3.0 + +overlap :: Text -> Text -> Ratio Int +overlap a b = + if d == 0 + then 1 % 1 + else intersectionSize (mkTextMap a) (mkTextMap b) % d + where + d = min (T.length a) (T.length b) + +-- | Return Jaccard similarity coefficient for two 'Text' values. Returned +-- value is in the range from 0 (no similarity) to 1 (exact match). Return 1 +-- if both +-- +-- See also: <https://en.wikipedia.org/wiki/Jaccard_index> +-- +-- @since 0.3.0 + +jaccard :: Text -> Text -> Ratio Int +jaccard a b = + if d == 0 + then 1 % 1 + else intersectionSize ma mb % d + where + ma = mkTextMap a + mb = mkTextMap b + d = unionSize ma mb + +-- | Make a map from 'Char' to 'Int' representing how many times the 'Char' +-- appears in the input 'Text'. + +mkTextMap :: Text -> Map Char Int +mkTextMap = T.foldl' f M.empty + where + f m ch = M.insertWith (+) ch 1 m +{-# INLINE mkTextMap #-} + +-- | Return intersection size between two 'Text'-maps. + +intersectionSize :: Map Char Int -> Map Char Int -> Int +intersectionSize a b = M.foldl' (+) 0 (M.intersectionWith min a b) +{-# INLINE intersectionSize #-} + +-- | Return union size between two 'Text'-maps. -damerauLevenshteinNorm :: Text -> Text -> Ratio Natural -damerauLevenshteinNorm = norm damerauLevenshtein -{-# INLINE damerauLevenshteinNorm #-} +unionSize :: Map Char Int -> Map Char Int -> Int +unionSize a b = M.foldl' (+) 0 (M.unionWith max a b) +{-# INLINE unionSize #-} ---------------------------------------------------------------------------- -- Other -- | /O(n)/ Return Hamming distance between two 'Text' values. Hamming --- distance is defined as number of positions at which the corresponding +-- distance is defined as the number of positions at which the corresponding -- symbols are different. The input 'Text' values should be of equal length -- or 'Nothing' will be returned. -- -- See also: <https://en.wikipedia.org/wiki/Hamming_distance>. +-- +-- __Heads up__, before version /0.3.0/ this function returned @'Maybe' +-- 'Data.Numeric.Natural'@. -hamming :: Text -> Text -> Maybe Natural +hamming :: Text -> Text -> Maybe Int hamming a b = if T.length a == T.length b - then Just . unsafePerformIO . TF.useAsPtr a $ \aptr size -> - TF.useAsPtr b $ \bptr _ -> - fromIntegral <$> c_hamming (fromIntegral size) aptr bptr + then Just (go 0 0 0) else Nothing - -foreign import ccall unsafe "tmetrics_hamming" - c_hamming :: CUInt -> Ptr Word16 -> Ptr Word16 -> IO CUInt + where + go !na !nb !r = + let !(TU.Iter cha da) = TU.iter a na + !(TU.Iter chb db) = TU.iter b nb + in if | na == len -> r + | cha /= chb -> go (na + da) (nb + db) (r + 1) + | otherwise -> go (na + da) (nb + db) r + len = TU.lengthWord16 a -- | Return Jaro distance between two 'Text' values. Returned value is in --- range from 0 (no similarity) to 1 (exact match). +-- the range from 0 (no similarity) to 1 (exact match). -- -- While the algorithm is pretty clear for artificial examples (like those -- from the linked Wikipedia article), for /arbitrary/ strings, it may be -- hard to decide which of two strings should be considered as one having --- “reference” order of characters (since order of matching characters in an +-- “reference” order of characters (order of matching characters in an -- essential part of the definition of the algorithm). This makes us -- consider the first string the “reference” string (with correct order of -- characters). Thus generally, @@ -144,71 +290,98 @@ -- This asymmetry can be found in all implementations of the algorithm on -- the internet, AFAIK. -- --- See also: <http://en.wikipedia.org/wiki/Jaro%E2%80%93Winkler_distance> +-- See also: <https://en.wikipedia.org/wiki/Jaro%E2%80%93Winkler_distance> -- -- @since 0.2.0 +-- +-- __Heads up__, before version /0.3.0/ this function returned @'Ratio' +-- 'Data.Numeric.Natural'@. -jaro :: Text -> Text -> Ratio Natural -jaro = jaroCommon (\_ _ _ _ x -> return x) - -jaroCommon :: (CUInt -> Ptr Word16 -> CUInt -> Ptr Word16 -> Ratio Natural -> IO (Ratio Natural)) -> Text -> Text -> Ratio Natural -jaroCommon f a b = unsafePerformIO $ alloca $ \m' -> alloca $ \t' -> - TF.useAsPtr a $ \aptr asize -> - TF.useAsPtr b $ \bptr bsize -> - if asize == 0 || bsize == 0 - then return (1 % 1) - else do - let asize' = fromIntegral asize - bsize' = fromIntegral bsize - c_jaro m' t' asize' aptr bsize' bptr - m <- fromIntegral <$> peek m' - t <- fromIntegral <$> peek t' - f asize' aptr bsize' bptr $ - if m == 0 - then 0 - else ((m % fromIntegral asize) + - (m % fromIntegral bsize) + - ((m - t) % m)) / 3 -{-# INLINE jaroCommon #-} - -foreign import ccall unsafe "tmetrics_jaro" - c_jaro :: Ptr CUInt -> Ptr CUInt -> CUInt -> Ptr Word16 -> CUInt -> Ptr Word16 -> IO () +jaro :: Text -> Text -> Ratio Int +jaro a b = + if T.null a || T.null b + then 0 % 1 + else runST $ do + let lena = T.length a + lenb = T.length b + d = + if lena >= 2 && lenb >= 2 + then max lena lenb `quot` 2 - 1 + else 0 + v <- VUM.replicate lenb (0 :: Int) + r <- VUM.replicate 3 (0 :: Int) -- tj, m, t + let goi !i !na !fromb = do + let !(TU.Iter ai da) = TU.iter a na + (from, fromb') = + if i >= d + then (i - d, fromb + TU.iter_ b fromb) + else (0, 0) + to = min (i + d + 1) lenb + goj !j !nb = + when (j < to) $ do + let !(TU.Iter bj db) = TU.iter b nb + used <- (== 1) <$> VUM.unsafeRead v j + if not used && ai == bj + then do + tj <- VUM.unsafeRead r 0 + if j < tj + then VUM.unsafeModify r (+ 1) 2 + else VUM.unsafeWrite r 0 j + VUM.unsafeWrite v j 1 + VUM.unsafeModify r (+ 1) 1 + else goj (j + 1) (nb + db) + when (i < lena) $ do + goj from fromb + goi (i + 1) (na + da) fromb' + goi 0 0 0 + m <- VUM.unsafeRead r 1 + t <- VUM.unsafeRead r 2 + return $ + if m == 0 + then 0 % 1 + else ((m % lena) + + (m % lenb) + + ((m - t) % m)) / 3 -- | Return Jaro-Winkler distance between two 'Text' values. Returned value -- is in range from 0 (no similarity) to 1 (exact match). -- --- See also: <http://en.wikipedia.org/wiki/Jaro%E2%80%93Winkler_distance> +-- See also: <https://en.wikipedia.org/wiki/Jaro%E2%80%93Winkler_distance> -- -- @since 0.2.0 +-- +-- __Heads up__, before version /0.3.0/ this function returned @'Ratio' +-- 'Data.Numeric.Natural'@. -jaroWinkler :: Text -> Text -> Ratio Natural -jaroWinkler = jaroCommon g +jaroWinkler :: Text -> Text -> Ratio Int +jaroWinkler a b = dj + (1 % 10) * l * (1 - dj) where - g asize aptr bsize bptr dj = do - l <- fromIntegral <$> c_common_prefix asize aptr bsize bptr - return (dj + (1 % 10) * l * (1 - dj)) + dj = inline (jaro a b) + l = fromIntegral (commonPrefix a b) -foreign import ccall unsafe "tmetrics_common_prefix" - c_common_prefix :: CUInt -> Ptr Word16 -> CUInt -> Ptr Word16 -> IO CUInt +-- | Return length of common prefix two 'Text' values have. + +commonPrefix :: Text -> Text -> Int +commonPrefix a b = go 0 0 0 + where + go !na !nb !r = + let !(TU.Iter cha da) = TU.iter a na + !(TU.Iter chb db) = TU.iter b nb + in if | na == lena -> r + | nb == lenb -> r + | cha == chb -> go (na + da) (nb + db) (r + 1) + | otherwise -> r + lena = TU.lengthWord16 a + lenb = TU.lengthWord16 b +{-# INLINE commonPrefix #-} ---------------------------------------------------------------------------- -- Helpers -withTwo - :: (CUInt -> Ptr Word16 -> CUInt -> Ptr Word16 -> IO CUInt) - -> Text - -> Text - -> Natural -withTwo f a b = - unsafePerformIO . TF.useAsPtr a $ \aptr asize -> - TF.useAsPtr b $ \bptr bsize -> - fromIntegral <$> f (fromIntegral asize) aptr (fromIntegral bsize) bptr -{-# INLINE withTwo #-} - -norm :: (Text -> Text -> Natural) -> Text -> Text -> Ratio Natural +norm :: (Text -> Text -> (Int, Int)) -> Text -> Text -> Ratio Int norm f a b = - let r = f a b + let (r, l) = f a b in if r == 0 then 1 % 1 - else 1 % 1 - r % fromIntegral (max (T.length a) (T.length b)) + else 1 % 1 - r % l {-# INLINE norm #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-metrics-0.2.0/LICENSE.md new/text-metrics-0.3.0/LICENSE.md --- old/text-metrics-0.2.0/LICENSE.md 2016-01-03 14:37:56.000000000 +0100 +++ new/text-metrics-0.3.0/LICENSE.md 2017-06-02 17:36:51.000000000 +0200 @@ -1,4 +1,4 @@ -Copyright © 2016 Mark Karpov +Copyright © 2016–2017 Mark Karpov All rights reserved. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-metrics-0.2.0/README.md new/text-metrics-0.3.0/README.md --- old/text-metrics-0.2.0/README.md 2016-10-09 16:43:02.000000000 +0200 +++ new/text-metrics-0.3.0/README.md 2017-06-13 10:42:49.000000000 +0200 @@ -7,76 +7,44 @@ [![Build Status](https://travis-ci.org/mrkkrp/text-metrics.svg?branch=master)](https… [![Coverage Status](https://coveralls.io/repos/mrkkrp/text-metrics/badge.svg?branch=master&service=github)](https://coveralls.io/github/mrkkrp/text-metrics?branch=master) -The library provides efficient implementations of various strings metrics. -It works with strict `Text` values and returns either `Natural` numbers -(because the metrics cannot be negative), or `Ratio Natural` values because -returned values are rational non-negative numbers by definition. - -The functions provided here are the fastest implementations available for -use in Haskell programs. In fact the functions are implemented in C for -maximal efficiency, but this leads to a minor flaw. When we work with `Text` -values in C, they are represented as UTF-16 encoded strings of two-byte -values. The algorithms treat the strings as if a character corresponds to -one element in such strings, which is true for almost all modern text data. -However, there are characters that are represented by two adjoined elements -in UTF-16: emoji, historic scripts, less used Chinese ideographs, and some -more. If input `Text` of the functions contains such characters, the -functions may return slightly incorrect result. Decide for yourself if this -is acceptable for your use case, but chances are you will never run into -situations when the functions produce incorrect results. +The library provides efficient implementations of various strings metric +algorithms. It works with strict `Text` values. The current version of the package implements: -* [Levenshtein distance](http://en.wikipedia.org/wiki/Levenshtein_distance) -* [Normalized Levenshtein distance](http://en.wikipedia.org/wiki/Levenshtein_distance) -* [Damerau-Levenshtein distance](http://en.wikipedia.org/wiki/Damerau%E2%80%93Levenshtein_distance) -* [Normalized Damerau-Levenshtein distance](http://en.wikipedia.org/wiki/Damerau%E2%80%93Levenshtein_distance) -* [Hamming distance](http://en.wikipedia.org/wiki/Hamming_distance) -* [Jaro distance](http://en.wikipedia.org/wiki/Jaro%E2%80%93Winkler_distance) -* [Jaro-Winkler distance](http://en.wikipedia.org/wiki/Jaro%E2%80%93Winkler_distance) - -TODO list: - -* [Overlap coefficient](http://en.wikipedia.org/wiki/Overlap_coefficient) -* [Jaccard similarity coefficient](http://en.wikipedia.org/wiki/Jaccard_index) +* [Levenshtein distance](https://en.wikipedia.org/wiki/Levenshtein_distance) +* [Normalized Levenshtein distance](https://en.wikipedia.org/wiki/Levenshtein_distance) +* [Damerau-Levenshtein distance](https://en.wikipedia.org/wiki/Damerau%E2%80%93Levenshtein_distanc… +* [Normalized Damerau-Levenshtein distance](https://en.wikipedia.org/wiki/Damerau%E2%80%93Levenshtein_distanc… +* [Hamming distance](https://en.wikipedia.org/wiki/Hamming_distance) +* [Jaro distance](https://en.wikipedia.org/wiki/Jaro%E2%80%93Winkler_distance) +* [Jaro-Winkler distance](https://en.wikipedia.org/wiki/Jaro%E2%80%93Winkler_distance) +* [Overlap coefficient](https://en.wikipedia.org/wiki/Overlap_coefficient) +* [Jaccard similarity coefficient](https://en.wikipedia.org/wiki/Jaccard_index) ## Comparison with the `edit-distance` package -There -is [`edit-distance`](https://hackage.haskell.org/package/edit-distance) -package whose scope overlaps with the scope of this package. The differences -are: +There is [`edit-distance`](https://hackage.haskell.org/package/edit-distance) package whose scope overlaps with the scope of +this package. The differences are: * `edit-distance` allows to specify costs for every operation when calculating Levenshtein distance (insertion, deletion, substitution, and transposition). This is rarely needed though in real-world applications, IMO. -* `edit-distance` only provides single Levenshtein distance, `text-metrics` - aims to provide implementations of most string metrics algorithms. +* `edit-distance` only provides Levenshtein distance, `text-metrics` aims to + provide implementations of most string metrics algorithms. * `edit-distance` works on `Strings`, while `text-metrics` works on strict `Text` values. -* As `README.md` of `edit-distance` states, “[the algorithms] have been - fairly heavily optimized”, which is apparently true, yet the - `text-metrics` is faster for short strings (under 64 characters) and even - faster for longer strings (scales better). How much faster? For short - strings more than ×3, and about ×4 for longer strings. - ## Implementation -All “meat” of the algorithms is written in C in a rather straightforward -way. Levenshtein variants are based on the “iterative algorithm with two -matrix rows” from Wikipedia with additional improvement that we do not copy -current row of distances into previous row, but just swap the pointers -(which is OK, since the arrays have equal length and current row will be -overwritten in the next iteration anyway). - -Normalized versions are defined as thin (inlined) Haskell wrappers. +Although we originally used C for speed, currently all functions are pure +Haskell tuned for performance. See [this blog post](https://markkarpov.com/post/migrating-text-metrics.html) for more info. ## License -Copyright © 2016 Mark Karpov +Copyright © 2016–2017 Mark Karpov Distributed under BSD 3 clause license. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-metrics-0.2.0/bench/Main.hs new/text-metrics-0.3.0/bench/Main.hs --- old/text-metrics-0.2.0/bench/Main.hs 2016-10-09 16:43:02.000000000 +0200 +++ new/text-metrics-0.3.0/bench/Main.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,64 +0,0 @@ --- --- Benchmarks for the ‘text-metrics’ package. --- --- Copyright © 2016 Mark Karpov <markkarpov(a)openmailbox.org> --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- * Redistributions of source code must retain the above copyright notice, --- this list of conditions and the following disclaimer. --- --- * 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. --- --- * Neither the name Mark Karpov nor the names of 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 “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 HOLDERS 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. - -module Main (main) where - -import Control.DeepSeq -import Criterion.Main -import Data.Text (Text) -import Data.Text.Metrics -import qualified Data.Text as T - -main :: IO () -main = defaultMain - [ btmetric "levenshtein" levenshtein - , btmetric "levenshteinNorm" levenshteinNorm - , btmetric "damerauLevenshtein" damerauLevenshtein - , btmetric "damerauLevenshteinNorm" damerauLevenshteinNorm - , btmetric "hamming" hamming - , btmetric "jaro" jaro - , btmetric "jaroWinkler" jaroWinkler ] - --- | Produce benchmark group to test - -btmetric :: NFData a => String -> (Text -> Text -> a) -> Benchmark -btmetric name f = bgroup name (bs <$> stdSeries) - where - bs n = env (return (testData n, testData n)) (bench (show n) . nf (uncurry f)) - --- | The series of lengths to try with every function as part of 'btmetric'. - -stdSeries :: [Int] -stdSeries = [5,10,20,40,80,160] - -testData :: Int -> Text -testData n = T.pack . take n . drop (n `mod` 4) . cycle $ ['a'..'z'] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-metrics-0.2.0/bench-memory/Main.hs new/text-metrics-0.3.0/bench-memory/Main.hs --- old/text-metrics-0.2.0/bench-memory/Main.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/text-metrics-0.3.0/bench-memory/Main.hs 2017-06-13 10:42:49.000000000 +0200 @@ -0,0 +1,38 @@ +module Main (main) where + +import Control.DeepSeq +import Control.Monad +import Data.Text (Text) +import Data.Text.Metrics +import Weigh +import qualified Data.Text as T + +main :: IO () +main = mainWith $ do + setColumns [Case, Allocated, GCs, Max] + bmetric "levenshtein" levenshtein + bmetric "levenshteinNorm" levenshteinNorm + bmetric "damerauLevenshtein" damerauLevenshtein + bmetric "damerauLevenshteinNorm" damerauLevenshteinNorm + bmetric "overlap" overlap + bmetric "jaccard" jaccard + bmetric "hamming" hamming + bmetric "jaro" jaro + bmetric "jaroWinkler" jaroWinkler + +-- | Perform a series to measurements with the same metric function. + +bmetric :: NFData a + => String -- ^ Name of the benchmark group + -> (Text -> Text -> a) -- ^ The function to benchmark + -> Weigh () +bmetric name f = forM_ stdSeries $ \n -> + func (name ++ "/" ++ show n) (uncurry f) (testData n, testData n) + +-- | The series of lengths to try with every function as part of 'btmetric'. + +stdSeries :: [Int] +stdSeries = [5,10,20,40,80,160] + +testData :: Int -> Text +testData n = T.pack . take n . drop (n `mod` 4) . cycle $ ['a'..'z'] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-metrics-0.2.0/bench-speed/Main.hs new/text-metrics-0.3.0/bench-speed/Main.hs --- old/text-metrics-0.2.0/bench-speed/Main.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/text-metrics-0.3.0/bench-speed/Main.hs 2017-06-13 10:42:49.000000000 +0200 @@ -0,0 +1,34 @@ +module Main (main) where + +import Control.DeepSeq +import Criterion.Main +import Data.Text (Text) +import Data.Text.Metrics +import qualified Data.Text as T + +main :: IO () +main = defaultMain + [ btmetric "levenshtein" levenshtein + , btmetric "levenshteinNorm" levenshteinNorm + , btmetric "damerauLevenshtein" damerauLevenshtein + , btmetric "damerauLevenshteinNorm" damerauLevenshteinNorm + , btmetric "overlap" overlap + , btmetric "jaccard" jaccard + , btmetric "hamming" hamming + , btmetric "jaro" jaro + , btmetric "jaroWinkler" jaroWinkler ] + +-- | Produce benchmark group to test. + +btmetric :: NFData a => String -> (Text -> Text -> a) -> Benchmark +btmetric name f = bgroup name (bs <$> stdSeries) + where + bs n = env (return (testData n, testData n)) (bench (show n) . nf (uncurry f)) + +-- | The series of lengths to try with every function as part of 'btmetric'. + +stdSeries :: [Int] +stdSeries = [5,10,20,40,80,160] + +testData :: Int -> Text +testData n = T.pack . take n . drop (n `mod` 4) . cycle $ ['a'..'z'] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-metrics-0.2.0/cbits/text_metrics.c new/text-metrics-0.3.0/cbits/text_metrics.c --- old/text-metrics-0.2.0/cbits/text_metrics.c 2016-10-09 16:43:02.000000000 +0200 +++ new/text-metrics-0.3.0/cbits/text_metrics.c 1970-01-01 01:00:00.000000000 +0100 @@ -1,207 +0,0 @@ -/* - * This file is part of ‘text-metrics’ package. - * - * Copyright © 2016 Mark Karpov - * - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * * Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * * 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. - * - * * Neither the name Mark Karpov nor the names of 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 “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 HOLDERS 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. - */ - -#include "text_metrics.h" - -/* Levenshtein variants */ - -unsigned int tmetrics_levenshtein (unsigned int la, uint16_t *a, unsigned int lb, uint16_t *b) -{ - if (la == 0) return lb; - if (lb == 0) return la; - - unsigned int v_len = lb + 1, *v0, *v1, i, j; - - if (v_len > VLEN_MAX) - { - v0 = malloc(sizeof(unsigned int) * v_len); - v1 = malloc(sizeof(unsigned int) * v_len); - } - else - { - v0 = alloca(sizeof(unsigned int) * v_len); - v1 = alloca(sizeof(unsigned int) * v_len); - } - - for (i = 0; i < v_len; i++) - v0[i] = i; - - for (i = 0; i < la; i++) - { - v1[0] = i + 1; - - for (j = 0; j < lb; j++) - { - unsigned int cost = *(a + i) == *(b + j) ? 0 : 1; - unsigned int x = *(v1 + j) + 1; - unsigned int y = *(v0 + j + 1) + 1; - unsigned int z = *(v0 + j) + cost; - *(v1 + j + 1) = MIN(x, MIN(y, z)); - } - - unsigned int *ptr = v0; - v0 = v1; - v1 = ptr; - } - - unsigned int result = *(v0 + lb); - - if (v_len > VLEN_MAX) - { - free(v0); - free(v1); - } - - return result; -} - -unsigned int tmetrics_damerau_levenshtein (unsigned int la, uint16_t *a, unsigned int lb, uint16_t *b) -{ - if (la == 0) return lb; - if (lb == 0) return la; - - unsigned int v_len = lb + 1, *v0, *v1, *v2, i, j; - - if (v_len > VLEN_MAX) - { - v0 = malloc(sizeof(unsigned int) * v_len); - v1 = malloc(sizeof(unsigned int) * v_len); - v2 = malloc(sizeof(unsigned int) * v_len); - } - else - { - v0 = alloca(sizeof(unsigned int) * v_len); - v1 = alloca(sizeof(unsigned int) * v_len); - v2 = alloca(sizeof(unsigned int) * v_len); - } - - for (i = 0; i < v_len; i++) - v0[i] = i; - - for (i = 0; i < la; i++) - { - v1[0] = i + 1; - - for (j = 0; j < lb; j++) - { - unsigned int cost = *(a + i) == *(b + j) ? 0 : 1; - unsigned int x = *(v1 + j) + 1; - unsigned int y = *(v0 + j + 1) + 1; - unsigned int z = *(v0 + j) + cost; - *(v1 + j + 1) = MIN(x, MIN(y, z)); - unsigned int val = *(v2 + j - 1) + cost; - if ( i > 0 && - j > 0 && - *(a + i) == *(b + j - 1) && - *(a + i - 1) == *(b + j) && - val < *(v1 + j + 1) ) - *(v1 + j + 1) = val; - } - - unsigned int *ptr = v0; - v0 = v1; - v1 = v2; - v2 = ptr; - } - - unsigned int result = *(v0 + lb); - - if (v_len > VLEN_MAX) - { - free(v0); - free(v1); - free(v2); - } - - return result; -} - -/* Other */ - -unsigned int tmetrics_hamming (unsigned int len, uint16_t *a, uint16_t *b) -{ - unsigned int acc = 0, i; - for (i = 0; i < len; i++) - { - if (*(a + i) != *(b + i)) acc++; - } - return acc; -} - -void tmetrics_jaro (unsigned int *m, unsigned int *t, unsigned int la, uint16_t *a, unsigned int lb, uint16_t *b) -{ - unsigned int d = 0, i, j, tj = 0, from, to; - char *v; - - *m = 0, *t = 0; - - if (la >= 2 && lb >= 2) - d = MAX(lb, la) / 2 - 1; - - if (lb > VLEN_MAX) v = malloc(sizeof(char) * lb); - else v = alloca(sizeof(char) * lb); - - for (i = 0; i < lb; i++) *(v + i) = 0; - - for (i = 0; i < la; i++) - { - from = i < d ? 0 : i - d; - to = MIN(i + d + 1, lb); - for (j = from; j < to; j++) - { - if (*(v + j)) continue; - - if (*(a + i) == *(b + j)) - { - if (j < tj) (*t)++; - else tj = j; - *(v + j) = 1; - (*m)++; - break; - } - } - } - - if (lb > VLEN_MAX) free(v); -} - -unsigned int tmetrics_common_prefix (unsigned int la, uint16_t *a, unsigned int lb, uint16_t *b) -{ - unsigned int acc = 0, i, l = MIN(la, lb); - for (i = 0; i < l; i++) - { - if (*(a + i) == *(b + i)) acc++; - else break; - } - return acc; -} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-metrics-0.2.0/cbits/text_metrics.h new/text-metrics-0.3.0/cbits/text_metrics.h --- old/text-metrics-0.2.0/cbits/text_metrics.h 2016-10-09 16:43:02.000000000 +0200 +++ new/text-metrics-0.3.0/cbits/text_metrics.h 1970-01-01 01:00:00.000000000 +0100 @@ -1,56 +0,0 @@ -/* - * This file is part of ‘text-metrics’ package. - * - * Copyright © 2016 Mark Karpov - * - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * * Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * * 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. - * - * * Neither the name Mark Karpov nor the names of 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 “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 HOLDERS 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. - */ - -#ifndef TEXT_METRICS_H -#define TEXT_METRICS_H - -#include <stdint.h> -#include <stdlib.h> - -#define MAX(a, b) ((a) > (b) ? (a) : (b)) -#define MIN(a, b) ((a) < (b) ? (a) : (b)) - -#define VLEN_MAX 255 /* Up to this length we use alloca. */ - -/* Levenshein variants */ - -unsigned int tmetrics_levenshtein (unsigned int, uint16_t *, unsigned int, uint16_t *); -unsigned int tmetrics_damerau_levenshtein (unsigned int, uint16_t *, unsigned int, uint16_t *); - -/* Other */ - -unsigned int tmetrics_hamming (unsigned int, uint16_t *, uint16_t *); -void tmetrics_jaro (unsigned int *, unsigned int *, unsigned int, uint16_t *, unsigned int, uint16_t *); -unsigned int tmetrics_common_prefix (unsigned int, uint16_t *, unsigned int, uint16_t *); - -#endif /* TEXT_METRICS_H */ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-metrics-0.2.0/tests/Main.hs new/text-metrics-0.3.0/tests/Main.hs --- old/text-metrics-0.2.0/tests/Main.hs 2016-10-09 16:43:02.000000000 +0200 +++ new/text-metrics-0.3.0/tests/Main.hs 2017-06-13 10:42:49.000000000 +0200 @@ -1,35 +1,3 @@ --- --- Tests for the ‘text-metrics’ package. --- --- Copyright © 2016 Mark Karpov <markkarpov(a)openmailbox.org> --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- * Redistributions of source code must retain the above copyright notice, --- this list of conditions and the following disclaimer. --- --- * 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. --- --- * Neither the name Mark Karpov nor the names of 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 “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 HOLDERS 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. - {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -62,6 +30,9 @@ testPair levenshtein "cake" "drake" 2 testPair levenshtein "saturday" "sunday" 3 testPair levenshtein "red" "wax" 3 +#if __GLASGOW_HASKELL__ >= 710 + testPair levenshtein "a😀c" "abc" 1 +#endif testPair levenshtein "lucky" "lucky" 0 testPair levenshtein "" "" 0 describe "levenshteinNorm" $ do @@ -70,6 +41,9 @@ testPair levenshteinNorm "cake" "drake" (3 % 5) testPair levenshteinNorm "saturday" "sunday" (5 % 8) testPair levenshteinNorm "red" "wax" (0 % 1) +#if __GLASGOW_HASKELL__ >= 710 + testPair levenshteinNorm "a😀c" "abc" (2 % 3) +#endif testPair levenshteinNorm "lucky" "lucky" (1 % 1) testPair levenshteinNorm "" "" (1 % 1) describe "damerauLevenshtein" $ do @@ -79,6 +53,9 @@ testPair damerauLevenshtein "nose" "ones" 2 testPair damerauLevenshtein "thing" "sign" 3 testPair damerauLevenshtein "red" "wax" 3 +#if __GLASGOW_HASKELL__ >= 710 + testPair damerauLevenshtein "a😀c" "abc" 1 +#endif testPair damerauLevenshtein "lucky" "lucky" 0 testPair damerauLevenshtein "" "" 0 describe "damerauLevenshteinNorm" $ do @@ -88,6 +65,9 @@ testPair damerauLevenshteinNorm "nose" "ones" (1 % 2) testPair damerauLevenshteinNorm "thing" "sign" (2 % 5) testPair damerauLevenshteinNorm "red" "wax" (0 % 1) +#if __GLASGOW_HASKELL__ >= 710 + testPair damerauLevenshteinNorm "a😀c" "abc" (2 % 3) +#endif testPair damerauLevenshteinNorm "lucky" "lucky" (1 % 1) testPair damerauLevenshteinNorm "" "" (1 % 1) describe "hamming" $ do @@ -98,6 +78,9 @@ testPair hamming "2173896" "2233796" (Just 3) testPair hamming "toned" "roses" (Just 3) testPair hamming "red" "wax" (Just 3) +#if __GLASGOW_HASKELL__ >= 710 + testPair hamming "a😀c" "abc" (Just 1) +#endif testPair hamming "lucky" "lucky" (Just 0) testPair hamming "" "" (Just 0) testPair hamming "small" "big" Nothing @@ -117,7 +100,10 @@ testPair jaro "five" "ten" (0 % 1) testPair jaro "ten" "five" (0 % 1) testPair jaro "lucky" "lucky" (1 % 1) - testPair jaro "" "" (1 % 1) +#if __GLASGOW_HASKELL__ >= 710 + testPair jaro "a😀c" "abc" (7 % 9) +#endif + testPair jaro "" "" (0 % 1) describe "jaroWinkler" $ do testPair jaroWinkler "aa" "a" (17 % 20) testPair jaroWinkler "a" "aa" (17 % 20) @@ -134,7 +120,29 @@ testPair jaroWinkler "five" "ten" (0 % 1) testPair jaroWinkler "ten" "five" (0 % 1) testPair jaroWinkler "lucky" "lucky" (1 % 1) - testPair jaroWinkler "" "" (1 % 1) +#if __GLASGOW_HASKELL__ >= 710 + testPair jaroWinkler "a😀c" "abc" (4 % 5) +#endif + testPair jaroWinkler "" "" (0 % 1) + describe "overlap" $ do + testSwap overlap + testPair overlap "fly" "butterfly" (1 % 1) + testPair overlap "night" "nacht" (3 % 5) + testPair overlap "context" "contact" (5 % 7) + testPair overlap "red" "wax" (0 % 1) +#if __GLASGOW_HASKELL__ >= 710 + testPair overlap "a😀c" "abc" (2 % 3) +#endif + testPair overlap "lucky" "lucky" (1 % 1) + describe "jaccard" $ do + testSwap jaccard + testPair jaccard "xxx" "xyx" (1 % 2) + testPair jaccard "night" "nacht" (3 % 7) + testPair jaccard "context" "contact" (5 % 9) +#if __GLASGOW_HASKELL__ >= 710 + testPair overlap "a😀c" "abc" (2 % 3) +#endif + testPair jaccard "lucky" "lucky" (1 % 1) -- | Test that given function returns the same results when order of -- arguments is swapped. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-metrics-0.2.0/text-metrics.cabal new/text-metrics-0.3.0/text-metrics.cabal --- old/text-metrics-0.2.0/text-metrics.cabal 2016-10-09 16:43:36.000000000 +0200 +++ new/text-metrics-0.3.0/text-metrics.cabal 2017-06-13 12:04:50.000000000 +0200 @@ -1,42 +1,11 @@ --- --- Cabal configuration for ‘text-metrics’ package. --- --- Copyright © 2016 Mark Karpov <markkarpov(a)openmailbox.org> --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- * Redistributions of source code must retain the above copyright notice, --- this list of conditions and the following disclaimer. --- --- * 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. --- --- * Neither the name Mark Karpov nor the names of 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 “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 HOLDERS 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. - name: text-metrics -version: 0.2.0 +version: 0.3.0 cabal-version: >= 1.10 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 license: BSD3 license-file: LICENSE.md -author: Mark Karpov <markkarpov(a)openmailbox.org> -maintainer: Mark Karpov <markkarpov(a)openmailbox.org> +author: Mark Karpov <markkarpov92(a)gmail.com> +maintainer: Mark Karpov <markkarpov92(a)gmail.com> homepage: https://github.com/mrkkrp/text-metrics bug-reports: https://github.com/mrkkrp/text-metrics/issues category: Text, Algorithms @@ -45,7 +14,6 @@ description: Calculate various string metrics efficiently. extra-doc-files: CHANGELOG.md , README.md -extra-source-files: cbits/*.h source-repository head type: git @@ -58,12 +26,10 @@ library build-depends: base >= 4.7 && < 5.0 + , containers >= 0.5.6.2 && < 0.6 , text >= 0.2 && < 1.3 - if !impl(ghc >= 7.10) - build-depends: nats == 1.* + , vector >= 0.11 && < 0.13 exposed-modules: Data.Text.Metrics - c-sources: cbits/text_metrics.c - include-dirs: cbits if flag(dev) ghc-options: -Wall -Werror else @@ -78,28 +44,39 @@ , base >= 4.7 && < 5.0 , hspec >= 2.0 && < 3.0 , text >= 0.2 && < 1.3 - , text-metrics >= 0.2.0 - if !impl(ghc >= 7.10) - build-depends: nats == 1.* + , text-metrics if flag(dev) ghc-options: -Wall -Werror else ghc-options: -O2 -Wall default-language: Haskell2010 -benchmark bench +benchmark bench-speed main-is: Main.hs - hs-source-dirs: bench + hs-source-dirs: bench-speed type: exitcode-stdio-1.0 - build-depends: base >= 4.7 && < 5.0 - , criterion >= 0.6.2.1 && < 1.2 - , deepseq >= 1.4 && < 1.5 + build-depends: base >= 4.7 && < 5.0 + , criterion >= 0.6.2.1 && < 1.3 + , deepseq >= 1.4 && < 1.5 , text >= 0.2 && < 1.3 - , text-metrics >= 0.2.0 - if !impl(ghc >= 7.10) - build-depends: nats == 1.* + , text-metrics if flag(dev) - ghc-options: -Wall -Werror + ghc-options: -O2 -Wall -Werror + else + ghc-options: -O2 -Wall + default-language: Haskell2010 + +benchmark bench-memory + main-is: Main.hs + hs-source-dirs: bench-memory + type: exitcode-stdio-1.0 + build-depends: base >= 4.7 && < 5.0 + , deepseq >= 1.4 && < 1.5 + , text >= 0.2 && < 1.3 + , text-metrics + , weigh >= 0.0.4 + if flag(dev) + ghc-options: -O2 -Wall -Werror else ghc-options: -O2 -Wall default-language: Haskell2010

1 0

commit ghc-text-all for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-text-all for openSUSE:Factory checked in at 2017-08-31 21:00:26 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-text-all (Old) and /work/SRC/openSUSE:Factory/.ghc-text-all.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-text-all" Thu Aug 31 21:00:26 2017 rev:3 rq:513513 version:0.4.1.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-text-all/ghc-text-all.changes 2017-05-17 10:55:33.596649731 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-text-all.new/ghc-text-all.changes 2017-08-31 21:00:28.309625604 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:27 UTC 2017 - psimons(a)suse.com + +- Update to version 0.4.1.1. + +------------------------------------------------------------------- Old: ---- text-all-0.3.1.0.tar.gz New: ---- text-all-0.4.1.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-text-all.spec ++++++ --- /var/tmp/diff_new_pack.ZmzYtr/_old 2017-08-31 21:00:29.509457024 +0200 +++ /var/tmp/diff_new_pack.ZmzYtr/_new 2017-08-31 21:00:29.529454215 +0200 @@ -18,7 +18,7 @@ %global pkg_name text-all Name: ghc-%{pkg_name} -Version: 0.3.1.0 +Version: 0.4.1.1 Release: 0 Summary: Everything Data.Text related in one package License: BSD-3-Clause @@ -26,10 +26,11 @@ Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-bytestring-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-text-devel BuildRequires: ghc-text-format-devel -BuildRequires: ghc-text-show-devel +BuildRequires: ghc-utf8-string-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build %description ++++++ text-all-0.3.1.0.tar.gz -> text-all-0.4.1.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-all-0.3.1.0/CHANGELOG.md new/text-all-0.4.1.1/CHANGELOG.md --- old/text-all-0.3.1.0/CHANGELOG.md 2017-04-23 23:29:06.000000000 +0200 +++ new/text-all-0.4.1.1/CHANGELOG.md 2017-07-11 17:22:29.000000000 +0200 @@ -1,18 +1,39 @@ +# 0.4.1.1 + +* Dropped compatibility with GHC 7.4.2 and added a lower bound for + `bytestring`. + +# 0.4.1.0 + +* Now `toString` and other functions work with `ByteString` as well. Lenient + UTF-8 decoding is used. + +* Added `toByteString` and `toLByteString`. + +# 0.4.0.0 + +* Dropped `text-show` entirely; now `show` works via `Prelude.show`, which is + slower but avoids a heavy dependency. It is recommended to use + `text-format`, `formatting` or `fmt` if fast formatting is needed. + +* Added `show` and `format` to `Data.Text.Lazy.All`. + # 0.3.1.0 -* Bumped the text-show upper bound. (text-show added some instances.) +* Bumped the `text-show` upper bound. (`text-show` added some instances.) # 0.3.0.2 -* Bumped the text-show upper bound. +* Bumped the `text-show` upper bound. # 0.3.0.1 -* Bumped the text-show upper bound. +* Bumped the `text-show` upper bound. # 0.3.0.0 -* Replaced functions like `strictToBuilder` with conversion typeclasses (i.e. now it's just `toStrict`, `toLazy`, `toBuilder`, and `toString`). +* Replaced functions like `strictToBuilder` with conversion typeclasses (i.e. + now it's just `toStrict`, `toLazy`, `toBuilder`, and `toString`). # 0.2.0.0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-all-0.3.1.0/lib/Data/Text/All.hs new/text-all-0.4.1.1/lib/Data/Text/All.hs --- old/text-all-0.3.1.0/lib/Data/Text/All.hs 2017-04-23 23:29:06.000000000 +0200 +++ new/text-all-0.4.1.1/lib/Data/Text/All.hs 2017-07-11 17:22:29.000000000 +0200 @@ -1,16 +1,15 @@ -{-# LANGUAGE -GADTs, -TypeSynonymInstances - #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeSynonymInstances #-} -{- | -Here are the nice things from text that you get (thanks to a restrictive lower bound) but that aren't documented elsewhere in this module: +{- | Note that thanks to a restrictive lower bound on @text@, you can be sure +that the following things will be present in the "Data.Text" reexport: * The 'T.takeWhileEnd' function. -* An instance for @Semigroup@. -* An instance for @printf@ (i.e. you can use a 'Text' as one of @printf@'s arguments). -* An instance for @Binary@. +* An instance for @Semigroup Text@. +* An instance for @Binary Text@. +* An instance for 'Text.Printf.printf' (i.e. you can use a 'Text' as one of + @printf@'s arguments). -} module Data.Text.All ( @@ -24,17 +23,14 @@ -- * Conversion -- $conversion - toStrict, toLazy, toBuilder, toString, + toStrict, toLazy, + toBuilder, + toString, + toByteString, toLByteString, -- * Showing -- $showing - - -- ** Strict 'Text' - show, show', - -- ** Lazy 'Text' - lshow, lshow', - -- ** 'Builder' - bshow, bshow', + show, lshow, bshow, -- * Formatting -- $formatting @@ -53,12 +49,18 @@ import Data.Text import Data.Text.IO import Data.Text.Encoding +import Data.Text.Encoding.Error import qualified Data.Text.Lazy.Builder as B -import Data.Text.Lazy.Builder (Builder) +import Data.Text.Lazy.Builder (Builder, flush) import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL -import TextShow hiding (Builder, toString) +import qualified Data.ByteString.UTF8 as UTF8 +import qualified Data.ByteString.Lazy.UTF8 as UTF8L import Data.Text.Format hiding (format, print, hprint, build) import Data.Text.Format.Params @@ -72,38 +74,27 @@ {- $showing -'show' is a fast variant of @show@ for 'Text' \/ 'Builder' that only works for some types – it's very fast for 'Int', etc, but doesn't work for types that you have defined yourself. (If you want more instances, import <https://hackage.haskell.org/package/text-show-instances text-show-instances>.) - -'show'' is a shortcut for @pack.show@ that works for everything with a 'Show' instance but is slower. +Variants below use 'P.show' from "Prelude". If you want faster showing, +either use <https://hackage.haskell.org/package/text-show text-show> or some +formatting library. -} -show :: TextShow a => a -> Text -show = showt +show :: Show a => a -> Text +show = pack . P.show {-# INLINE show #-} -lshow :: TextShow a => a -> LText -lshow = showtl +lshow :: Show a => a -> LText +lshow = TL.pack . P.show {-# INLINE lshow #-} -bshow :: TextShow a => a -> Builder -bshow = showb +bshow :: Show a => a -> Builder +bshow = B.fromString . P.show {-# INLINE bshow #-} -show' :: Show a => a -> Text -show' = pack . P.show -{-# INLINE show' #-} - -lshow' :: Show a => a -> LText -lshow' = TL.pack . P.show -{-# INLINE lshow' #-} - -bshow' :: Show a => a -> Builder -bshow' = B.fromString . P.show -{-# INLINE bshow' #-} - {- $formatting -'format' is a function similar to @printf@ in spirit. Don't forget to enable @OverloadedStrings@ if you want to use it! +'format' is a function similar to @printf@ in spirit. Don't forget to enable +@OverloadedStrings@ if you want to use it! >>> format "{}+{}={}" (2, 2, 4) "2+2=4" @@ -133,8 +124,9 @@ bformat = Format.build {-# INLINE bformat #-} -{- $conversion -These functions can convert from strict\/lazy 'Text', 'Builder', and 'String'. +{- $conversion These functions can convert from strict\/lazy 'Text', 'Builder', +'String', and strict\/lazy 'BS.ByteString' (in which case they use lenient +UTF-8 decoding). -} class ToStrict t where @@ -148,6 +140,12 @@ instance ToStrict Builder where toStrict = TL.toStrict . B.toLazyText {-# INLINE toStrict #-} +instance ToStrict BS.ByteString where + toStrict = decodeUtf8With lenientDecode + {-# INLINE toStrict #-} +instance ToStrict BSL.ByteString where + toStrict = decodeUtf8With lenientDecode . BSL.toStrict + {-# INLINE toStrict #-} class ToLazy t where toLazy :: t -> LText @@ -160,6 +158,12 @@ instance ToLazy Builder where toLazy = B.toLazyText {-# INLINE toLazy #-} +instance ToLazy BS.ByteString where + toLazy = TL.fromStrict . decodeUtf8With lenientDecode + {-# INLINE toLazy #-} +instance ToLazy BSL.ByteString where + toLazy = TL.decodeUtf8With lenientDecode + {-# INLINE toLazy #-} class ToBuilder t where toBuilder :: t -> Builder @@ -172,6 +176,12 @@ instance ToBuilder LText where toBuilder = B.fromLazyText {-# INLINE toBuilder #-} +instance ToBuilder BS.ByteString where + toBuilder = B.fromText . decodeUtf8With lenientDecode + {-# INLINE toBuilder #-} +instance ToBuilder BSL.ByteString where + toBuilder = B.fromLazyText . TL.decodeUtf8With lenientDecode + {-# INLINE toBuilder #-} class ToString t where toString :: t -> String @@ -184,6 +194,42 @@ instance ToString Builder where toString = TL.unpack . B.toLazyText {-# INLINE toString #-} +instance ToString BS.ByteString where + toString = UTF8.toString + {-# INLINE toString #-} +instance ToString BSL.ByteString where + toString = UTF8L.toString + {-# INLINE toString #-} + +class ToByteString t where + toByteString :: t -> BS.ByteString +instance ToByteString Text where + toByteString = encodeUtf8 + {-# INLINE toByteString #-} +instance ToByteString LText where + toByteString = encodeUtf8 . TL.toStrict + {-# INLINE toByteString #-} +instance ToByteString Builder where + toByteString = encodeUtf8 . TL.toStrict . B.toLazyText + {-# INLINE toByteString #-} +instance (a ~ Char) => ToByteString [a] where + toByteString = UTF8.fromString + {-# INLINE toByteString #-} + +class ToLByteString t where + toLByteString :: t -> BSL.ByteString +instance ToLByteString Text where + toLByteString = TL.encodeUtf8 . TL.fromStrict + {-# INLINE toLByteString #-} +instance ToLByteString LText where + toLByteString = TL.encodeUtf8 + {-# INLINE toLByteString #-} +instance ToLByteString Builder where + toLByteString = TL.encodeUtf8 . B.toLazyText + {-# INLINE toLByteString #-} +instance (a ~ Char) => ToLByteString [a] where + toLByteString = UTF8L.fromString + {-# INLINE toLByteString #-} -- | A 'Builder' producing a single character. bsingleton :: Char -> Builder diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-all-0.3.1.0/lib/Data/Text/Lazy/All.hs new/text-all-0.4.1.1/lib/Data/Text/Lazy/All.hs --- old/text-all-0.3.1.0/lib/Data/Text/Lazy/All.hs 2017-04-23 23:29:06.000000000 +0200 +++ new/text-all-0.4.1.1/lib/Data/Text/Lazy/All.hs 2017-07-11 17:22:29.000000000 +0200 @@ -4,6 +4,9 @@ module Data.Text.Lazy, module Data.Text.Lazy.IO, module Data.Text.Lazy.Encoding, + + -- * Lazy text functions + show, format, ) where @@ -11,3 +14,12 @@ import Data.Text.Lazy import Data.Text.Lazy.IO import Data.Text.Lazy.Encoding +import Data.Text.Format (format) +import qualified Prelude as P +import Prelude hiding (show) + + +-- | A synonym for 'Data.Text.All.lshow'. +show :: Show a => a -> Text +show = pack . P.show +{-# INLINE show #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-all-0.3.1.0/text-all.cabal new/text-all-0.4.1.1/text-all.cabal --- old/text-all-0.3.1.0/text-all.cabal 2017-04-23 23:29:06.000000000 +0200 +++ new/text-all-0.4.1.1/text-all.cabal 2017-07-11 17:22:29.000000000 +0200 @@ -1,5 +1,5 @@ name: text-all -version: 0.3.1.0 +version: 0.4.1.1 synopsis: Everything Data.Text related in one package description: Everything @Data.Text@-related in one package. @@ -13,7 +13,7 @@ maintainer: yom(a)artyom.me -- copyright: category: Text -tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 +tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 build-type: Simple extra-source-files: CHANGELOG.md cabal-version: >=1.10 @@ -28,9 +28,10 @@ -- other-modules: -- other-extensions: build-depends: base >=4.5 && <5 + , bytestring >= 0.10 , text ==1.2.2.* - , text-show >=3.2 && <3.7 , text-format ==0.3.1.* + , utf8-string ghc-options: -Wall -fno-warn-unused-do-bind hs-source-dirs: lib default-language: Haskell2010

1 0

commit ghc-text for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-text for openSUSE:Factory checked in at 2017-08-31 21:00:23 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-text (Old) and /work/SRC/openSUSE:Factory/.ghc-text.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-text" Thu Aug 31 21:00:23 2017 rev:13 rq:513512 version:1.2.2.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-text/ghc-text.changes 2016-07-21 08:13:11.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-text.new/ghc-text.changes 2017-08-31 21:00:24.778121789 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:06:08 UTC 2017 - psimons(a)suse.com + +- Update to version 1.2.2.2. + +------------------------------------------------------------------- Old: ---- text-1.2.2.1.tar.gz New: ---- text-1.2.2.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-text.spec ++++++ --- /var/tmp/diff_new_pack.xGrXXx/_old 2017-08-31 21:00:27.177784630 +0200 +++ /var/tmp/diff_new_pack.xGrXXx/_new 2017-08-31 21:00:27.205780696 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-text # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,15 +19,14 @@ %global pkg_name text %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.2.2.1 +Version: 1.2.2.2 Release: 0 Summary: An efficient packed Unicode text type License: BSD-2-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-array-devel BuildRequires: ghc-binary-devel BuildRequires: ghc-bytestring-devel @@ -44,7 +43,6 @@ BuildRequires: ghc-test-framework-hunit-devel BuildRequires: ghc-test-framework-quickcheck2-devel %endif -# End cabal-rpm deps %description An efficient packed, immutable Unicode text type (both strict and lazy), with a @@ -86,20 +84,14 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache ++++++ text-1.2.2.1.tar.gz -> text-1.2.2.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/Data/Text/Array.hs new/text-1.2.2.2/Data/Text/Array.hs --- old/text-1.2.2.1/Data/Text/Array.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/Data/Text/Array.hs 2017-05-21 07:16:35.000000000 +0200 @@ -20,7 +20,7 @@ -- > import qualified Data.Text.Array as A -- -- The names in this module resemble those in the 'Data.Array' family --- of modules, but are shorter due to the assumption of qualifid +-- of modules, but are shorter due to the assumption of qualified -- naming. module Data.Text.Array ( diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/Data/Text/Encoding.hs new/text-1.2.2.2/Data/Text/Encoding.hs --- old/text-1.2.2.1/Data/Text/Encoding.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/Data/Text/Encoding.hs 2017-05-21 07:16:35.000000000 +0200 @@ -55,13 +55,9 @@ , encodeUtf32LE , encodeUtf32BE -#if MIN_VERSION_bytestring(0,10,4) -- * Encoding Text using ByteString Builders - -- | /Note/ that these functions are only available if built against - -- @bytestring >= 0.10.4.0@. , encodeUtf8Builder , encodeUtf8BuilderEscaped -#endif ) where #if __GLASGOW_HASKELL__ >= 702 @@ -70,24 +66,15 @@ import Control.Monad.ST (unsafeIOToST, unsafeSTToIO) #endif -#if MIN_VERSION_bytestring(0,10,4) -import Data.Bits ((.&.)) -import Data.Text.Internal.Unsafe.Char (ord) -import qualified Data.ByteString.Builder as B -import qualified Data.ByteString.Builder.Internal as B hiding (empty, append) -import qualified Data.ByteString.Builder.Prim as BP -import qualified Data.ByteString.Builder.Prim.Internal as BP -import qualified Data.Text.Internal.Encoding.Utf16 as U16 -#endif - import Control.Exception (evaluate, try) import Control.Monad.ST (runST) +import Data.Bits ((.&.)) import Data.ByteString as B import Data.ByteString.Internal as B hiding (c2w) import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode) import Data.Text.Internal (Text(..), safe, text) import Data.Text.Internal.Private (runText) -import Data.Text.Internal.Unsafe.Char (unsafeWrite) +import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite) import Data.Text.Internal.Unsafe.Shift (shiftR) import Data.Text.Show () import Data.Text.Unsafe (unsafeDupablePerformIO) @@ -98,8 +85,13 @@ import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr) import Foreign.Storable (Storable, peek, poke) import GHC.Base (ByteArray#, MutableByteArray#) +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Builder.Internal as B hiding (empty, append) +import qualified Data.ByteString.Builder.Prim as BP +import qualified Data.ByteString.Builder.Prim.Internal as BP import qualified Data.Text.Array as A import qualified Data.Text.Internal.Encoding.Fusion as E +import qualified Data.Text.Internal.Encoding.Utf16 as U16 import qualified Data.Text.Internal.Fusion as F #include "text_cbits.h" @@ -315,8 +307,6 @@ decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode {-# INLINE decodeUtf8' #-} -#if MIN_VERSION_bytestring(0,10,4) - -- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding. encodeUtf8Builder :: Text -> B.Builder encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8) @@ -377,7 +367,6 @@ outerLoop i (B.BufferRange op ope) where poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8) -#endif -- | Encode text using UTF-8 encoding. encodeUtf8 :: Text -> ByteString diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/Data/Text/Foreign.hs new/text-1.2.2.2/Data/Text/Foreign.hs --- old/text-1.2.2.1/Data/Text/Foreign.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/Data/Text/Foreign.hs 2017-05-21 07:16:35.000000000 +0200 @@ -108,7 +108,7 @@ | n >= len || m >= len = t | otherwise = Text arr off m where - m | w < 0xDB00 || w > 0xD8FF = n + m | w < 0xD800 || w > 0xDBFF = n | otherwise = n+1 w = A.unsafeIndex arr (off+n-1) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/Data/Text/Internal/Builder/Int/Digits.hs new/text-1.2.2.2/Data/Text/Internal/Builder/Int/Digits.hs --- old/text-1.2.2.1/Data/Text/Internal/Builder/Int/Digits.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/Data/Text/Internal/Builder/Int/Digits.hs 2017-05-21 07:16:35.000000000 +0200 @@ -2,7 +2,7 @@ -- Module: Data.Text.Internal.Builder.Int.Digits -- Copyright: (c) 2013 Bryan O'Sullivan --- License: BSD3 +-- License: BSD-style -- Maintainer: Bryan O'Sullivan <bos(a)serpentine.com> -- Stability: experimental -- Portability: portable diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/Data/Text/Internal/Builder.hs new/text-1.2.2.2/Data/Text/Internal/Builder.hs --- old/text-1.2.2.1/Data/Text/Internal/Builder.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/Data/Text/Internal/Builder.hs 2017-05-21 07:16:35.000000000 +0200 @@ -6,7 +6,7 @@ -- Module : Data.Text.Internal.Builder -- Copyright : (c) 2013 Bryan O'Sullivan -- (c) 2010 Johan Tibell --- License : BSD3-style (see LICENSE) +-- License : BSD-style (see LICENSE) -- -- Maintainer : Johan Tibell <johan.tibell(a)gmail.com> -- Stability : experimental @@ -242,6 +242,8 @@ !t = Text arr o u ts <- inlineInterleaveST (k b) return $! t : ts +{-# INLINE [1] flush #-} +-- defer inlining so that flush/flush rule may fire. ------------------------------------------------------------------------ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/Data/Text/Internal/Fusion/Common.hs new/text-1.2.2.2/Data/Text/Internal/Fusion/Common.hs --- old/text-1.2.2.1/Data/Text/Internal/Fusion/Common.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/Data/Text/Internal/Fusion/Common.hs 2017-05-21 07:16:35.000000000 +0200 @@ -107,7 +107,7 @@ import qualified Data.List as L import qualified Prelude as P import Data.Bits (shiftL) -import Data.Char (isLetter) +import Data.Char (isLetter, isSpace) import Data.Int (Int64) import Data.Text.Internal.Fusion.Types import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping, @@ -462,15 +462,16 @@ where next (CC (letter :*: s) '\0' _) = case next0 s of - Done -> Done - Skip s' -> Skip (CC (letter :*: s') '\0' '\0') + Done -> Done + Skip s' -> Skip (CC (letter :*: s') '\0' '\0') Yield c s' - | letter' -> if letter - then lowerMapping c (letter' :*: s') - else titleMapping c (letter' :*: s') - | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0') - where letter' = isLetter c - next (CC s a b) = Yield a (CC s b '\0') + | nonSpace -> if letter + then lowerMapping c (nonSpace :*: s') + else titleMapping c (letter' :*: s') + | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0') + where nonSpace = P.not (isSpace c) + letter' = isLetter c + next (CC s a b) = Yield a (CC s b '\0') {-# INLINE [0] toTitle #-} data Justify i s = Just1 !i !s @@ -669,12 +670,12 @@ -- ** Generating and unfolding streams replicateCharI :: Integral a => a -> Char -> Stream Char -replicateCharI n c +replicateCharI !n !c | n < 0 = empty | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low where - next i | i >= n = Done - | otherwise = Yield c (i + 1) + next !i | i >= n = Done + | otherwise = Yield c (i + 1) {-# INLINE [0] replicateCharI #-} data RI s = RI !s {-# UNPACK #-} !Int64 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/Data/Text/Internal/Fusion.hs new/text-1.2.2.2/Data/Text/Internal/Fusion.hs --- old/text-1.2.2.1/Data/Text/Internal/Fusion.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/Data/Text/Internal/Fusion.hs 2017-05-21 07:16:35.000000000 +0200 @@ -98,25 +98,35 @@ -- | /O(n)/ Convert a 'Stream Char' into a 'Text'. unstream :: Stream Char -> Text unstream (Stream next0 s0 len) = runText $ \done -> do - let mlen = upperBound 4 len + -- Before encoding each char we perform a buffer realloc check assuming + -- worst case encoding size of two 16-bit units for the char. Just add an + -- extra space to the buffer so that we do not end up reallocating even when + -- all the chars are encoded as single unit. + let mlen = upperBound 4 len + 1 arr0 <- A.new mlen - let outer arr top = loop + let outer !arr !maxi = encode where - loop !s !i = - case next0 s of - Done -> done arr i - Skip s' -> loop s' i - Yield x s' - | j >= top -> {-# SCC "unstream/resize" #-} do - let top' = (top + 1) `shiftL` 1 - arr' <- A.new top' - A.copyM arr' 0 arr 0 top - outer arr' top' s i - | otherwise -> do d <- unsafeWrite arr i x - loop s' (i+d) - where j | ord x < 0x10000 = i - | otherwise = i + 1 - outer arr0 mlen s0 0 + -- keep the common case loop as small as possible + encode !si !di = + case next0 si of + Done -> done arr di + Skip si' -> encode si' di + Yield c si' + -- simply check for the worst case + | maxi < di + 1 -> realloc si di + | otherwise -> do + n <- unsafeWrite arr di c + encode si' (di + n) + + -- keep uncommon case separate from the common case code + {-# NOINLINE realloc #-} + realloc !si !di = do + let newlen = (maxi + 1) * 2 + arr' <- A.new newlen + A.copyM arr' 0 arr 0 di + outer arr' (newlen - 1) si di + + outer arr0 (mlen - 1) s0 0 {-# INLINE [0] unstream #-} {-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/Data/Text/Lazy/Builder/Int.hs new/text-1.2.2.2/Data/Text/Lazy/Builder/Int.hs --- old/text-1.2.2.1/Data/Text/Lazy/Builder/Int.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/Data/Text/Lazy/Builder/Int.hs 2017-05-21 07:16:35.000000000 +0200 @@ -7,7 +7,7 @@ -- Module: Data.Text.Lazy.Builder.Int -- Copyright: (c) 2013 Bryan O'Sullivan -- (c) 2011 MailRank, Inc. --- License: BSD3 +-- License: BSD-style -- Maintainer: Bryan O'Sullivan <bos(a)serpentine.com> -- Stability: experimental -- Portability: portable diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/Data/Text/Lazy/Builder.hs new/text-1.2.2.2/Data/Text/Lazy/Builder.hs --- old/text-1.2.2.1/Data/Text/Lazy/Builder.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/Data/Text/Lazy/Builder.hs 2017-05-21 07:16:35.000000000 +0200 @@ -8,7 +8,7 @@ -- Module : Data.Text.Lazy.Builder -- Copyright : (c) 2013 Bryan O'Sullivan -- (c) 2010 Johan Tibell --- License : BSD3-style (see LICENSE) +-- License : BSD-style (see LICENSE) -- -- Maintainer : Johan Tibell <johan.tibell(a)gmail.com> -- Stability : experimental diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/Data/Text/Lazy/Encoding.hs new/text-1.2.2.2/Data/Text/Lazy/Encoding.hs --- old/text-1.2.2.1/Data/Text/Lazy/Encoding.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/Data/Text/Lazy/Encoding.hs 2017-05-21 07:16:35.000000000 +0200 @@ -46,27 +46,23 @@ , encodeUtf32LE , encodeUtf32BE -#if MIN_VERSION_bytestring(0,10,4) -- * Encoding Text using ByteString Builders , encodeUtf8Builder , encodeUtf8BuilderEscaped -#endif ) where import Control.Exception (evaluate, try) +import Data.Monoid (Monoid(..)) import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode) import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks) -import qualified Data.ByteString as S -import qualified Data.ByteString.Lazy as B -import qualified Data.ByteString.Lazy.Internal as B -import qualified Data.ByteString.Unsafe as B -#if MIN_VERSION_bytestring(0,10,4) import Data.Word (Word8) -import Data.Monoid (Monoid(..)) +import qualified Data.ByteString as S import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith) import qualified Data.ByteString.Builder.Prim as BP -#endif +import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString.Lazy.Internal as B +import qualified Data.ByteString.Unsafe as B import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E @@ -146,7 +142,6 @@ {-# INLINE decodeUtf8' #-} encodeUtf8 :: Text -> B.ByteString -#if MIN_VERSION_bytestring(0,10,4) encodeUtf8 Empty = B.empty encodeUtf8 lt@(Chunk t _) = B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt @@ -168,11 +163,6 @@ encodeUtf8BuilderEscaped prim = foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c `mappend` b) mempty -#else -encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs) -encodeUtf8 Empty = B.Empty -#endif - -- | Decode text from little endian UTF-16 encoding. decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/Data/Text/Lazy/Read.hs new/text-1.2.2.2/Data/Text/Lazy/Read.hs --- old/text-1.2.2.1/Data/Text/Lazy/Read.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/Data/Text/Lazy/Read.hs 2017-05-21 07:16:35.000000000 +0200 @@ -68,9 +68,9 @@ go n d = (n * 10 + fromIntegral (digitToInt d)) -- | Read a hexadecimal integer, consisting of an optional leading --- @\"0x\"@ followed by at least one decimal digit. Input is consumed --- until a non-hex-digit or end of string is reached. This function --- is case insensitive. +-- @\"0x\"@ followed by at least one hexadecimal digit. Input is +-- consumed until a non-hex-digit or end of string is reached. +-- This function is case insensitive. -- -- This function does not handle leading sign characters. If you need -- to handle signed input, use @'signed' 'hexadecimal'@. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/Data/Text/Lazy.hs new/text-1.2.2.2/Data/Text/Lazy.hs --- old/text-1.2.2.1/Data/Text/Lazy.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/Data/Text/Lazy.hs 2017-05-21 07:16:35.000000000 +0200 @@ -545,7 +545,7 @@ unstream (S.tail (stream t)) = tail t #-} --- | /O(1)/ Returns all but the last character of a 'Text', which must +-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must -- be non-empty. Subject to fusion. init :: Text -> Text init (Chunk t0 ts0) = go t0 ts0 @@ -581,7 +581,7 @@ isSingleton = S.isSingleton . stream {-# INLINE isSingleton #-} --- | /O(1)/ Returns the last character of a 'Text', which must be +-- | /O(n\/c)/ Returns the last character of a 'Text', which must be -- non-empty. Subject to fusion. last :: Text -> Char last Empty = emptyError "last" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/Data/Text/Read.hs new/text-1.2.2.2/Data/Text/Read.hs --- old/text-1.2.2.1/Data/Text/Read.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/Data/Text/Read.hs 2017-05-21 07:16:35.000000000 +0200 @@ -67,9 +67,9 @@ go n d = (n * 10 + fromIntegral (digitToInt d)) -- | Read a hexadecimal integer, consisting of an optional leading --- @\"0x\"@ followed by at least one decimal digit. Input is consumed --- until a non-hex-digit or end of string is reached. This function --- is case insensitive. +-- @\"0x\"@ followed by at least one hexadecimal digit. Input is +-- consumed until a non-hex-digit or end of string is reached. +-- This function is case insensitive. -- -- This function does not handle leading sign characters. If you need -- to handle signed input, use @'signed' 'hexadecimal'@. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/Data/Text.hs new/text-1.2.2.2/Data/Text.hs --- old/text-1.2.2.1/Data/Text.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/Data/Text.hs 2017-05-21 07:16:35.000000000 +0200 @@ -238,6 +238,7 @@ import qualified Data.Text.Lazy as L import Data.Int (Int64) #endif +import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt) #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts #endif @@ -571,7 +572,9 @@ -- Subject to fusion. length :: Text -> Int length t = S.length (stream t) -{-# INLINE length #-} +{-# INLINE [0] length #-} +-- length needs to be phased after the compareN/length rules otherwise +-- it may inline before the rules have an opportunity to fire. -- | /O(n)/ Compare the count of characters in a 'Text' to a number. -- Subject to fusion. @@ -590,32 +593,32 @@ {-# RULES "TEXT ==N/length -> compareLength/==EQ" [~1] forall t n. - (==) (length t) n = compareLength t n == EQ + eqInt (length t) n = compareLength t n == EQ #-} {-# RULES "TEXT /=N/length -> compareLength//=EQ" [~1] forall t n. - (/=) (length t) n = compareLength t n /= EQ + neInt (length t) n = compareLength t n /= EQ #-} {-# RULES "TEXT <N/length -> compareLength/==LT" [~1] forall t n. - (<) (length t) n = compareLength t n == LT + ltInt (length t) n = compareLength t n == LT #-} {-# RULES "TEXT <=N/length -> compareLength//=GT" [~1] forall t n. - (<=) (length t) n = compareLength t n /= GT + leInt (length t) n = compareLength t n /= GT #-} {-# RULES "TEXT >N/length -> compareLength/==GT" [~1] forall t n. - (>) (length t) n = compareLength t n == GT + gtInt (length t) n = compareLength t n == GT #-} {-# RULES "TEXT >=N/length -> compareLength//=LT" [~1] forall t n. - (>=) (length t) n = compareLength t n /= LT + geInt (length t) n = compareLength t n /= LT #-} -- ----------------------------------------------------------------------------- @@ -1096,8 +1099,8 @@ iterNEnd :: Int -> Text -> Int iterNEnd n t@(Text _arr _off len) = loop (len-1) n where loop i !m + | m <= 0 = i+1 | i <= 0 = 0 - | m <= 1 = i | otherwise = loop (i+d) (m-1) where d = reverseIter_ t i diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/benchmarks/haskell/Benchmarks/Stream.hs new/text-1.2.2.2/benchmarks/haskell/Benchmarks/Stream.hs --- old/text-1.2.2.1/benchmarks/haskell/Benchmarks/Stream.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/benchmarks/haskell/Benchmarks/Stream.hs 2017-05-21 07:16:35.000000000 +0200 @@ -18,11 +18,11 @@ import qualified Data.Text.Encoding.Error as E import qualified Data.Text.Internal.Encoding.Fusion as T import qualified Data.Text.Internal.Encoding.Fusion.Common as F -import qualified Data.Text.Internal.Fusion as T +import qualified Data.Text.Internal.Fusion as F import qualified Data.Text.IO as T import qualified Data.Text.Lazy.Encoding as TL import qualified Data.Text.Internal.Lazy.Encoding.Fusion as TL -import qualified Data.Text.Internal.Lazy.Fusion as TL +import qualified Data.Text.Internal.Lazy.Fusion as FL import qualified Data.Text.Lazy.IO as TL instance NFData a => NFData (Stream a) where @@ -53,14 +53,25 @@ !utf32beL = TL.encodeUtf32BE tl -- For the functions which operate on streams - let !s = T.stream t + let !s = F.stream t return $ bgroup "Stream" -- Fusion [ bgroup "stream" $ - [ bench "Text" $ nf T.stream t - , bench "LazyText" $ nf TL.stream tl + [ bench "Text" $ nf F.stream t + , bench "LazyText" $ nf FL.stream tl + ] + -- must perform exactly the same as stream above due to + -- stream/unstream (i.e. stream after unstream) fusion + , bgroup "stream-fusion" $ + [ bench "Text" $ nf (F.stream . F.unstream . F.stream) t + , bench "LazyText" $ nf (FL.stream . FL.unstream . FL.stream) tl + ] + -- measure the overhead of unstream after stream + , bgroup "stream-unstream" $ + [ bench "Text" $ nf (F.unstream . F.stream) t + , bench "LazyText" $ nf (FL.unstream . FL.stream) tl ] -- Encoding.Fusion diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/benchmarks/haskell/Benchmarks.hs new/text-1.2.2.2/benchmarks/haskell/Benchmarks.hs --- old/text-1.2.2.1/benchmarks/haskell/Benchmarks.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/benchmarks/haskell/Benchmarks.hs 2017-05-21 07:16:35.000000000 +0200 @@ -53,7 +53,7 @@ , Mul.benchmark , Pure.benchmark "tiny" (tf "tiny.txt") , Pure.benchmark "ascii" (tf "ascii-small.txt") - , Pure.benchmark "france" (tf "france.html") + -- , Pure.benchmark "france" (tf "france.html") , Pure.benchmark "russian" (tf "russian-small.txt") , Pure.benchmark "japanese" (tf "japanese.txt") , ReadNumbers.benchmark (tf "numbers.txt") diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/benchmarks/text-benchmarks.cabal new/text-1.2.2.2/benchmarks/text-benchmarks.cabal --- old/text-1.2.2.1/benchmarks/text-benchmarks.cabal 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/benchmarks/text-benchmarks.cabal 2017-05-21 07:16:35.000000000 +0200 @@ -3,7 +3,7 @@ synopsis: Benchmarks for the text package description: Benchmarks for the text package homepage: https://bitbucket.org/bos/text -license: BSD3 +license: BSD2 license-file: ../LICENSE author: Jasper Van der Jeugt <jaspervdj(a)gmail.com>, Bryan O'Sullivan <bos(a)serpentine.com>, @@ -15,6 +15,11 @@ cabal-version: >=1.2 +flag bytestring-builder + description: Depend on the bytestring-builder package for backwards compatibility. + default: False + manual: False + flag llvm description: use LLVM default: False @@ -33,7 +38,6 @@ build-depends: base == 4.*, binary, blaze-builder, - bytestring, bytestring-lexing >= 0.5.0, containers, criterion >= 0.10.0.0, @@ -46,6 +50,12 @@ utf8-string, vector + if flag(bytestring-builder) + build-depends: bytestring >= 0.9 && < 0.10.4, + bytestring-builder >= 0.10.4 + else + build-depends: bytestring >= 0.10.4 + executable text-multilang hs-source-dirs: haskell main-is: Multilang.hs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/changelog.md new/text-1.2.2.2/changelog.md --- old/text-1.2.2.1/changelog.md 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/changelog.md 2017-05-21 07:16:35.000000000 +0200 @@ -1,10 +1,27 @@ +1.2.2.2 + +* The `toTitle` function now correctly handles letters that + immediately follow punctuation. Before, `"there's"` would turn into + `"There'S"`. Now, it becomes `"There's"`. + +* The implementation of unstreaming is faster, resulting in operations + such as `map` and `intersperse` speeding up by up to 30%, with + smaller code generated. + +* The optimised length comparison function is now more likely to be + used after some rewrite rule tweaking. + +* Bug fix: an off-by-one bug in `takeEnd` is fixed. + +* Bug fix: a logic error in `takeWord16` is fixed. + 1.2.2.1 * The switch to `integer-pure` in 1.2.2.0 was apparently mistaken. The build flag has been renamed accordingly. Your army of diligent maintainers apologizes for the churn. -* Spec compliance: toCaseFold now follows the Unicode 8.0 spec +* Spec compliance: `toCaseFold` now follows the Unicode 8.0 spec (updated from 7.0) * An STG lint error has been fixed diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/tests/Tests/Properties.hs new/text-1.2.2.2/tests/Tests/Properties.hs --- old/text-1.2.2.1/tests/Tests/Properties.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/tests/Tests/Properties.hs 2017-05-21 07:16:36.000000000 +0200 @@ -11,7 +11,7 @@ import Control.Applicative ((<$>), (<*>)) import Control.Arrow ((***), second) import Data.Bits ((.&.)) -import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord) +import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isLetter, isUpper, ord) import Data.Int (Int8, Int16, Int32, Int64) import Data.Monoid (Monoid(..)) import Data.String (IsString(fromString)) @@ -23,6 +23,7 @@ import Data.Text.Lazy.Read as TL import Data.Text.Read as T import Data.Word (Word, Word8, Word16, Word32, Word64) +import Data.Maybe (mapMaybe) import Numeric (showEFloat, showFFloat, showGFloat, showHex) import Prelude hiding (replicate) import Test.Framework (Test, testGroup) @@ -37,6 +38,7 @@ import qualified Data.Bits as Bits (shiftL, shiftR) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL +import qualified Data.Char as C import qualified Data.List as L import qualified Data.Text as T import qualified Data.Text.Encoding as E @@ -60,10 +62,10 @@ tl_pack_unpack = (TL.unpack . TL.pack) `eq` id t_stream_unstream = (S.unstream . S.stream) `eq` id tl_stream_unstream = (SL.unstream . SL.stream) `eq` id -t_reverse_stream t = (S.reverse . S.reverseStream) t == t -t_singleton c = [c] == (T.unpack . T.singleton) c -tl_singleton c = [c] == (TL.unpack . TL.singleton) c -tl_unstreamChunks x = f 11 x == f 1000 x +t_reverse_stream t = (S.reverse . S.reverseStream) t === t +t_singleton c = [c] === (T.unpack . T.singleton) c +tl_singleton c = [c] === (TL.unpack . TL.singleton) c +tl_unstreamChunks x = f 11 x === f 1000 x where f n = SL.unstreamChunks n . S.streamList tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id @@ -74,13 +76,13 @@ encodeLazyL1 :: TL.Text -> BL.ByteString encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks -t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a +t_ascii t = E.decodeASCII (E.encodeUtf8 a) === a where a = T.map (\c -> chr (ord c `mod` 128)) t -tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a +tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) === a where a = TL.map (\c -> chr (ord c `mod` 128)) t -t_latin1 t = E.decodeLatin1 (encodeL1 a) == a +t_latin1 t = E.decodeLatin1 (encodeL1 a) === a where a = T.map (\c -> chr (ord c `mod` 256)) t -tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a +tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) === a where a = TL.map (\c -> chr (ord c `mod` 256)) t t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right) @@ -111,7 +113,7 @@ let b = E.encodeUtf8 t ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t leftover = (++ [B.empty]) . init . tail . B.inits - in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls + in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b === ls data Badness = Solo | Leading | Trailing deriving (Eq, Show) @@ -201,8 +203,8 @@ mconcat `eq` (unpackS . mconcat . L.map T.pack) tl_mconcat = unsquare $ mconcat `eq` (unpackS . mconcat . L.map TL.pack) -t_mempty = mempty == (unpackS (mempty :: T.Text)) -tl_mempty = mempty == (unpackS (mempty :: TL.Text)) +t_mempty = mempty === (unpackS (mempty :: T.Text)) +tl_mempty = mempty === (unpackS (mempty :: TL.Text)) t_IsString = fromString `eqP` (T.unpack . fromString) tl_IsString = fromString `eqP` (TL.unpack . fromString) @@ -326,6 +328,19 @@ where p = T.length . T.filter isUpper tl_toUpper_upper t = p (TL.toUpper t) >= p t where p = TL.length . TL.filter isUpper +t_toTitle_title t = all (<= 1) (caps w) + where caps = fmap (T.length . T.filter isUpper) . T.words . T.toTitle + -- TIL: there exist uppercase-only letters + w = T.filter (\c -> if C.isUpper c then C.toLower c /= c else True) t +t_toTitle_1stNotLower = and . notLow . T.toTitle . T.filter stable + where notLow = mapMaybe (fmap (not . isLower) . (T.find isLetter)) . T.words + -- Surprise! The Spanish/Portuguese ordinal indicators changed + -- from category Ll (letter, lowercase) to Lo (letter, other) + -- in Unicode 7.0 + -- Oh, and there exist lowercase-only letters (see previous test) + stable c = if isLower c + then C.toUpper c /= c + else c /= '\170' && c /= '\186' justifyLeft k c xs = xs ++ L.replicate (k - length xs) c justifyRight m n xs = L.replicate (m - length xs) n ++ xs @@ -720,7 +735,7 @@ conc = T.concat . TL.toChunks t_indices_occurs = unsquare $ \(NotEmpty t) ts -> let s = T.intercalate t ts - in Slow.indices t s == indices t s + in Slow.indices t s === indices t s -- Bit shifts. shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k @@ -812,18 +827,18 @@ -- Reading. t_decimal (n::Int) s = - T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t) + T.signed T.decimal (T.pack (show n) `T.append` t) === Right (n,t) where t = T.dropWhile isDigit s tl_decimal (n::Int) s = - TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t) + TL.signed TL.decimal (TL.pack (show n) `TL.append` t) === Right (n,t) where t = TL.dropWhile isDigit s t_hexadecimal m s ox = - T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t) + T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) === Right (n,t) where t = T.dropWhile isHexDigit s p = if ox then "0x" else "" n = getPositive m :: Int tl_hexadecimal m s ox = - TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t) + TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) === Right (n,t) where t = TL.dropWhile isHexDigit s p = if ox then "0x" else "" n = getPositive m :: Int @@ -867,11 +882,11 @@ t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t -t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t +t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) === t where n = small m t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr) -t_copy t = T.copy t == t +t_copy t = T.copy t === t -- Regression tests. s_filter_eq s = S.filter p t == S.streamList (filter p s) @@ -1030,7 +1045,9 @@ testProperty "tl_toLower_lower" tl_toLower_lower, testProperty "t_toUpper_length" t_toUpper_length, testProperty "t_toUpper_upper" t_toUpper_upper, - testProperty "tl_toUpper_upper" tl_toUpper_upper + testProperty "tl_toUpper_upper" tl_toUpper_upper, + testProperty "t_toTitle_title" t_toTitle_title, + testProperty "t_toTitle_1stNotLower" t_toTitle_1stNotLower ], testGroup "justification" [ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/tests/Tests/QuickCheckUtils.hs new/text-1.2.2.2/tests/Tests/QuickCheckUtils.hs --- old/text-1.2.2.1/tests/Tests/QuickCheckUtils.hs 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/tests/Tests/QuickCheckUtils.hs 2017-05-21 07:16:36.000000000 +0200 @@ -106,7 +106,7 @@ where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs instance Arbitrary T.Text where - arbitrary = T.pack `fmap` arbitrary + arbitrary = T.pack `fmap` string shrink = map T.pack . shrink . T.unpack instance Arbitrary TL.Text where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/tests/text-tests.cabal new/text-1.2.2.2/tests/text-tests.cabal --- old/text-1.2.2.1/tests/text-tests.cabal 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/tests/text-tests.cabal 2017-05-21 07:16:36.000000000 +0200 @@ -3,7 +3,7 @@ synopsis: Functional tests for the text package description: Functional tests for the text package homepage: https://github.com/bos/text -license: BSD3 +license: BSD2 license-file: ../LICENSE author: Jasper Van der Jeugt <jaspervdj(a)gmail.com>, Bryan O'Sullivan <bos(a)serpentine.com>, @@ -20,6 +20,11 @@ default: False manual: True +flag bytestring-builder + description: Depend on the bytestring-builder package for backwards compatibility. + default: False + manual: False + executable text-tests main-is: Tests.hs @@ -48,16 +53,21 @@ HUnit >= 1.2, QuickCheck >= 2.7, base == 4.*, - bytestring, deepseq, directory, - quickcheck-unicode, + quickcheck-unicode >= 1.0.1.0, random, test-framework >= 0.4, test-framework-hunit >= 0.2, test-framework-quickcheck2 >= 0.2, text-tests + if flag(bytestring-builder) + build-depends: bytestring >= 0.9 && < 0.10.4, + bytestring-builder >= 0.10.4 + else + build-depends: bytestring >= 0.10.4 + executable text-tests-stdio main-is: Tests/IO.hs @@ -137,7 +147,12 @@ array, base == 4.*, binary, - bytestring, deepseq, ghc-prim, integer-gmp + + if flag(bytestring-builder) + build-depends: bytestring >= 0.9 && < 0.10.4, + bytestring-builder >= 0.10.4 + else + build-depends: bytestring >= 0.10.4 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-1.2.2.1/text.cabal new/text-1.2.2.2/text.cabal --- old/text-1.2.2.1/text.cabal 2016-03-17 18:53:39.000000000 +0100 +++ new/text-1.2.2.2/text.cabal 2017-05-21 07:16:35.000000000 +0200 @@ -1,5 +1,5 @@ name: text -version: 1.2.2.1 +version: 1.2.2.2 homepage: https://github.com/bos/text bug-reports: https://github.com/bos/text/issues synopsis: An efficient packed Unicode text type. @@ -31,7 +31,7 @@ the @text-icu@ package: <http://hackage.haskell.org/package/text-icu> -license: BSD3 +license: BSD2 license-file: LICENSE author: Bryan O'Sullivan <bos(a)serpentine.com> maintainer: Bryan O'Sullivan <bos(a)serpentine.com> @@ -64,6 +64,11 @@ tests/scripts/*.sh tests/text-tests.cabal +flag bytestring-builder + description: Depend on the bytestring-builder package for backwards compatibility. + default: False + manual: False + flag developer description: operate in developer mode default: False @@ -133,10 +138,11 @@ deepseq >= 1.1.0.0, ghc-prim >= 0.2 - if impl(ghc >= 7.7) - build-depends: bytestring >= 0.10.4.0 + if flag(bytestring-builder) + build-depends: bytestring >= 0.9 && < 0.10.4, + bytestring-builder >= 0.10.4 else - build-depends: bytestring >= 0.9 + build-depends: bytestring >= 0.10.4 cpp-options: -DHAVE_DEEPSEQ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 @@ -171,16 +177,21 @@ array, base, binary, - bytestring, deepseq, directory, ghc-prim, - quickcheck-unicode, + quickcheck-unicode >= 1.0.1.0, random, test-framework >= 0.4, test-framework-hunit >= 0.2, test-framework-quickcheck2 >= 0.2 + if flag(bytestring-builder) + build-depends: bytestring >= 0.9 && < 0.10.4, + bytestring-builder >= 0.10.4 + else + build-depends: bytestring >= 0.10.4 + if flag(integer-simple) cpp-options: -DINTEGER_SIMPLE build-depends: integer-simple >= 0.1 && < 0.5

1 0

commit ghc-tasty-rerun for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-tasty-rerun for openSUSE:Factory checked in at 2017-08-31 21:00:20 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-tasty-rerun (Old) and /work/SRC/openSUSE:Factory/.ghc-tasty-rerun.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-tasty-rerun" Thu Aug 31 21:00:20 2017 rev:4 rq:513511 version:1.1.7 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-tasty-rerun/ghc-tasty-rerun.changes 2016-08-24 10:08:04.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-tasty-rerun.new/ghc-tasty-rerun.changes 2017-08-31 21:00:21.814538180 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:48 UTC 2017 - psimons(a)suse.com + +- Update to version 1.1.7. + +------------------------------------------------------------------- Old: ---- tasty-rerun-1.1.6.tar.gz New: ---- tasty-rerun-1.1.7.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-tasty-rerun.spec ++++++ --- /var/tmp/diff_new_pack.vBmnRz/_old 2017-08-31 21:00:22.766404440 +0200 +++ /var/tmp/diff_new_pack.vBmnRz/_new 2017-08-31 21:00:22.774403316 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-tasty-rerun # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,11 +18,11 @@ %global pkg_name tasty-rerun Name: ghc-%{pkg_name} -Version: 1.1.6 +Version: 1.1.7 Release: 0 Summary: Run tests by filtering the test tree depending on the result of previous test runs License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… BuildRequires: ghc-Cabal-devel @@ -96,15 +96,12 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %post devel %ghc_pkg_recache ++++++ tasty-rerun-1.1.6.tar.gz -> tasty-rerun-1.1.7.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-rerun-1.1.6/Changelog.md new/tasty-rerun-1.1.7/Changelog.md --- old/tasty-rerun-1.1.6/Changelog.md 2016-07-12 15:13:33.000000000 +0200 +++ new/tasty-rerun-1.1.7/Changelog.md 2017-07-24 14:16:38.000000000 +0200 @@ -1,3 +1,7 @@ +# 1.1.7 + +* Allow base < 4.11. + # 1.1.6 * Allow base 4.9 for building with GHC 8.0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-rerun-1.1.6/tasty-rerun.cabal new/tasty-rerun-1.1.7/tasty-rerun.cabal --- old/tasty-rerun-1.1.6/tasty-rerun.cabal 2016-07-12 15:13:33.000000000 +0200 +++ new/tasty-rerun-1.1.7/tasty-rerun.cabal 2017-07-24 14:16:38.000000000 +0200 @@ -1,5 +1,5 @@ name: tasty-rerun -version: 1.1.6 +version: 1.1.7 homepage: http://github.com/ocharles/tasty-rerun license: BSD3 license-file: LICENSE @@ -72,7 +72,7 @@ library exposed-modules: Test.Tasty.Ingredients.Rerun build-depends: - base >=4.6 && <4.10, + base >=4.6 && <4.11, containers >= 0.5.0.0, mtl >= 2.1.2, optparse-applicative >= 0.6,

1 0

commit ghc-tasty-discover for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-tasty-discover for openSUSE:Factory checked in at 2017-08-31 21:00:16 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-tasty-discover (Old) and /work/SRC/openSUSE:Factory/.ghc-tasty-discover.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-tasty-discover" Thu Aug 31 21:00:16 2017 rev:2 rq:513510 version:3.0.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-tasty-discover/ghc-tasty-discover.changes 2017-05-10 20:54:35.276384429 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-tasty-discover.new/ghc-tasty-discover.changes 2017-08-31 21:00:19.714833193 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:05:55 UTC 2017 - psimons(a)suse.com + +- Update to version 3.0.2. + +------------------------------------------------------------------- Old: ---- tasty-discover-1.1.0.tar.gz New: ---- tasty-discover-3.0.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-tasty-discover.spec ++++++ --- /var/tmp/diff_new_pack.Nd1vDU/_old 2017-08-31 21:00:21.042646632 +0200 +++ /var/tmp/diff_new_pack.Nd1vDU/_new 2017-08-31 21:00:21.058644385 +0200 @@ -17,28 +17,37 @@ %global pkg_name tasty-discover +%bcond_with tests Name: ghc-%{pkg_name} -Version: 1.1.0 +Version: 3.0.2 Release: 0 Summary: Test discovery for the tasty framework -License: GPL-3.0+ +License: MIT Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… BuildRequires: chrpath BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-containers-devel BuildRequires: ghc-directory-devel BuildRequires: ghc-filepath-devel BuildRequires: ghc-rpm-macros +BuildRoot: %{_tmppath}/%{name}-%{version}-build +%if %{with tests} BuildRequires: ghc-tasty-devel BuildRequires: ghc-tasty-hspec-devel BuildRequires: ghc-tasty-hunit-devel BuildRequires: ghc-tasty-quickcheck-devel -BuildRequires: ghc-tasty-th-devel -BuildRoot: %{_tmppath}/%{name}-%{version}-build +BuildRequires: ghc-tasty-smallcheck-devel +%endif %description -Test discovery for the tasty framework. +Automatic test discovery and runner for the tasty framework. Prefix your test +case names and tasty-discover will discover, collect and run them. All popular +test libraries are covered. Configure once and then just write your tests. +Avoid forgetting to add test modules to your Cabal/Hpack files. Tasty +ingredients are included along with various configuration options for different +use cases. Please see the `README.md` below for how to get started. %package devel Summary: Haskell %{pkg_name} library development files @@ -61,6 +70,9 @@ %ghc_lib_install %ghc_fix_rpath %{pkg_name}-%{version} +%check +%cabal_test + %post devel %ghc_pkg_recache @@ -69,11 +81,11 @@ %files -f %{name}.files %defattr(-,root,root,-) -%doc LICENSE.md +%doc LICENSE %{_bindir}/%{pkg_name} %files devel -f %{name}-devel.files %defattr(-,root,root,-) -%doc example +%doc CHANGELOG.md README.md %changelog ++++++ tasty-discover-1.1.0.tar.gz -> tasty-discover-3.0.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/CHANGELOG.md new/tasty-discover-3.0.2/CHANGELOG.md --- old/tasty-discover-1.1.0/CHANGELOG.md 1970-01-01 01:00:00.000000000 +0100 +++ new/tasty-discover-3.0.2/CHANGELOG.md 2017-06-04 10:19:21.000000000 +0200 @@ -0,0 +1,123 @@ +# Change Log + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog] and this project adheres to +[Semantic Versioning]. + +[Keep a Changelog]: http://keepachangelog.com/ +[Semantic Versioning]: http://semver.org/ + +# 3.0.2 [2017-06-05] + +### Fixed +- Make upper bounds for dependencies looser. +- Fix typo in README.md option documentation. + +### Remove +- Remove TOC, the hyperlinks weren't working on Hackage. + +# 3.0.1 [2017-06-04] + +### Fixed +- Fixed CHANGELOG.md rendering for Hackage (see pull request [#106]). + +### Added +- Add missing --tree-display documentation note (see pull request [#107]). + +[#107]: https://github.com/lwm/tasty-discover/pull/107 +[#106]: https://github.com/lwm/tasty-discover/pull/106 + +# 3.0.0 [2017-06-03] + +### Added +- Add --tree-display configuration option (see pull request [#103]). + +### Changed +- Deprecate `case_` in favour of `unit_` for HUnit test cases (see pull request [#97]). + +### Fixed +- Correctly handle sub-directories when using --no-module-suffix (see pull request [#102]). + +[#97]: https://github.com/lwm/tasty-discover/pull/97 +[#102]: https://github.com/lwm/tasty-discover/pull/102 +[#103]: https://github.com/lwm/tasty-discover/pull/103 + +# 2.0.3 [2017-04-13] + +### Fixed +- Make the Cabal description more clear for Hackage. + +# 2.0.2 [2017-04-13] + +### Added +- README.md and CHANGELOG.md included for Hackage (see pull request [#96]). +- Re-add stylish-haskell automated checking (see pull request [#88]). + +[#88]: https://github.com/lwm/tasty-discover/pull/88 +[#96]: https://github.com/lwm/tasty-discover/pull/96 + +## 2.0.1 [2017-03-18] + +### Fixed +- Fix flaky test comparison (see pull request [#86]). + +[#86]: https://github.com/lwm/tasty-discover/pull/86 + +### Removed +- Remove the Test.Tasty.Type module (see pull request [#83]). + +[#83]: https://github.com/lwm/tasty-discover/pull/83 + +## 2.0.0 [2017-03-15] + +### Added +- Add new hpack format. +- Add generator style test discovery from tasty-auto. +- Add new configuration options: debug, ingredients and module name. +- Add unit tests for all functionality. + +### Fixed +- Re-license to MIT. + +### Removed +- RTD documentation. +- TemplateHaskell dependency +- Example project and integration test project. + +### Changed +- Move all tests into test folder. + +## 1.1.0 [2017-01-19] + +### Added +- Add --ignore-module configuration option. + +## 1.0.1 [2017-11-13] + +### Added +- Add Cabal and Documentation testing on Travis CI. + +### Fixed +- Include missing extra-source-files. +- Slim down LICENSE.md and mark as GPL-3 in Cabal file. + +## 1.0.0 [2016-11-04] + +### Added +- Add documentation on RTD. +- Release on Hackage and Stackage. + +## 0.0.3 [2016-09-20] + +### Added +- --no-module-suffix configuration option. + +## 0.0.2 [2016-02-20] + +### Added +- --module-suffix configuration option. + +## 0.0.1 [2016-02-13] + +- tasty-discover initial release. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/LICENSE new/tasty-discover-3.0.2/LICENSE --- old/tasty-discover-1.1.0/LICENSE 1970-01-01 01:00:00.000000000 +0100 +++ new/tasty-discover-3.0.2/LICENSE 2017-03-10 23:54:01.000000000 +0100 @@ -0,0 +1,19 @@ +Copyright (c) 2016 Luke Murphy + +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. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/LICENSE.md new/tasty-discover-3.0.2/LICENSE.md --- old/tasty-discover-1.1.0/LICENSE.md 2016-11-13 23:58:50.000000000 +0100 +++ new/tasty-discover-3.0.2/LICENSE.md 1970-01-01 01:00:00.000000000 +0100 @@ -1,12 +0,0 @@ -tasty-discover - Test discovery for the tasty framework. -Copyright (C) 2017 Luke Murphy <lukewm(a)riseup.net> - -This program is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/README.md new/tasty-discover-3.0.2/README.md --- old/tasty-discover-1.1.0/README.md 1970-01-01 01:00:00.000000000 +0100 +++ new/tasty-discover-3.0.2/README.md 2017-06-04 02:03:59.000000000 +0200 @@ -0,0 +1,113 @@ +[![Build Status](https://travis-ci.org/lwm/tasty-discover.svg?branch=master)](https:… +[![Hackage Status](https://img.shields.io/hackage/v/tasty-discover.svg)](http://hackag… +[![tasty-discover](http://stackage.org/package/tasty-discover/badge/nightly)](http://stackage.org/nightly/package/tasty-discover) +[![GitHub license](https://img.shields.io/badge/license-MIT-brightgreen.svg)](https:/… + +# tasty-discover + +Automatic test discovery and runner for the [tasty framework]. + +[tasty framework]: https://github.com/feuerbach/tasty + +# Getting Started + +5 steps to tasty test discovery satori: + - Create a `Tasty.hs` in the `hs-source-dirs` of your test suite. + - Set your test suite `main-is` to the `Tasty.hs`. + - Create test modules in files with suffix `*Test.hs` or `*Spec.hs`. + - Write your tests with the following prefixes: + - `prop_`: [QuickCheck](http://hackage.haskell.org/package/tasty-quickcheck) properties. + - `scprop_`: [SmallCheck](http://hackage.haskell.org/package/tasty-smallcheck) properties. + - `unit_`: [HUnit](http://hackage.haskell.org/package/tasty-hunit) test cases. + - `spec_`: [Hspec](http://hackage.haskell.org/package/tasty-hspec) specifications. + - `test_`: [Tasty](http://hackage.haskell.org/package/tasty) TestTrees. + +# Examples + +``` haskell +{-# LANGUAGE ScopedTypeVariables #-} + +module ExampleTest where + +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Hspec +import Test.Tasty.QuickCheck + +-- HUnit test case +unit_listCompare :: IO () +unit_listCompare = [1, 2, 3] `compare` [1,2] @?= GT + +-- QuickCheck property +prop_additionCommutative :: Int -> Int -> Bool +prop_additionCommutative a b = a + b == b + a + +-- SmallSheck property +scprop_sortReverse :: [Int] -> Bool +scprop_sortReverse list = sort list == sort (reverse list) + +-- Hspec specification +spec_prelude :: Spec +spec_prelude = do + describe "Prelude.head" $ do + it "returns the first element of a list" $ do + head [23 ..] `shouldBe` (23 :: Int) + +-- Tasty TestTree +test_multiplication :: [TestTree] +test_multiplication = [testProperty "One is identity" $ \(a :: Int) -> a * 1 == a] + +-- Tasty IO TestTree +test_generateTree :: IO TestTree +test_generateTree = do + input <- pure "Some input" + pure $ testCase input $ pure () + +-- Tasty IO [TestTree] +test_generateTrees :: IO [TestTree] +test_generateTrees = do + inputs <- pure ["First input", "Second input"] + pure $ map (\s -> testCase s $ pure ()) inputs +``` + +# Configuration + +Pass configuration options within your `Tasty.hs` like so: + +``` haskell +{-# + OPTIONS_GHC -F -pgmF tasty-discover + -optF <OPTION> + -optF <OPTION> + -- etc. +#-} +``` + +## No Arguments +Example: `{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --debug #-}` + + - `--no-module-suffix`: Collect all test modules, regardless of module suffix. + - `--debug`: Output the contents of the generated module while testing. + - `--tree-display`: Display the test output results hierarchically. + +## With Arguments +Example: `{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --module-suffix=FooBar #-}` + + - `--module-suffix`: Which test module suffix you wish to have discovered. + - `--generated-module`: The name of the generated test module. + - `--ignore-module`: Which test modules to ignore from discovery. + - `--ingredient`: Tasty ingredients to add to your test runner. + +# Change Log +See the [change log] for the latest changes. + +[change log]: https://github.com/lwm/tasty-discover/blob/master/CHANGELOG.md + +# Contributing +All contributions welcome! + +# Acknowledgements +Thanks to [hspec-discover] and [tasty-auto] for making this possible. + +[hspec-discover]: https://hspec.github.io/hspec-discover.html +[tasty-auto]: https://github.com/minad/tasty-auto diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/Setup.hs new/tasty-discover-3.0.2/Setup.hs --- old/tasty-discover-1.1.0/Setup.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/tasty-discover-3.0.2/Setup.hs 2017-03-11 00:56:09.000000000 +0100 @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/Setup.lhs new/tasty-discover-3.0.2/Setup.lhs --- old/tasty-discover-1.1.0/Setup.lhs 2016-11-12 18:23:30.000000000 +0100 +++ new/tasty-discover-3.0.2/Setup.lhs 1970-01-01 01:00:00.000000000 +0100 @@ -1,3 +0,0 @@ -#!/usr/bin/env runhaskell -> import Distribution.Simple -> main = defaultMain diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/example/test/AllTheFolders/AnotherNestTest.hs new/tasty-discover-3.0.2/example/test/AllTheFolders/AnotherNestTest.hs --- old/tasty-discover-1.1.0/example/test/AllTheFolders/AnotherNestTest.hs 2016-09-27 00:48:35.000000000 +0200 +++ new/tasty-discover-3.0.2/example/test/AllTheFolders/AnotherNestTest.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,4 +0,0 @@ -module AllTheFolders.AnotherNestTest where - -prop_nineIsNine :: Bool -prop_nineIsNine = 9 == (9 :: Integer) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/example/test/BarTest.hs new/tasty-discover-3.0.2/example/test/BarTest.hs --- old/tasty-discover-1.1.0/example/test/BarTest.hs 2016-10-25 02:06:18.000000000 +0200 +++ new/tasty-discover-3.0.2/example/test/BarTest.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,8 +0,0 @@ -module BarTest where - -import Test.Tasty.Discover (hspec, describe, it, shouldBe) - -case_headIsWorking = hspec $ - describe "Check if Prelude.head 'still has it'" $ - it "returns the first element of a list" $ - head [23 ..] `shouldBe` (23 :: Int) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/example/test/FooTest.hs new/tasty-discover-3.0.2/example/test/FooTest.hs --- old/tasty-discover-1.1.0/example/test/FooTest.hs 2016-09-27 00:48:35.000000000 +0200 +++ new/tasty-discover-3.0.2/example/test/FooTest.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,15 +0,0 @@ -module FooTest where - -import Test.Tasty.Discover (Assertion, (@?=), TestTree, testCase) - -test_allMyTestsGrouped :: [TestTree] -test_allMyTestsGrouped = - [ testCase "Testing the meaning of life." case_theAnswer - , testCase "Testing the number of the beast." case_theNumberOfTheBeast - ] - -case_theAnswer :: Assertion -case_theAnswer = 42 @?= (42 :: Integer) - -case_theNumberOfTheBeast :: Assertion -case_theNumberOfTheBeast = 666 @?= (666 :: Integer) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/example/test/Tasty.hs new/tasty-discover-3.0.2/example/test/Tasty.hs --- old/tasty-discover-1.1.0/example/test/Tasty.hs 2016-09-27 00:48:35.000000000 +0200 +++ new/tasty-discover-3.0.2/example/test/Tasty.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF tasty-discover #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/example/test/Thing/AnotherThing/NestedTest.hs new/tasty-discover-3.0.2/example/test/Thing/AnotherThing/NestedTest.hs --- old/tasty-discover-1.1.0/example/test/Thing/AnotherThing/NestedTest.hs 2016-09-27 00:48:35.000000000 +0200 +++ new/tasty-discover-3.0.2/example/test/Thing/AnotherThing/NestedTest.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,4 +0,0 @@ -module Thing.AnotherThing.NestedTest where - -prop_twoIsTwo :: Bool -prop_twoIsTwo = 2 == (2 :: Integer) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/executable/Main.hs new/tasty-discover-3.0.2/executable/Main.hs --- old/tasty-discover-1.1.0/executable/Main.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/tasty-discover-3.0.2/executable/Main.hs 2017-06-04 01:56:06.000000000 +0200 @@ -0,0 +1,32 @@ +-- | Main executable module. +module Main where + +import Control.Monad (when) +import Data.Maybe (fromMaybe) +import System.Environment (getArgs, getProgName) +import System.Exit (exitFailure) +import System.IO (hPutStrLn, stderr) +import Test.Tasty.Config (Config (..), parseConfig) +import Test.Tasty.Discover (findTests, generateTestDriver) + +-- | Main function. +main :: IO () +main = do + args <- getArgs + name <- getProgName + case args of + src : _ : dst : opts -> + case parseConfig name opts of + Left err -> do + hPutStrLn stderr err + exitFailure + Right config -> do + tests <- findTests src config + let ingredients = tastyIngredients config + moduleName = fromMaybe "Main" (generatedModuleName config) + output = generateTestDriver config moduleName ingredients src tests + when (debug config) $ hPutStrLn stderr output + writeFile dst output + _ -> do + hPutStrLn stderr "Usage: tasty-discover src _ dst [OPTION...]" + exitFailure diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/integration-test/test-configurable-module/FooMySuffix.hs new/tasty-discover-3.0.2/integration-test/test-configurable-module/FooMySuffix.hs --- old/tasty-discover-1.1.0/integration-test/test-configurable-module/FooMySuffix.hs 2016-09-27 00:48:35.000000000 +0200 +++ new/tasty-discover-3.0.2/integration-test/test-configurable-module/FooMySuffix.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,4 +0,0 @@ -module FooMySuffix where - -prop_theNumberOfTheBeast :: Bool -prop_theNumberOfTheBeast = 666 == (666 :: Integer) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/integration-test/test-configurable-module/Nested/BarMySuffix.hs new/tasty-discover-3.0.2/integration-test/test-configurable-module/Nested/BarMySuffix.hs --- old/tasty-discover-1.1.0/integration-test/test-configurable-module/Nested/BarMySuffix.hs 2016-09-27 00:48:35.000000000 +0200 +++ new/tasty-discover-3.0.2/integration-test/test-configurable-module/Nested/BarMySuffix.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,4 +0,0 @@ -module Nested.BarMySuffix where - -prop_theMeaningOfLife :: Bool -prop_theMeaningOfLife = 42 == (42 :: Integer) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/integration-test/test-configurable-module/Tasty.hs new/tasty-discover-3.0.2/integration-test/test-configurable-module/Tasty.hs --- old/tasty-discover-1.1.0/integration-test/test-configurable-module/Tasty.hs 2016-09-27 00:48:35.000000000 +0200 +++ new/tasty-discover-3.0.2/integration-test/test-configurable-module/Tasty.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --module-suffix=MySuffix #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/integration-test/test-no-module-suffix/Nested/AnotherBar.hs new/tasty-discover-3.0.2/integration-test/test-no-module-suffix/Nested/AnotherBar.hs --- old/tasty-discover-1.1.0/integration-test/test-no-module-suffix/Nested/AnotherBar.hs 2016-10-24 01:38:37.000000000 +0200 +++ new/tasty-discover-3.0.2/integration-test/test-no-module-suffix/Nested/AnotherBar.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,4 +0,0 @@ -module Nested.AnotherBar where - -prop_someOtherTest :: Bool -prop_someOtherTest = 12 == (12 :: Integer) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/integration-test/test-no-module-suffix/SomeFoo.hs new/tasty-discover-3.0.2/integration-test/test-no-module-suffix/SomeFoo.hs --- old/tasty-discover-1.1.0/integration-test/test-no-module-suffix/SomeFoo.hs 2016-10-24 01:38:37.000000000 +0200 +++ new/tasty-discover-3.0.2/integration-test/test-no-module-suffix/SomeFoo.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,6 +0,0 @@ -module SomeFoo where - -import Data.Maybe (isNothing) - -prop_whatIsHapeningHere :: Bool -prop_whatIsHapeningHere = isNothing Nothing diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/integration-test/test-no-module-suffix/Tasty.hs new/tasty-discover-3.0.2/integration-test/test-no-module-suffix/Tasty.hs --- old/tasty-discover-1.1.0/integration-test/test-no-module-suffix/Tasty.hs 2016-10-24 01:38:37.000000000 +0200 +++ new/tasty-discover-3.0.2/integration-test/test-no-module-suffix/Tasty.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --no-module-suffix #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/library/Test/Tasty/Config.hs new/tasty-discover-3.0.2/library/Test/Tasty/Config.hs --- old/tasty-discover-1.1.0/library/Test/Tasty/Config.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/tasty-discover-3.0.2/library/Test/Tasty/Config.hs 2017-06-04 01:56:06.000000000 +0200 @@ -0,0 +1,68 @@ +-- Configuration options module. +module Test.Tasty.Config + ( Config(..) + , parseConfig + , defaultConfig + ) where + +import Data.Maybe (isJust) +import System.Console.GetOpt (ArgDescr (NoArg, ReqArg), + ArgOrder (Permute), OptDescr (Option), + getOpt) + +type Ingredient = String + +data Config = Config + { moduleSuffix :: Maybe String + , generatedModuleName :: Maybe String + , ignoredModules :: [FilePath] + , tastyIngredients :: [Ingredient] + , noModuleSuffix :: Bool + , debug :: Bool + , treeDisplay :: Bool + } deriving (Show) + +-- | The default configuration +defaultConfig :: Config +defaultConfig = Config Nothing Nothing [] [] False False False + +-- | Configuration options parser. +parseConfig :: String -> [String] -> Either String Config +parseConfig prog args = case getOpt Permute options args of + (opts, [], []) -> + let config = foldl (flip id) defaultConfig opts + errorMsg = "You cannot combine '--no-module-suffix' and '--module-suffix'\n" + in + if noModuleSuffix config && isJust (moduleSuffix config) + then formatError errorMsg + else Right config + (_, _, err:_) -> formatError err + (_, arg:_, _) -> formatError ("unexpected argument `" ++ arg ++ "`\n") + where + formatError err = Left (prog ++ ": " ++ err) + +-- | All configuration options. +options :: [OptDescr (Config -> Config)] +options = [ + Option [] ["module-suffix"] + (ReqArg (\s c -> c {moduleSuffix = Just s}) "SUFFIX") + "Specify desired test module suffix" + , Option [] ["generated-module"] + (ReqArg (\s c -> c {generatedModuleName = Just s}) "MODULE") + "Qualified generated module name" + , Option [] ["ignore-module"] + (ReqArg (\s c -> c {ignoredModules = s : ignoredModules c}) "FILE") + "Ignore a test module" + , Option [] ["ingredient"] + (ReqArg (\s c -> c {tastyIngredients = s : tastyIngredients c}) "INGREDIENT") + "Qualified tasty ingredient name" + , Option [] ["no-module-suffix"] + (NoArg $ \c -> c {noModuleSuffix = True}) + "Ignore test module suffix and import them all" + , Option [] ["debug"] + (NoArg $ \c -> c {debug = True}) + "Debug output of generated test module" + , Option [] ["tree-display"] + (NoArg $ \c -> c {treeDisplay = True}) + "Display test output hierarchically" + ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/library/Test/Tasty/Discover.hs new/tasty-discover-3.0.2/library/Test/Tasty/Discover.hs --- old/tasty-discover-1.1.0/library/Test/Tasty/Discover.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/tasty-discover-3.0.2/library/Test/Tasty/Discover.hs 2017-06-04 01:56:06.000000000 +0200 @@ -0,0 +1,131 @@ +-- | Automatic test discovery and runner for the tasty framework. +module Test.Tasty.Discover where + +import Data.List (dropWhileEnd, intercalate, isPrefixOf, + isSuffixOf, nub) +import qualified Data.Map.Strict as M +import Data.Traversable (for) +import System.Directory (doesDirectoryExist, getDirectoryContents) +import System.FilePath (takeDirectory, (</>)) +import Test.Tasty.Config (Config (..)) +import Test.Tasty.Generator (Generator (..), Test (..), generators, + getGenerators, mkTest, showSetup) + +generateTestDriver :: Config -> String -> [String] -> FilePath -> [Test] -> String +generateTestDriver config modname is src tests = + let generators' = getGenerators tests + testNumVars = map (("t"++) . show) [(0 :: Int)..] + in + concat + [ "{-# LINE 1 \"" ++ src ++ "\" #-}\n" + , "{-# LANGUAGE FlexibleInstances #-}\n" + , "module " ++ modname ++ " (main, ingredients, tests) where\n" + , "import Prelude\n" + , "import qualified Test.Tasty as T\n" + , "import qualified Test.Tasty.Ingredients as T\n" + , unlines $ map generatorImport generators' + , showImports (map ingredientImport is ++ map testModule tests) + , unlines $ map generatorClass generators' + , "tests :: IO T.TestTree\n" + , "tests = do\n" + , unlines $ zipWith showSetup tests testNumVars + , " pure $ T.testGroup \"" ++ src ++ "\" [" + , intercalate "," $ showTests config tests testNumVars + , "]\n" + , concat + [ "ingredients :: [T.Ingredient]\n" + , "ingredients = " ++ ingredients is ++ "\n" + , "main :: IO ()\n" + , "main = tests >>= T.defaultMainWithIngredients ingredients\n" + ] + ] + +addSuffixes :: [String] -> [String] +addSuffixes modules = (++) <$> modules <*> [".lhs", ".hs"] + +isHidden :: FilePath -> Bool +isHidden filename = head filename /= '.' + +filesBySuffix :: FilePath -> [String] -> IO [FilePath] +filesBySuffix dir suffixes = do + entries <- filter isHidden <$> getDirectoryContents dir + fmap concat $ for entries $ \entry -> do + let dir' = dir </> entry + dirExists <- doesDirectoryExist dir' + if dirExists then + map (entry </>) <$> filesBySuffix dir' suffixes + else if any (`isSuffixOf` entry) suffixes then + pure [entry] + else + pure [] + +isIgnored :: [FilePath] -> String -> Bool +isIgnored ignores filename = filename `notElem` addSuffixes ignores + +findTests :: FilePath -> Config -> IO [Test] +findTests src config = do + let dir = takeDirectory src + suffixes = testFileSuffixes config + ignores = ignoredModules config + files <- filter (isIgnored ignores) <$> filesBySuffix dir suffixes + concat <$> traverse (extract dir) files + where + extract dir file = extractTests file <$> readFile (dir </> file) + +extractTests :: FilePath -> String -> [Test] +extractTests file = mkTestDeDuped . isKnownPrefix . parseTest + where + mkTestDeDuped = map (mkTest file) . nub + isKnownPrefix = filter (\g -> any (checkPrefix g) generators) + checkPrefix g = (`isPrefixOf` g) . generatorPrefix + parseTest = map fst . concatMap lex . lines + +testFileSuffixes :: Config -> [String] +testFileSuffixes config = if noModuleSuffix config + then [""] + else addSuffixes suffixes + where + suffixes = case moduleSuffix config of + Just suffix' -> [suffix'] + Nothing -> ["Spec", "Test"] + +showImports :: [String] -> String +showImports mods = unlines $ nub $ map (\m -> "import qualified " ++ m ++ "\n") mods + +ingredientImport :: String -> String +ingredientImport = init . dropWhileEnd (/= '.') + +ingredients :: [String] -> String +ingredients is = concat $ map (++":") is ++ ["T.defaultIngredients"] + +showTests :: Config -> [Test] -> [String] -> [String] +showTests config tests testNumVars = if treeDisplay config + then showModuleTree $ mkModuleTree tests testNumVars + else zipWith (curry snd) tests testNumVars + +newtype ModuleTree = ModuleTree (M.Map String (ModuleTree, [String])) + deriving (Eq, Show) + +showModuleTree :: ModuleTree -> [String] +showModuleTree (ModuleTree mdls) = map showModule $ M.assocs mdls + where + -- special case, collapse to mdl.submdl + showModule (mdl, (ModuleTree subMdls, [])) | M.size subMdls == 1 = + let [(subMdl, (subSubTree, testVars))] = M.assocs subMdls + in showModule (mdl ++ '.' : subMdl, (subSubTree, testVars)) + showModule (mdl, (subTree, testVars)) = concat + [ "T.testGroup \"", mdl + , "\" [", intercalate "," (showModuleTree subTree ++ testVars), "]" ] + +mkModuleTree :: [Test] -> [String] -> ModuleTree +mkModuleTree tests testVars = ModuleTree $ + foldr go M.empty $ zipWith (\t tVar -> (testModule t, tVar)) tests testVars + where + go (mdl, tVar) mdls = M.insertWith merge key val mdls + where + (key, val) = case break (== '.') mdl of + (_, []) -> (mdl, (ModuleTree M.empty, [tVar])) + (topMdl, '.':subMdl) -> (topMdl, (ModuleTree $ go (subMdl, tVar) M.empty, [])) + _ -> error "impossible case in mkModuleTree.go.key" + merge (ModuleTree mdls1, tVars1) (ModuleTree mdls2, tVars2) = + (ModuleTree $ M.unionWith merge mdls1 mdls2, tVars1 ++ tVars2) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/library/Test/Tasty/Generator.hs new/tasty-discover-3.0.2/library/Test/Tasty/Generator.hs --- old/tasty-discover-1.1.0/library/Test/Tasty/Generator.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/tasty-discover-3.0.2/library/Test/Tasty/Generator.hs 2017-06-04 01:56:06.000000000 +0200 @@ -0,0 +1,124 @@ +module Test.Tasty.Generator + ( Generator(..) + , generators + , showSetup + , getGenerator + , getGenerators + , Test(..) + , mkTest, + ) where + +import Data.Function (on) +import Data.List (find, groupBy, isPrefixOf, sortOn) +import Data.Maybe (fromJust) +import System.FilePath (dropExtension, pathSeparator) + +data Test = Test + { testModule :: String + , testFunction :: String + } deriving (Eq, Show) + +mkTest :: FilePath -> String -> Test +mkTest = Test . chooser pathSeparator '.' . dropExtension + where chooser c1 c2 = map $ \c3 -> if c3 == c1 then c2 else c3 + +data Generator = Generator + { generatorPrefix :: String + , generatorImport :: String + , generatorClass :: String + , generatorSetup :: Test -> String + } + +qualifyFunction :: Test -> String +qualifyFunction t = testModule t ++ "." ++ testFunction t + +name :: Test -> String +name = chooser '_' ' ' . tail . dropWhile (/= '_') . testFunction + where chooser c1 c2 = map $ \c3 -> if c3 == c1 then c2 else c3 + +getGenerator :: Test -> Generator +getGenerator t = fromJust $ getPrefix generators + where getPrefix = find ((`isPrefixOf` testFunction t) . generatorPrefix) + +getGenerators :: [Test] -> [Generator] +getGenerators = + map head . + groupBy ((==) `on` generatorPrefix) . + sortOn generatorPrefix . + map getGenerator + +showSetup :: Test -> String -> String +showSetup t var = " " ++ var ++ " <- " ++ setup ++ "\n" + where setup = generatorSetup (getGenerator t) t + +generators :: [Generator] +generators = + [ quickCheckPropertyGenerator + , hunitTestCaseGeneratorDeprecated + , hunitTestCaseGenerator + , hspecTestCaseGenerator + , tastyTestGroupGenerator + ] + +quickCheckPropertyGenerator :: Generator +quickCheckPropertyGenerator = Generator + { generatorPrefix = "prop_" + , generatorImport = "import qualified Test.Tasty.QuickCheck as QC\n" + , generatorClass = "" + , generatorSetup = \t -> "pure $ QC.testProperty \"" ++ name t ++ "\" " ++ qualifyFunction t + } + +deprecationMessage :: String +deprecationMessage = + error $ concat + [ "\n\n" + , "----------------------------------------------------------\n" + , "DEPRECATION NOTICE: The `case_` prefix is deprecated.\n" + , "Please use the `unit_` prefix instead.\n" + , "Please see https://github.com/lwm/tasty-discover/issues/95.\n" + , "----------------------------------------------------------\n" + ] + +-- DEPRECATED: Use `unit_` instead (below) +hunitTestCaseGeneratorDeprecated :: Generator +hunitTestCaseGeneratorDeprecated = Generator + { generatorPrefix = "case_" + , generatorImport = deprecationMessage + , generatorClass = deprecationMessage + , generatorSetup = const deprecationMessage + } + +hunitTestCaseGenerator :: Generator +hunitTestCaseGenerator = Generator + { generatorPrefix = "unit_" + , generatorImport = "import qualified Test.Tasty.HUnit as HU\n" + , generatorClass = concat + [ "class TestCase a where testCase :: String -> a -> IO T.TestTree\n" + , "instance TestCase (IO ()) where testCase n = pure . HU.testCase n\n" + , "instance TestCase (IO String) where testCase n = pure . HU.testCaseInfo n\n" + , "instance TestCase ((String -> IO ()) -> IO ()) where testCase n = pure . HU.testCaseSteps n\n" + ] + , generatorSetup = \t -> "testCase \"" ++ name t ++ "\" " ++ qualifyFunction t + } + +hspecTestCaseGenerator :: Generator +hspecTestCaseGenerator = Generator + { generatorPrefix = "spec_" + , generatorImport = "import qualified Test.Tasty.Hspec as HS\n" + , generatorClass = "" + , generatorSetup = \t -> "HS.testSpec \"" ++ name t ++ "\" " ++ qualifyFunction t + } + +tastyTestGroupGenerator :: Generator +tastyTestGroupGenerator = Generator + { generatorPrefix = "test_" + , generatorImport = "" + , generatorClass = concat + [ "class TestGroup a where testGroup :: String -> a -> IO T.TestTree\n" + , "instance TestGroup T.TestTree where testGroup _ a = pure a\n" + , "instance TestGroup [T.TestTree] where testGroup n a = pure $ T.testGroup n a\n" + , "instance TestGroup (IO T.TestTree) where testGroup _ a = a\n" + , "instance TestGroup (IO [T.TestTree]) where testGroup n a = T.testGroup n <$> a\n" + ] + , generatorSetup = \t -> "testGroup \"" ++ name t ++ "\" " ++ qualifyFunction t + } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/src/Main.hs new/tasty-discover-3.0.2/src/Main.hs --- old/tasty-discover-1.1.0/src/Main.hs 2016-11-12 13:24:28.000000000 +0100 +++ new/tasty-discover-3.0.2/src/Main.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,11 +0,0 @@ --- | Main module and entry point. - -module Main where - -import System.Environment (getArgs) - -import Test.Tasty.Run (run) - --- | Pass pre processor arguments. -main :: IO () -main = getArgs >>= run diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/src/Test/Tasty/Config.hs new/tasty-discover-3.0.2/src/Test/Tasty/Config.hs --- old/tasty-discover-1.1.0/src/Test/Tasty/Config.hs 2017-01-19 21:44:52.000000000 +0100 +++ new/tasty-discover-3.0.2/src/Test/Tasty/Config.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,26 +0,0 @@ --- | Preprocessor configuration. - -module Test.Tasty.Config ( - Config(..) -, defaultConfig -, options -) where - -import System.Console.GetOpt (ArgDescr (ReqArg, NoArg) , OptDescr (Option)) - -import Test.Tasty.Type (Config(..)) - --- | The empty configuration. -defaultConfig :: Config -defaultConfig = Config Nothing False [] - --- | All configuration options. -options :: [OptDescr (Config -> Config)] -options = [ - Option [] ["module-suffix"] - (ReqArg (\s c -> c {configModuleSuffix = Just s}) "SUFFIX") "" - , Option [] ["no-module-suffix"] - (NoArg $ \c -> c {noModuleSuffix = True}) "" - , Option [] ["ignore-module"] - (ReqArg (\s c -> c {ignoredModules = s : ignoredModules c}) "FILE") "" - ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/src/Test/Tasty/Discover.hs new/tasty-discover-3.0.2/src/Test/Tasty/Discover.hs --- old/tasty-discover-1.1.0/src/Test/Tasty/Discover.hs 2016-11-12 13:24:29.000000000 +0100 +++ new/tasty-discover-3.0.2/src/Test/Tasty/Discover.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,17 +0,0 @@ --- | Automatic test discovery and runner for the tasty framework. - -module Test.Tasty.Discover (module Discover) where - --- 3rd party -import Test.Tasty as Discover -import Test.Tasty.HUnit as Discover -import Test.Tasty.QuickCheck as Discover -import Test.Tasty.TH as Discover -import Test.Tasty.Hspec as Discover - --- `tasty-discover` modules -import Test.Tasty.Run as Discover -import Test.Tasty.Parse as Discover -import Test.Tasty.Type as Discover -import Test.Tasty.Config as Discover -import Test.Tasty.Util as Discover diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/src/Test/Tasty/Parse.hs new/tasty-discover-3.0.2/src/Test/Tasty/Parse.hs --- old/tasty-discover-1.1.0/src/Test/Tasty/Parse.hs 2016-11-12 13:24:29.000000000 +0100 +++ new/tasty-discover-3.0.2/src/Test/Tasty/Parse.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,25 +0,0 @@ --- | Parser for the GHC preprocessor definition. - -module Test.Tasty.Parse ( - parseConfig -) where - -import Data.Maybe (isJust) -import System.Console.GetOpt (ArgOrder (Permute), getOpt) - -import Test.Tasty.Config (Config(..), defaultConfig, options) - --- | Preprocessor configuration parser. -parseConfig :: String -> [String] -> Either String Config -parseConfig prog args = case getOpt Permute options args of - (opts, [], []) -> - let config = foldl (flip id) defaultConfig opts - errorMsg = "You cannot combine '--no-module-suffix' and '--module-suffix'\n" - in - if noModuleSuffix config && isJust (configModuleSuffix config) - then formatError errorMsg - else Right config - (_, _, err:_) -> formatError err - (_, arg:_, _) -> formatError ("unexpected argument `" ++ arg ++ "`\n") - where - formatError err = Left (prog ++ ": " ++ err) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/src/Test/Tasty/Run.hs new/tasty-discover-3.0.2/src/Test/Tasty/Run.hs --- old/tasty-discover-1.1.0/src/Test/Tasty/Run.hs 2016-11-12 13:24:30.000000000 +0100 +++ new/tasty-discover-3.0.2/src/Test/Tasty/Run.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,54 +0,0 @@ --- | Test discovery and runner boilerplate generator. - -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Test.Tasty.Run ( - run -, tmpModule -) where - -import System.Environment (getProgName) -import System.IO (hPutStrLn, stderr) -import System.Exit (exitFailure) - -import Test.Tasty.Parse (parseConfig) -import Test.Tasty.Util (importList, findTests, getListOfTests) -import Test.Tasty.Type (Config, Test) - --- | Parse preprocessor arguments and write the test runner module. -run :: [String] -> IO () -run processor_args = do - name <- getProgName - case processor_args of - src : _ : dst : opts -> case parseConfig name opts of - - Left err -> do - hPutStrLn stderr err - exitFailure - - Right conf -> do - stringed <- show <$> getListOfTests src conf - tests <- findTests src conf - writeFile dst (tmpModule src conf tests stringed) - - _ -> do - hPutStrLn stderr name - exitFailure - - --- | Generate the test runner module. -tmpModule :: FilePath -> Config -> [Test] -> String -> String -tmpModule src conf tests ts = - ( - "{-# LINE 1 " . shows src . " #-}\n" - . showString "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}\n" - . showString "{-# LANGUAGE TemplateHaskell #-}\n" - . showString "module Main where\n" - . showString "import Test.Tasty.Discover\n" - . importList tests conf - . showString "main :: IO ()\n" - . showString ("main = do $(defaultMainGeneratorFor \"tasty-discover\" " ++ ts ++ ")") - ) "\n" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/src/Test/Tasty/Type.hs new/tasty-discover-3.0.2/src/Test/Tasty/Type.hs --- old/tasty-discover-1.1.0/src/Test/Tasty/Type.hs 2017-01-19 21:44:52.000000000 +0100 +++ new/tasty-discover-3.0.2/src/Test/Tasty/Type.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,18 +0,0 @@ --- | Types. - -module Test.Tasty.Type where - --- | A test type. Corresponds to a test file path and module name. -data Test = Test { - testFile :: FilePath -, testModule :: String -} deriving (Eq, Show) - --- | A configuration type. --- Constructor values are parsed from the preprocessor file. -data Config = Config { - configModuleSuffix :: Maybe String -, noModuleSuffix :: Bool -, ignoredModules :: [FilePath] -} deriving (Eq, Show) - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/src/Test/Tasty/Util.hs new/tasty-discover-3.0.2/src/Test/Tasty/Util.hs --- old/tasty-discover-1.1.0/src/Test/Tasty/Util.hs 2017-01-19 21:44:52.000000000 +0100 +++ new/tasty-discover-3.0.2/src/Test/Tasty/Util.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,135 +0,0 @@ --- | Utility functions. - -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Test.Tasty.Util ( - importList -, findTests -, getListOfTests - --- Testing purposes -, fileToTest -, getFilesRecursive -, isValidModuleChar -, isValidModuleName -) where - -import Control.Applicative ((<|>)) -import Control.Monad (filterM) -import Data.Char (isAlphaNum, isUpper) -import Data.List (intercalate, sort, stripPrefix) -import Data.Maybe (mapMaybe) -import Data.String (IsString, fromString) -import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents) -import System.FilePath (splitDirectories, splitFileName, (</>)) -import System.FilePath.Posix (splitExtension) - -import Test.Tasty.TH (extractTestFunctions) - -import Test.Tasty.Config (Config(..)) -import Test.Tasty.Type - -instance IsString ShowS where - fromString = showString - --- | Import statements for a list of tests. -importList :: [Test] -> Config -> ShowS -importList ts config = - foldr ((.) . f) "" ts - where - f :: Test -> ShowS - f test = if noModuleSuffix config then - "import " . showString (testModule test) . "\n" - else - case configModuleSuffix config of - Just suffix' -> "import " . showString (testModule test) . showString (suffix' ++ "\n") - _ -> "import " . showString (testModule test) . "Test\n" - - --- | Is 'c' a valid character in a Haskell module name? -isValidModuleChar :: Char -> Bool -isValidModuleChar c = isAlphaNum c || c == '_' || c == '\'' - --- | Is 'cs' a valid Haskell module name? -isValidModuleName :: String -> Bool -isValidModuleName [] = False -isValidModuleName (c:cs) = isUpper c && all isValidModuleChar cs - --- | All files under 'baseDir'. -getFilesRecursive :: FilePath -> IO [FilePath] -getFilesRecursive baseDir = sort <$> go [] - where - go :: FilePath -> IO [FilePath] - go dir = do - c <- map (dir </>) . filter (`notElem` [".", ".."]) <$> getDirectoryContents (baseDir </> dir) - dirs <- filterM (doesDirectoryExist . (baseDir </>)) c >>= mapM go - files <- filterM (doesFileExist . (baseDir </>)) c - return (files ++ concat dirs) - --- | Convert a file to a File type. -fileToTest :: FilePath -> Config -> FilePath -> Maybe Test -fileToTest dir conf file = - let - suffix :: Maybe String - suffix = configModuleSuffix conf - - noModule :: Bool - noModule = noModuleSuffix conf - - files :: [FilePath] - files = reverse $ splitDirectories file - in - if noModule then catchAll files else case suffix of - Just suffix' -> filterBySuffix suffix' files - Nothing -> filterBySuffix "Test" files - where - filterBySuffix :: String -> [FilePath] -> Maybe Test - filterBySuffix suffix files = - case files of - x:xs -> case - stripSuffix (suffix ++ ".hs") x <|> stripSuffix (suffix ++ ".lhs") x of - Just name | isValidModuleName name && all isValidModuleName xs -> - let pathComponents = reverse (name : xs) - moduleName = intercalate "." pathComponents - in if isIgnoredModule pathComponents - then Nothing - else Just . Test (dir </> file) $ moduleName - _ -> Nothing - _ -> Nothing - - isIgnoredModule :: [FilePath] -> Bool - isIgnoredModule pathComponents = - let moduleName = intercalate "." pathComponents - in moduleName `elem` ignoredModules conf - - stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] - stripSuffix suff str = reverse <$> stripPrefix (reverse suff) (reverse str) - - catchAll :: [FilePath] -> Maybe Test - catchAll (x:xs) = - let name = fst $ splitExtension x - pathComponents = reverse (name : xs) - in - if isValidModuleName name - && all isValidModuleName xs - && not (isIgnoredModule pathComponents) then - Just . Test (dir </> file) $ (intercalate "." . reverse) (name : xs) - else Nothing - catchAll _ = Nothing - --- | All test modules under 'dir'. -findTests :: FilePath -> Config -> IO [Test] -findTests path config = - let (dir, file) = splitFileName path - tests = mapMaybe $ fileToTest dir config - in - tests . filter (/= file) <$> getFilesRecursive dir - --- | All test function names in 'src'. -getListOfTests :: FilePath -> Config -> IO [String] -getListOfTests src conf = do - allFiles <- fmap testFile <$> findTests src conf - allTests <- mapM extractTestFunctions allFiles - return $ concat allTests diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/tasty-discover.cabal new/tasty-discover-3.0.2/tasty-discover.cabal --- old/tasty-discover-1.1.0/tasty-discover.cabal 2017-01-19 21:45:16.000000000 +0100 +++ new/tasty-discover-3.0.2/tasty-discover.cabal 2017-06-04 10:19:58.000000000 +0200 @@ -1,87 +1,79 @@ -name: tasty-discover -version: 1.1.0 -license: GPL-3 -license-file: LICENSE.md -copyright: (c) 2016 Luke Murphy -author: Luke Murphy <lukewm(a)riseup.net> -maintainer: Luke Murphy <lukewm(a)riseup.net> -build-type: Simple -cabal-version: >= 1.22 -category: Testing -stability: Stable -bug-reports: https://github.com/lwm/tasty-discover/issues -homepage: https://github.com/lwm/tasty-discover/ -synopsis: Test discovery for the tasty framework. -description: Test discovery for the tasty framework. +-- This file has been generated from package.yaml by hpack version 0.17.0. +-- +-- see: https://github.com/sol/hpack + +name: tasty-discover +version: 3.0.2 +synopsis: Test discovery for the tasty framework. +description: Automatic test discovery and runner for the tasty framework. + Prefix your test case names and tasty-discover will discover, collect and run them. All popular test libraries are covered. Configure once and then just write your tests. Avoid forgetting to add test modules to your Cabal/Hpack files. Tasty ingredients are included along with various configuration options for different use cases. Please see the `README.md` below for how to get started. +category: Testing +stability: Experimental +homepage: https://github.com/lwm/tasty-discover#readme +bug-reports: https://github.com/lwm/tasty-discover/issues +author: Luke Murphy +maintainer: Luke Murphy <lukewm(a)riseup.net> +copyright: 2016 Luke Murphy +license: MIT +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 + extra-source-files: - integration-test/test-configurable-module/*.hs - integration-test/test-configurable-module/Nested/*.hs - integration-test/test-no-module-suffix/*.hs - integration-test/test-no-module-suffix/Nested/*.hs - example/test/*.hs - example/test/AllTheFolders/*.hs - example/test/Thing/AnotherThing/*.hs - test/tmpdir/*.hs - test/tmpdir/*.md + CHANGELOG.md + README.md + +source-repository head + type: git + location: https://github.com/lwm/tasty-discover library - ghc-options: - -Wall - exposed-modules: - Test.Tasty.Discover - other-modules: - Test.Tasty.Config - Test.Tasty.Parse - Test.Tasty.Run - Test.Tasty.Util - Test.Tasty.Type + hs-source-dirs: + library + ghc-options: -Wall build-depends: - base == 4.* - , filepath - , directory - , tasty - , tasty-th - , tasty-hunit - , tasty-quickcheck - , tasty-hspec - hs-source-dirs: src + base >= 4.8 && < 5.0 + , containers >= 0.4 && < 1.0 + , directory >= 1.1 && < 2.0 + , filepath >= 1.3 && < 2.0 + exposed-modules: + Test.Tasty.Config + Test.Tasty.Discover + Test.Tasty.Generator default-language: Haskell2010 executable tasty-discover - ghc-options: - -Wall - hs-source-dirs: - src - main-is: - Main.hs - other-modules: - Test.Tasty.Config - Test.Tasty.Discover - Test.Tasty.Parse - Test.Tasty.Run - Test.Tasty.Util - Test.Tasty.Type + main-is: executable/Main.hs + ghc-options: -Wall build-depends: - base == 4.* - , filepath - , directory + base >= 4.8 && < 5.0 + , containers >= 0.4 && < 1.0 + , directory >= 1.1 && < 2.0 + , filepath >= 1.3 && < 2.0 , tasty-discover - , tasty-th default-language: Haskell2010 -test-suite unit-tests - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: Tasty.hs - other-modules: - ParseTest - RunnerTest - UtilTest +test-suite test + type: exitcode-stdio-1.0 + main-is: Tasty.hs + hs-source-dirs: + test + ghc-options: -Wall build-depends: - base == 4.* + base >= 4.8 && < 5.0 + , containers >= 0.4 && < 1.0 + , directory >= 1.1 && < 2.0 + , filepath >= 1.3 && < 2.0 + , base + , tasty , tasty-discover - default-language: Haskell2010 - -Source-repository head - type: git - location: git://github.com/lwm/tasty-discover.git + , tasty-hspec + , tasty-hunit + , tasty-quickcheck + , tasty-smallcheck + other-modules: + ConfigTest + DiscoverTest + SubMod.FooBaz + SubMod.PropTest + default-language: Haskell2010 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/test/ConfigTest.hs new/tasty-discover-3.0.2/test/ConfigTest.hs --- old/tasty-discover-1.1.0/test/ConfigTest.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/tasty-discover-3.0.2/test/ConfigTest.hs 2017-06-04 01:56:06.000000000 +0200 @@ -0,0 +1,80 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +module ConfigTest where + +import Data.List (isInfixOf) +import qualified Data.Map.Strict as M +import Test.Tasty.Config +import Test.Tasty.Discover (ModuleTree (..), findTests, + generateTestDriver, mkModuleTree, + showTests) +import Test.Tasty.Generator (Test (..), mkTest) +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck + +unit_noModuleSuffixEmptyList :: IO () +unit_noModuleSuffixEmptyList = do + actual <- findTests "test/SubMod/" (defaultConfig { moduleSuffix = Just "DoesntExist"}) + actual @?= [] + +unit_differentGeneratedModule :: Assertion +unit_differentGeneratedModule = assertBool "" ("FunkyModuleName" `isInfixOf` generatedModule) + where generatedModule = generateTestDriver defaultConfig "FunkyModuleName" [] "test/" [] + +unit_ignoreAModule :: IO () +unit_ignoreAModule = do + actual <- findTests "test/SubMod/" (defaultConfig { ignoredModules = ["PropTest"] }) + actual @?= [] + +unit_noModuleSuffix :: IO () +unit_noModuleSuffix = do + actual1 <- findTests "test/SubMod/" defaultConfig + actual1 @?= [mkTest "PropTest" "prop_additionAssociative"] + + actual2 <- findTests "test/SubMod/" (defaultConfig { noModuleSuffix = True }) + let expected = [ mkTest "FooBaz" "prop_additionCommutative" + , mkTest "FooBaz" "prop_multiplationDistributiveOverAddition" + , mkTest "PropTest" "prop_additionAssociative" ] + assertBool "" $ all (`elem` expected) actual2 + +unit_noModuleSuffixRecurseDirs :: IO () +unit_noModuleSuffixRecurseDirs = do + tests <- findTests "test/" (defaultConfig { noModuleSuffix = True }) + assertBool "" $ elem (mkTest "SubMod/FooBaz" "prop_additionCommutative") tests + +unit_noTreeDisplayDefault :: IO () +unit_noTreeDisplayDefault = do + let config = defaultConfig { noModuleSuffix = True } + tests <- findTests "test/SubMod/" config + let testNumVars = map (('t' :) . show) [(0::Int)..] + trees = showTests config tests testNumVars + length trees @?= 3 + +unit_treeDisplay :: IO () +unit_treeDisplay = do + let config = defaultConfig { noModuleSuffix = True, treeDisplay = True } + tests <- findTests "test/SubMod/" config + let testNumVars = map (('t' :) . show) [(0::Int)..] + trees = showTests config tests testNumVars + length trees @?= 2 + +prop_mkModuleTree :: ModuleTree -> Property +prop_mkModuleTree mtree = + let (tests, testVars) = unzip $ flattenTree mtree + in mkModuleTree tests testVars === mtree + where + flattenTree (ModuleTree mp) = M.assocs mp >>= flattenModule + flattenModule (mdl, (subTree, testVars)) = concat + [ map (\(Test subMdl _, tVar) -> (Test (mdl ++ '.':subMdl) "-", tVar)) (flattenTree subTree) + , map (\tVar -> (Test mdl "-", tVar)) testVars ] + +instance Arbitrary ModuleTree where + arbitrary = sized $ \size -> + resize (min size 12) (ModuleTree . M.fromList <$> listOf1 mdlGen) + where + mdlGen = sized $ \size -> do + mdl <- listOf1 (elements ['a'..'z']) + subTree <- if size == 0 + then pure $ ModuleTree M.empty + else resize (size `div` 2) arbitrary + tVars <- listOf1 (listOf1 arbitrary) + pure (mdl, (subTree, tVars)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/test/DiscoverTest.hs new/tasty-discover-3.0.2/test/DiscoverTest.hs --- old/tasty-discover-1.1.0/test/DiscoverTest.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/tasty-discover-3.0.2/test/DiscoverTest.hs 2017-06-04 00:46:53.000000000 +0200 @@ -0,0 +1,43 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module DiscoverTest where + +import Data.List +import Test.Tasty +import Test.Tasty.Hspec +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck + +unit_listCompare :: IO () +unit_listCompare = [1 :: Int, 2, 3] `compare` [1,2] @?= GT + +prop_additionCommutative :: Int -> Int -> Bool +prop_additionCommutative a b = a + b == b + a + +scprop_sortReverse :: [Int] -> Bool +scprop_sortReverse list = sort list == sort (reverse list) + +spec_prelude :: Spec +spec_prelude = + describe "Prelude.head" $ + it "returns the first element of a list" $ + head [23 ..] `shouldBe` (23 :: Int) + +test_addition :: TestTree +test_addition = testProperty "Addition commutes" $ \(a :: Int) (b :: Int) -> a + b == b + a + +test_multiplication :: [TestTree] +test_multiplication = + [ testProperty "Multiplication commutes" $ \(a :: Int) (b :: Int) -> a * b == b * a + , testProperty "One is identity" $ \(a :: Int) -> a == a + ] + +test_generateTree :: IO TestTree +test_generateTree = do + input <- pure "Some input" + pure $ testCase input $ pure () + +test_generateTrees :: IO [TestTree] +test_generateTrees = do + inputs <- pure ["First input", "Second input"] + pure $ map (\s -> testCase s $ pure ()) inputs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/test/ParseTest.hs new/tasty-discover-3.0.2/test/ParseTest.hs --- old/tasty-discover-1.1.0/test/ParseTest.hs 2017-01-19 21:44:52.000000000 +0100 +++ new/tasty-discover-3.0.2/test/ParseTest.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,45 +0,0 @@ --- Unit tests for Test.Tasty.Parse module. - -module ParseTest where - -import Test.Tasty.Discover (parseConfig, Config(..), - Assertion, (@?=)) - -case_parseConfig :: Assertion -case_parseConfig = - parseConfig "foo" ["--module-suffix=MySuffix"] - @?= - Right Config { configModuleSuffix=Just "MySuffix" - , noModuleSuffix=False - , ignoredModules=[] - } - -case_parseConfigMissingArg :: Assertion -case_parseConfigMissingArg = - parseConfig "foo" ["--module-suffix"] - @?= - Left "foo: option `--module-suffix' requires an argument SUFFIX\n" - -case_parseConfigEmptyArg :: Assertion -case_parseConfigEmptyArg = - parseConfig "foo" [] - @?= - Right (Config Nothing False []) - -case_parseConfigInvalidArg :: Assertion -case_parseConfigInvalidArg = - parseConfig "foo" ["a"] - @?= - Left "foo: unexpected argument `a`\n" - -case_parseConfigBooleanArg :: Assertion -case_parseConfigBooleanArg = - parseConfig "foo" ["--no-module-suffix"] - @?= - Right Config {configModuleSuffix=Nothing, noModuleSuffix=True, ignoredModules= []} - -case_parseConfigInvalidArgCombination :: Assertion -case_parseConfigInvalidArgCombination = - parseConfig "foo" ["--module-suffix=MySuffix", "--no-module-suffix"] - @?= - Left "foo: You cannot combine '--no-module-suffix' and '--module-suffix'\n" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/test/RunnerTest.hs new/tasty-discover-3.0.2/test/RunnerTest.hs --- old/tasty-discover-1.1.0/test/RunnerTest.hs 2016-11-12 13:24:32.000000000 +0100 +++ new/tasty-discover-3.0.2/test/RunnerTest.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,20 +0,0 @@ --- Unit tests to assure `tasty-discover` is discovering tests. - -module RunnerTest where - -import Test.Tasty.Discover (Assertion, (@?), defaultConfig, getListOfTests) - -case_unitTestsDiscovered :: Assertion -case_unitTestsDiscovered = do - unitTests <- getListOfTests "test" defaultConfig - (return $ null unitTests :: IO Bool) @? "Couldn't find any unit tests." - -case_integrationTestsDiscovered :: Assertion -case_integrationTestsDiscovered = do - integrationTests <- getListOfTests "integration-test/" defaultConfig - (return $ null integrationTests :: IO Bool) @? "Couldn't find any integration tests." - -case_exampleTestsDiscovered :: Assertion -case_exampleTestsDiscovered = do - exampleTests <- getListOfTests "example/" defaultConfig - (return $ null exampleTests :: IO Bool) @? "Couldn't find any example tests." diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/test/SubMod/FooBaz.hs new/tasty-discover-3.0.2/test/SubMod/FooBaz.hs --- old/tasty-discover-1.1.0/test/SubMod/FooBaz.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/tasty-discover-3.0.2/test/SubMod/FooBaz.hs 2017-06-04 01:56:06.000000000 +0200 @@ -0,0 +1,7 @@ +module SubMod.FooBaz where + +prop_additionCommutative :: Int -> Int -> Bool +prop_additionCommutative a b = a + b == b + a + +prop_multiplationDistributiveOverAddition :: Integer -> Integer -> Integer -> Bool +prop_multiplationDistributiveOverAddition a b c = a * (b + c) == a * b + a * c diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/test/SubMod/PropTest.hs new/tasty-discover-3.0.2/test/SubMod/PropTest.hs --- old/tasty-discover-1.1.0/test/SubMod/PropTest.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/tasty-discover-3.0.2/test/SubMod/PropTest.hs 2017-06-04 00:46:54.000000000 +0200 @@ -0,0 +1,4 @@ +module SubMod.PropTest where + +prop_additionAssociative :: Int -> Int -> Int -> Bool +prop_additionAssociative a b c = (a + b) + c == a + (b + c) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/test/UtilTest.hs new/tasty-discover-3.0.2/test/UtilTest.hs --- old/tasty-discover-1.1.0/test/UtilTest.hs 2017-01-19 21:44:52.000000000 +0100 +++ new/tasty-discover-3.0.2/test/UtilTest.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,40 +0,0 @@ --- Unit tests for Test.Tasty.Util module. - -module UtilTest where - -import Test.Tasty.Discover (Assertion, (@?=), defaultConfig, getListOfTests, - findTests, fileToTest, getFilesRecursive, - isValidModuleChar, isValidModuleName, - Config(..), Test(..)) - -case_getListOfTests :: Assertion -case_getListOfTests = do - result <- getListOfTests "test/tmpdir/" defaultConfig - result @?= ["case_foo"] - -case_getListOfTestsWithSuffix :: Assertion -case_getListOfTestsWithSuffix = do - let config = Config (Just "DoesntExist") False [] - result <- getListOfTests "test/tmpdir/" config - result @?= [] - -case_findTests :: Assertion -case_findTests = do - result <- findTests "test/tmpdir/" defaultConfig - result @?= [Test {testFile="test/tmpdir/FooTest.hs", testModule="Foo"}] - -case_fileToTest :: Assertion -case_fileToTest = do - let result = fileToTest "test/tmpdir/" defaultConfig "FooTest.hs" - result @?= Just Test {testFile="test/tmpdir/FooTest.hs", testModule="Foo"} - -case_getFilesRecursive :: Assertion -case_getFilesRecursive = do - result <- getFilesRecursive "test/tmpdir/" - result @?= ["FooTest.hs", "README.md"] - -case_isValidModuleChar :: Assertion -case_isValidModuleChar = isValidModuleChar 'C' @?= True - -case_isValidModuleName :: Assertion -case_isValidModuleName = isValidModuleName "Jim" @?= True diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/test/tmpdir/FooTest.hs new/tasty-discover-3.0.2/test/tmpdir/FooTest.hs --- old/tasty-discover-1.1.0/test/tmpdir/FooTest.hs 2016-11-12 13:24:31.000000000 +0100 +++ new/tasty-discover-3.0.2/test/tmpdir/FooTest.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,3 +0,0 @@ -module FooTest where - -case_foo = undefined diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tasty-discover-1.1.0/test/tmpdir/README.md new/tasty-discover-3.0.2/test/tmpdir/README.md --- old/tasty-discover-1.1.0/test/tmpdir/README.md 2016-10-24 13:13:27.000000000 +0200 +++ new/tasty-discover-3.0.2/test/tmpdir/README.md 1970-01-01 01:00:00.000000000 +0100 @@ -1,3 +0,0 @@ -# tmpdir - -This folder is used for various unit tests in the parent folder.

1 0