machines 0.6.2 → 0.6.3
raw patch · 10 files changed
+61/−177 lines, 10 filesdep +faildep ~basedep ~conduitdep ~conduit-combinatorssetup-changedPVP ok
version bump matches the API change (PVP)
Dependencies added: fail
Dependency ranges changed: base, conduit, conduit-combinators, criterion, distributive, doctest
API changes (from Hackage documentation)
+ Data.Machine.Is: instance a ~ b => Data.Semigroup.Semigroup (Data.Machine.Is.Is a b)
+ Data.Machine.Plan: instance Control.Monad.Fail.MonadFail (Data.Machine.Plan.PlanT k o m)
Files
- .travis.yml +5/−5
- CHANGELOG.markdown +6/−0
- Setup.lhs +14/−162
- Warning.hs +5/−0
- machines.cabal +12/−3
- src/Data/Machine/Is.hs +6/−2
- src/Data/Machine/Mealy.hs +2/−2
- src/Data/Machine/MealyT.hs +4/−0
- src/Data/Machine/Moore.hs +2/−2
- src/Data/Machine/Plan.hs +5/−1
.travis.yml view
@@ -28,15 +28,15 @@ - env: CABALVER=1.24 GHCVER=8.0.2 compiler: ": #GHC 8.0.2" addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2], sources: [hvr-ghc]}}- - env: CABALVER=1.24 GHCVER=8.2.1+ - env: CABALVER=2.0 GHCVER=8.2.1 compiler: ": #GHC 8.2.1"- addons: {apt: {packages: [cabal-install-1.24,ghc-8.2.1], sources: [hvr-ghc]}}- - env: CABALVER=1.24 GHCVER=head+ addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.1], sources: [hvr-ghc]}}+ - env: CABALVER=head GHCVER=head compiler: ": #GHC head"- addons: {apt: {packages: [cabal-install-1.24,ghc-head], sources: [hvr-ghc]}}+ addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} allow_failures:- - env: CABALVER=1.24 GHCVER=head+ - env: CABALVER=head GHCVER=head before_install: - unset CC
CHANGELOG.markdown view
@@ -1,3 +1,9 @@+0.6.3+-----+* Add `Semigroup` instance for `Is`+* Add `MonadFail` instance for `PlanT`+* Support `doctest-0.12`+ 0.6.2 ----- * Revamp `Setup.hs` to use `cabal-doctest`. This makes it build
Setup.lhs view
@@ -1,182 +1,34 @@ \begin{code} {-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-} module Main (main) where #ifndef MIN_VERSION_cabal_doctest #define MIN_VERSION_cabal_doctest(x,y,z) 0 #endif - #if MIN_VERSION_cabal_doctest(1,0,0)-import Distribution.Extra.Doctest ( defaultMainWithDoctests )-#else --- Otherwise we provide a shim--#ifndef MIN_VERSION_Cabal-#define MIN_VERSION_Cabal(x,y,z) 0-#endif-#ifndef MIN_VERSION_directory-#define MIN_VERSION_directory(x,y,z) 0-#endif-#if MIN_VERSION_Cabal(1,24,0)-#define InstalledPackageId UnitId-#endif--import Control.Monad ( when )-import Data.List ( nub )-import Data.String ( fromString )-import Distribution.Package ( InstalledPackageId )-import Distribution.Package ( PackageId, Package (..), packageVersion )-import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..))-import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )-import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )-import Distribution.Simple.BuildPaths ( autogenModulesDir )-import Distribution.Simple.Setup ( BuildFlags(buildDistPref, buildVerbosity), fromFlag)-import Distribution.Simple.LocalBuildInfo ( withPackageDB, withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler )-import Distribution.Simple.Compiler ( showCompilerId , PackageDB (..))-import Distribution.Text ( display , simpleParse )-import System.FilePath ( (</>) )--#if MIN_VERSION_Cabal(1,25,0)-import Distribution.Simple.BuildPaths ( autogenComponentModulesDir )-#endif+import Distribution.Extra.Doctest ( defaultMainWithDoctests )+main :: IO ()+main = defaultMainWithDoctests "doctests" -#if MIN_VERSION_directory(1,2,2)-import System.Directory (makeAbsolute) #else-import System.Directory (getCurrentDirectory)-import System.FilePath (isAbsolute) -makeAbsolute :: FilePath -> IO FilePath-makeAbsolute p | isAbsolute p = return p- | otherwise = do- cwd <- getCurrentDirectory- return $ cwd </> p-#endif--generateBuildModule :: String -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()-generateBuildModule testsuiteName flags pkg lbi = do- let verbosity = fromFlag (buildVerbosity flags)- let distPref = fromFlag (buildDistPref flags)-- -- Package DBs- let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref </> "package.conf.inplace" ]- let dbFlags = "-hide-all-packages" : packageDbArgs dbStack-- withLibLBI pkg lbi $ \lib libcfg -> do- let libBI = libBuildInfo lib-- -- modules- let modules = exposedModules lib ++ otherModules libBI- -- it seems that doctest is happy to take in module names, not actual files!- let module_sources = modules-- -- We need the directory with library's cabal_macros.h!-#if MIN_VERSION_Cabal(1,25,0)- let libAutogenDir = autogenComponentModulesDir lbi libcfg-#else- let libAutogenDir = autogenModulesDir lbi+#ifdef MIN_VERSION_Cabal+-- If the macro is defined, we have new cabal-install,+-- but for some reason we don't have cabal-doctest in package-db+--+-- Probably we are running cabal sdist, when otherwise using new-build+-- workflow+import Warning () #endif - -- Lib sources and includes- iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ libAutogenDir : hsSourceDirs libBI- includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs libBI-- -- CPP includes, i.e. include cabal_macros.h- let cppFlags = map ("-optP"++) $- [ "-include", libAutogenDir ++ "/cabal_macros.h" ]- ++ cppOptions libBI-- withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testsuiteName) $ do-- -- get and create autogen dir-#if MIN_VERSION_Cabal(1,25,0)- let testAutogenDir = autogenComponentModulesDir lbi suitecfg-#else- let testAutogenDir = autogenModulesDir lbi-#endif- createDirectoryIfMissingVerbose verbosity True testAutogenDir-- -- write autogen'd file- rewriteFile (testAutogenDir </> "Build_doctests.hs") $ unlines- [ "module Build_doctests where"- , ""- -- -package-id etc. flags- , "pkgs :: [String]"- , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg)- , ""- , "flags :: [String]"- , "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags)- , ""- , "module_sources :: [String]"- , "module_sources = " ++ show (map display module_sources)- ]- where- -- we do this check in Setup, as then doctests don't need to depend on Cabal- isOldCompiler = maybe False id $ do- a <- simpleParse $ showCompilerId $ compiler lbi- b <- simpleParse "7.5"- return $ packageVersion (a :: PackageId) < b-- formatDeps = map formatOne- formatOne (installedPkgId, pkgId)- -- The problem is how different cabal executables handle package databases- -- when doctests depend on the library- | packageId pkg == pkgId = "-package=" ++ display pkgId- | otherwise = "-package-id=" ++ display installedPkgId-- -- From Distribution.Simple.Program.GHC- packageDbArgs :: [PackageDB] -> [String]- packageDbArgs | isOldCompiler = packageDbArgsConf- | otherwise = packageDbArgsDb-- -- GHC <7.6 uses '-package-conf' instead of '-package-db'.- packageDbArgsConf :: [PackageDB] -> [String]- packageDbArgsConf dbstack = case dbstack of- (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs- (GlobalPackageDB:dbs) -> ("-no-user-package-conf")- : concatMap specific dbs- _ -> ierror- where- specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ]- specific _ = ierror- ierror = error $ "internal error: unexpected package db stack: "- ++ show dbstack-- -- GHC >= 7.6 uses the '-package-db' flag. See- -- https://ghc.haskell.org/trac/ghc/ticket/5977.- packageDbArgsDb :: [PackageDB] -> [String]- -- special cases to make arguments prettier in common scenarios- packageDbArgsDb dbstack = case dbstack of- (GlobalPackageDB:UserPackageDB:dbs)- | all isSpecific dbs -> concatMap single dbs- (GlobalPackageDB:dbs)- | all isSpecific dbs -> "-no-user-package-db"- : concatMap single dbs- dbs -> "-clear-package-db"- : concatMap single dbs- where- single (SpecificPackageDB db) = [ "-package-db=" ++ db ]- single GlobalPackageDB = [ "-global-package-db" ]- single UserPackageDB = [ "-user-package-db" ]- isSpecific (SpecificPackageDB _) = True- isSpecific _ = False--testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]-testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys+import Distribution.Simple -defaultMainWithDoctests :: String -> IO ()-defaultMainWithDoctests testSuiteName = defaultMainWithHooks simpleUserHooks- { buildHook = \pkg lbi hooks flags -> do- generateBuildModule testSuiteName flags pkg lbi- buildHook simpleUserHooks pkg lbi hooks flags- }+main :: IO ()+main = defaultMain #endif--main :: IO ()-main = defaultMainWithDoctests "doctests" \end{code}
+ Warning.hs view
@@ -0,0 +1,5 @@+module Warning+ {-# WARNING ["You are configuring this package without cabal-doctest installed.",+ "The doctests test-suite will not work as a result.",+ "To fix this, install cabal-doctest before configuring."] #-}+ () where
machines.cabal view
@@ -1,6 +1,6 @@ name: machines category: Control, Enumerator-version: 0.6.2+version: 0.6.3 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE@@ -25,6 +25,7 @@ config README.markdown CHANGELOG.markdown+ Warning.hs examples/LICENSE examples/machines-examples.cabal examples/*.hs@@ -83,6 +84,13 @@ UndecidableInstances ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields++ -- See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0#base-4.9.0.0+ if impl(ghc >= 8.0)+ ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances+ else+ build-depends: fail == 4.9.*+ hs-source-dirs: src -- Verify the results of the examples@@ -92,7 +100,8 @@ default-language: Haskell2010 build-depends: base == 4.*,- doctest >= 0.11.1 && < 0.12+ doctest >= 0.11.1 && < 0.13,+ machines ghc-options: -Wall -threaded hs-source-dirs: tests @@ -107,7 +116,7 @@ base == 4.*, conduit >= 1.0 && < 1.3, conduit-combinators >= 0.2.5 && < 1.2,- criterion >= 0.6 && < 1.2,+ criterion >= 0.6 && < 1.3, machines, mtl >= 2 && < 2.3, pipes >= 4 && < 4.4
src/Data/Machine/Is.hs view
@@ -15,7 +15,7 @@ ) where import Control.Category-import Data.Monoid+import Data.Semigroup import Prelude -- | Witnessed type equality@@ -33,10 +33,14 @@ Refl `compare` Refl = EQ {-# INLINE compare #-} +instance (a ~ b) => Semigroup (Is a b) where+ Refl <> Refl = Refl+ {-# INLINE (<>) #-}+ instance (a ~ b) => Monoid (Is a b) where mempty = Refl {-# INLINE mempty #-}- mappend Refl Refl = Refl+ mappend = (<>) {-# INLINE mappend #-} instance (a ~ b) => Read (Is a b) where
src/Data/Machine/Mealy.hs view
@@ -95,12 +95,12 @@ -- | slow diagonalization instance Monad (Mealy a) where- return b = r where r = Mealy (const (b, r))+ return = pure {-# INLINE return #-} m >>= f = Mealy $ \a -> case runMealy m a of (b, m') -> (fst (runMealy (f b) a), m' >>= f) {-# INLINE (>>=) #-}- _ >> n = n+ (>>) = (*>) {-# INLINE (>>) #-} instance Profunctor Mealy where
src/Data/Machine/MealyT.hs view
@@ -49,8 +49,12 @@ MealyT m <*> MealyT n = MealyT $ \a -> (\(mb, mm) (nb, nm) -> (mb nb, mm <*> nm)) <$> m a <*> n a instance Monad m => Monad (MealyT m a) where+#if !MIN_VERSION_base(4,8,0)+ -- pre-AMP {-# INLINE return #-} return b = r where r = MealyT (const (return (b, r))) -- Stolen from Pointed+#endif+ MealyT g >>= f = MealyT $ \a -> do (b, MealyT _h) <- g a runMealyT (f b) a
src/Data/Machine/Moore.hs view
@@ -98,11 +98,11 @@ -- | slow diagonalization instance Monad (Moore a) where- return a = r where r = Moore a (const r)+ return = pure {-# INLINE return #-} k >>= f = j (fmap f k) where j (Moore a g) = Moore (extract a) (\x -> j $ fmap (\(Moore _ h) -> h x) (g x))- _ >> m = m+ (>>) = (*>) instance Copointed (Moore a) where copoint (Moore b _) = b
src/Data/Machine/Plan.hs view
@@ -39,6 +39,7 @@ import Control.Monad.State.Class import Control.Monad.Reader.Class import Control.Monad.Error.Class+import qualified Control.Monad.Fail as Fail import Control.Monad.Writer.Class import Data.Functor.Identity import Prelude hiding ((.),id)@@ -114,10 +115,13 @@ return = pure {-# INLINE return #-} PlanT m >>= f = PlanT (\kp ke kr kf -> m (\a -> runPlanT (f a) kp ke kr kf) ke kr kf)+ {-# INLINE (>>=) #-} (>>) = (*>) {-# INLINE (>>) #-}+ fail = Fail.fail++instance Fail.MonadFail (PlanT k o m) where fail _ = PlanT (\_ _ _ kf -> kf)- {-# INLINE (>>=) #-} instance MonadPlus (PlanT k o m) where mzero = empty