simpleconfig 0.0.9 → 0.0.10

raw patch · 3 files changed

+119/−30 lines, 3 filesdep +eitherdep +hspecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: either, hspec

API changes (from Hackage documentation)

Files

• simpleconfig.cabal +12/−10
• src/Config/Simple.hs +75/−10
• test/Spec.hs +32/−10

@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.20.0.+-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack ----- hash: 1f3e3450009bfd77e7430ed520edd3aa0c946c5dd117d5f40be0ee518511d9b5+-- hash: 3985e307c00f6905bfb6d5a656f0c09031bd4c0a8d158c15cb73db132796ebaa  name:           simpleconfig-version:        0.0.9+version:        0.0.10 synopsis:       Short description of your package description:    Please see the README on Github at <https://github.com/koterpillar/simpleconfig#readme> category:       Web@@ -18,7 +18,6 @@ license-file:   LICENSE build-type:     Simple cabal-version:  >= 1.10- extra-source-files:     README.md @@ -27,31 +26,34 @@   location: https://github.com/koterpillar/simpleconfig  library+  exposed-modules:+      Config.Simple+  other-modules:+      Paths_simpleconfig   hs-source-dirs:       src   build-depends:       base >=4.7 && <5     , containers+    , either     , lens-  exposed-modules:-      Config.Simple-  other-modules:-      Paths_simpleconfig   default-language: Haskell2010  test-suite simpleconfig-test   type: exitcode-stdio-1.0   main-is: Spec.hs+  other-modules:+      Paths_simpleconfig   hs-source-dirs:       test   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:       base     , containers+    , either     , generic-deriving+    , hspec     , lens     , simpleconfig     , text-  other-modules:-      Paths_simpleconfig   default-language: Haskell2010

@@ -12,6 +12,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-}  module Config.Simple   ( ConfigBool@@ -20,14 +21,19 @@   , Partial   , Complete   , LensFor(..)+  , AccumFor(..)   , configLens+  , configLensPartial   , fromPartialConfig   ) where  import Control.Lens +import Data.Either.Validation import Data.Monoid (Any(..), Last(..)) import Data.Set (Set)+import qualified Data.Set as Set+import Data.String (IsString(..))  import GHC.Generics import qualified GHC.Generics as G@@ -39,25 +45,41 @@  data CComplete +data CAccum+ data CLensFor k c +type family ConfigLensTarget k where+  ConfigLensTarget CComplete = CComplete+  ConfigLensTarget CPartial = CAccum++type family ConfigLensFor k s a where+  ConfigLensFor CComplete s a = LensFor s a+  ConfigLensFor CPartial s a = AccumFor s a+ newtype LensFor s a =   LensFor (Lens' s a) +newtype AccumFor s a =+  AccumFor (a -> s -> s)+ type family ConfigLast a k where   ConfigLast a CPartial = Last a   ConfigLast a CComplete = a-  ConfigLast a (CLensFor k root) = LensFor root (ConfigLast a k)+  ConfigLast a CAccum = a+  ConfigLast a (CLensFor k root) = ConfigLensFor k root (ConfigLast a (ConfigLensTarget k))  type family ConfigBool k where   ConfigBool CPartial = Any   ConfigBool CComplete = Bool-  ConfigBool (CLensFor k root) = LensFor root (ConfigBool k)+  ConfigBool CAccum = Bool+  ConfigBool (CLensFor k root) = ConfigLensFor k root (ConfigBool (ConfigLensTarget k))  type family ConfigSet a k where   ConfigSet a CPartial = Set a   ConfigSet a CComplete = Set a-  ConfigSet a (CLensFor k root) = LensFor root (ConfigSet a k)+  ConfigSet a CAccum = a+  ConfigSet a (CLensFor k root) = ConfigLensFor k root (ConfigSet a (ConfigLensTarget k))  type Partial config = config CPartial @@ -69,29 +91,45 @@      ( Generic (Partial config)      , Generic (Complete config)      , GFromPartialConfig (Rep (Partial config)) (Rep (Complete config))+     , IsString text      )   => Partial config-  -> Maybe (Complete config)+  -> Validation [text] (Complete config) fromPartialConfig = fmap G.to . gFromPartialConfig . G.from  class GFromPartialConfig (repPartial :: * -> *) (repComplete :: * -> *) where-  gFromPartialConfig :: repPartial x -> Maybe (repComplete x)+  gFromPartialConfig :: IsString text => repPartial x -> Validation [text] (repComplete x)  instance GFromPartialConfig fp fc =>-         GFromPartialConfig (M1 i m fp) (M1 i m fc) where+         GFromPartialConfig (D1 m fp) (D1 m fc) where   gFromPartialConfig (M1 x) = M1 <$> gFromPartialConfig x +instance GFromPartialConfig fp fc =>+         GFromPartialConfig (C1 m fp) (C1 m fc) where+  gFromPartialConfig (M1 x) = M1 <$> gFromPartialConfig x+ instance (GFromPartialConfig ap ac, GFromPartialConfig bp bc) =>          GFromPartialConfig (ap :*: bp) (ac :*: bc) where   gFromPartialConfig (a :*: b) =     liftA2 (:*:) (gFromPartialConfig a) (gFromPartialConfig b) +instance (GFromPartialConfigMaybe fp fc, Selector m) =>+         GFromPartialConfig (S1 m fp) (S1 m fc) where+  gFromPartialConfig v@(M1 x) =+    fmap M1 $+    case gFromPartialConfigMaybe x of+      Just r -> Success r+      Nothing -> Failure [fromString $ selName v]++class GFromPartialConfigMaybe (repPartial :: * -> *) (repComplete :: * -> *) where+  gFromPartialConfigMaybe :: repPartial x -> Maybe (repComplete x)+ class GFromPartialConfigMember partial complete where   gFromPartialConfigMember :: partial -> Maybe complete  instance GFromPartialConfigMember partial complete =>-         GFromPartialConfig (Rec0 partial) (Rec0 complete) where-  gFromPartialConfig (K1 a) = K1 <$> gFromPartialConfigMember a+         GFromPartialConfigMaybe (Rec0 partial) (Rec0 complete) where+  gFromPartialConfigMaybe (K1 a) = K1 <$> gFromPartialConfigMember a  instance GFromPartialConfigMember Any Bool where   gFromPartialConfigMember = Just . getAny@@ -102,20 +140,38 @@ instance GFromPartialConfigMember (Last a) a where   gFromPartialConfigMember = getLast -configLens ::+configLens' ::      forall config k.      ( Generic (config k)      , Generic (LensConfig k config)      , GLensFor (config k) (Rep (config k)) (Rep (LensConfig k config))      )   => LensConfig k config-configLens = G.to $ gToLensFor rootLens+configLens' = G.to $ gToLensFor rootLens   where     rootLens ::          forall x. Generic (config k)       => Lens' (config k) (Rep (config k) x)     rootLens = G.generic +configLens ::+     forall config.+     ( Generic (config CComplete)+     , Generic (LensConfig CComplete config)+     , GLensFor (config CComplete) (Rep (config CComplete)) (Rep (LensConfig CComplete config))+     )+  => LensConfig CComplete config+configLens = configLens'++configLensPartial ::+     forall config.+     ( Generic (config CPartial)+     , Generic (LensConfig CPartial config)+     , GLensFor (config CPartial) (Rep (config CPartial)) (Rep (LensConfig CPartial config))+     )+  => LensConfig CPartial config+configLensPartial = configLens'+ class GLensFor root rep repLens where   gToLensFor :: Lens' root (rep x) -> repLens x @@ -129,3 +185,12 @@  instance GLensFor root (Rec0 x) (Rec0 (LensFor root x)) where   gToLensFor rootLens = K1 $ LensFor $ rootLens . G._K1++instance GLensFor root (Rec0 (Last x)) (Rec0 (AccumFor root x)) where+  gToLensFor rootLens = K1 $ AccumFor $ \v s -> s & rootLens . G._K1 <>~ Last (Just v)++instance GLensFor root (Rec0 Any) (Rec0 (AccumFor root Bool)) where+  gToLensFor rootLens = K1 $ AccumFor $ \v s -> s & rootLens . G._K1 <>~ Any v++instance Ord a => GLensFor root (Rec0 (Set a)) (Rec0 (AccumFor root a)) where+  gToLensFor rootLens = K1 $ AccumFor $ \v s -> s & rootLens . G._K1 <>~ Set.singleton v

@@ -11,7 +11,9 @@ import Control.Lens import Control.Monad +import Data.Either.Validation import Data.Foldable+import Data.Maybe import Data.Monoid (Last(..)) import Data.Set (Set) import qualified Data.Set as Set@@ -23,6 +25,8 @@  import GHC.Generics +import Test.Hspec+ import Config.Simple  data ConfigF k = Config@@ -49,14 +53,32 @@  Config (LensFor address) (LensFor dryRun) (LensFor widgets) = configLens +Config (AccumFor address') (AccumFor dryRun') (AccumFor widgets') =+  configLensPartial++isSuccess :: Validation e a -> Bool+isSuccess (Success _) = True+isSuccess (Failure _) = False+ main :: IO ()-main = do-  let config' =-        mempty & (address <>~ pure "Silverpond") & (dryRun <>~ Any True) &-        (widgets <>~ Set.singleton "blah") &-        (address <>~ pure "SEEK")-  print config'-  let (Just config) = fromPartialConfig config'-  Text.putStrLn $ "Address = " <> config ^. address-  when (config ^. dryRun) $ Text.putStrLn "Dry run"-  for_ (config ^. widgets) $ \widget -> Text.putStrLn $ "Widget = " <> widget+main =+  hspec $+  describe "fromPartialConfig" $ do+    context "with a complete config" $ do+      let config' =+            mempty & address' "Silverpond" & dryRun' True & widgets' "blah" &+            address' "SEEK"+      let result = fromPartialConfig config'+      it "should succeed" $ result `shouldSatisfy` isSuccess+      let (Success config) = fromPartialConfig config'+      it "should override Last members with later assignments" $+        config ^. address `shouldBe` "SEEK"+      it "should turn on Any members" $ config ^. dryRun `shouldBe` True+      it "should record set members" $+        config ^. widgets `shouldBe` Set.fromList ["blah"]+    context "with incomplete config" $ do+      let config' = mempty & dryRun' True+      let result = fromPartialConfig config'+      it "should return a failure" $ result `shouldNotSatisfy` isSuccess+      let (Failure fields) = fromPartialConfig config'+      it "should return missing fields" $ fields `shouldBe` ["_address"]