flexible-defaults 0.0.1.2 → 0.0.2
raw patch · 7 files changed
+50/−36 lines, 7 filesdep +semigroupsdep ~basesetup-changednew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: semigroups
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- Setup.lhs +0/−1
- examples/Class.hs +9/−9
- examples/Instances.hs +1/−1
- flexible-defaults.cabal +9/−7
- src/Language/Haskell/TH/FlexibleDefaults.hs +14/−12
- src/Language/Haskell/TH/FlexibleDefaults/DSL.hs +10/−3
- src/Language/Haskell/TH/FlexibleDefaults/Solve.hs +7/−3
Setup.lhs view
@@ -2,4 +2,3 @@ > import Distribution.Simple > main = defaultMain-
examples/Class.hs view
@@ -16,16 +16,16 @@ class DefaultsTest a where foo :: a -> String foo = error "foo not implemented"- + bar :: a -> Int bar = error "bar not implemented"- + baz :: a -> a -> a baz = error "baz not implemented"- + qux :: a -> Integer qux = error "qux not implemented"- + quux :: a -> Bool quux = error "quux not implemented" @@ -35,27 +35,27 @@ implementation $ do cost 1 return [d| foo = filter isDigit . show |]- + function "bar" $ do implementation $ do dependsOn "qux" return [d| bar = fromInteger . qux |]- + function "baz" $ do implementation $ do score 1 dependsOn "quux" return [d| baz x | quux x = const x- | otherwise = id + | otherwise = id |] implementation $ do return [d| baz = const |]- + function "qux" $ do implementation $ do dependsOn "foo" return [d| qux = read . foo |]- + function "quux" $ do implementation $ do cost 1
examples/Instances.hs view
@@ -43,7 +43,7 @@ instance DefaultsTest Bool where foo True = "0" foo False = "1"- + baz = (||) |] )
flexible-defaults.cabal view
@@ -1,14 +1,14 @@ name: flexible-defaults-version: 0.0.1.2+version: 0.0.2 stability: provisional cabal-version: >= 1.6 build-type: Simple author: James Cook <mokus@deepbondi.net>-maintainer: James Cook <mokus@deepbondi.net>+maintainer: Peter Simons <simons@cryp.to> license: PublicDomain-homepage: https://github.com/mokus0/flexible-defaults+homepage: https://github.com/peti/flexible-defaults category: Code Generation, Template Haskell synopsis: Generate default function implementations for complex type classes.@@ -30,13 +30,13 @@ extra-source-files: examples/*.hs -tested-with: GHC == 7.0.4, GHC == 7.2.1, GHC == 7.2.2,- GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4,- GHC == 7.10.3, GHC == 8.0.1, GHC == 8.1+tested-with: GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.2, GHC == 7.6.3,+ GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2,+ GHC == 8.4.3 source-repository head type: git- location: https://github.com/mokus0/flexible-defaults.git+ location: https://github.com/peti/flexible-defaults.git Library hs-source-dirs: src@@ -49,3 +49,5 @@ template-haskell, th-extras, transformers+ if !impl(ghc >= 8.0)+ build-depends: semigroups == 0.18.*
src/Language/Haskell/TH/FlexibleDefaults.hs view
@@ -1,7 +1,7 @@ -- |A code-generation system for complex typeclass default-implementation--- configurations. There are usage examples in this package's source +-- configurations. There are usage examples in this package's source -- distribution[1] and in the random-source package[2].--- +-- -- 1. <https://github.com/mokus0/flexible-defaults/tree/master/examples> -- -- 2. <https://github.com/mokus0/random-fu/blob/master/random-source/src/Data/Random/Internal/TH.hs>@@ -19,14 +19,17 @@ , dependsOn , inline , noinline- + , withDefaults , implementDefaults ) where import Data.List-import Data.Monoid import Data.Ord+#if !(MIN_VERSION_base(4,8,0))+-- starting with base-4.8, Monoid is rexported from Prelude+import Data.Monoid+#endif import qualified Data.Map as M import qualified Data.Set as S import Language.Haskell.TH@@ -43,18 +46,18 @@ implementDefaults defs futzedDecs = do let decs = genericalizeDecs futzedDecs prob = toProblem defs- + implemented = S.fromList (map nameBase (concatMap namesBoundInDec decs)) unimplemented = deleteKeys implemented prob- + solutions = chooseImplementations unimplemented- + implementations <- case solutions of [] -> fail "implementDefaults: incomplete set of basis functions"- ss -> + ss -> let best = maximumBy (comparing scoreSolution) ss in sequence [ decQ | ImplSpec _ _ decQ <- M.elems best]- + return (decs ++ concat implementations) -- TODO: maybe make this accept multiple instance declarations, and/or pass non-instance Dec's unmodified.@@ -69,7 +72,7 @@ withDefaults :: (Monoid s, Ord s) => Defaults s () -> Q [Dec] -> Q [Dec] withDefaults defs decQ = do dec <- decQ- + case dec of #if MIN_VERSION_template_haskell(2,11,0) [InstanceD ol clsCxt cls decs] -> do@@ -80,6 +83,5 @@ impl <- implementDefaults defs decs return [InstanceD clsCxt cls impl] #endif- - _ -> fail "withDefaults: second parameter should be a single instance declaration" + _ -> fail "withDefaults: second parameter should be a single instance declaration"
src/Language/Haskell/TH/FlexibleDefaults/DSL.hs view
@@ -1,12 +1,16 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, CPP #-}+ module Language.Haskell.TH.FlexibleDefaults.DSL where +#if !(MIN_VERSION_base(4,8,0))+-- starting with base-4.8, Applicative is rexported from Prelude import Control.Applicative+#endif import Control.Monad.Trans.Reader import Control.Monad.Trans.State import Control.Monad.Trans.Writer import Data.List-import Data.Monoid+import Data.Semigroup as Semigroup import qualified Data.Map as M import Data.Ord import qualified Data.Set as S@@ -21,10 +25,13 @@ instance Functor Impls where fmap f (Impls m) = Impls (M.map (map (fmap f)) m) +instance Semigroup.Semigroup (Impls s) where+ (<>) (Impls x) (Impls y) = Impls (M.unionWith mappend x y)+ instance Monoid (Impls s) where mempty = Impls mempty- mappend (Impls x) (Impls y) = Impls (M.unionWith mappend x y)- + mappend = (Semigroup.<>)+ -- |A description of a system of 'Function's and default 'Implementation's -- which can be used to complete a partial implementation of some type class. newtype Defaults s a = Defaults { unDefaults :: Writer (Impls s) a }
src/Language/Haskell/TH/FlexibleDefaults/Solve.hs view
@@ -1,4 +1,6 @@-module Language.Haskell.TH.FlexibleDefaults.Solve +{-# LANGUAGE CPP #-}++module Language.Haskell.TH.FlexibleDefaults.Solve ( ImplSpec(..) , scoreImplSpec , Problem@@ -10,10 +12,13 @@ import Prelude hiding (all) import Data.Foldable (all) import Data.Maybe-import Data.Monoid import qualified Data.Map as M import qualified Data.Set as S import Language.Haskell.TH+#if !(MIN_VERSION_base(4,8,0))+-- starting with base-4.8, Monoid is rexported from Prelude+import Data.Monoid+#endif data ImplSpec s = ImplSpec { implScore :: Maybe s@@ -51,4 +56,3 @@ impl <- take 1 (filter (all implemented . dependencies) impls) otherImpls <- chooseImplementations newUnimplemented return (M.insert name impl otherImpls)-