simpleconfig (empty) → 0.0.1
raw patch · 6 files changed
+331/−0 lines, 6 filesdep +basedep +containersdep +generic-derivingsetup-changed
Dependencies added: base, containers, generic-deriving, lens, simpleconfig, text
Files
- LICENSE +30/−0
- README.md +7/−0
- Setup.hs +2/−0
- simpleconfig.cabal +57/−0
- src/Config/Simple.hs +171/−0
- test/Spec.hs +64/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Alexey Kotlyarov (c) 2017++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 of Alexey Kotlyarov nor the names of other+ 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 AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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.
+ README.md view
@@ -0,0 +1,7 @@+# simpleconfig++### Releasing++* Install [bumpversion](https://github.com/peritus/bumpversion): `pip install bumpversion`.+* Run `bumpversion major|minor|patch`.+* Run `git push --tags`.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ simpleconfig.cabal view
@@ -0,0 +1,57 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: d5a310c8f0c4aa16e1b8046c54841213c3110fb60919b3737484fbeb7c5cac12++name: simpleconfig+version: 0.0.1+synopsis: Short description of your package+homepage: https://github.com/koterpillar/simpleconfig#readme+bug-reports: https://github.com/koterpillar/simpleconfig/issues+license: BSD3+license-file: LICENSE+author: Alexey Kotlyarov+maintainer: a@koterpillar.com+copyright: 2017 Alexey Kotlyarov+category: Web+build-type: Simple+cabal-version: >= 1.10+description: Please see the README on Github at <https://github.com/koterpillar/simpleconfig#readme>++extra-source-files:+ README.md++source-repository head+ type: git+ location: https://github.com/koterpillar/simpleconfig++library+ hs-source-dirs:+ src+ exposed-modules:+ Config.Simple+ other-modules:+ Paths_simpleconfig+ build-depends:+ base >=4.7 && <5+ , containers+ , lens+ default-language: Haskell2010++test-suite simpleconfig-test+ type: exitcode-stdio-1.0+ hs-source-dirs:+ test+ main-is: Spec.hs+ build-depends:+ base+ , containers+ , generic-deriving+ , lens+ , simpleconfig+ , text+ other-modules:+ Paths_simpleconfig+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010
+ src/Config/Simple.hs view
@@ -0,0 +1,171 @@+{-|+Module: Config.Simple+Description: Simple configuration data types++Functions for declaring a configuration data type.+-}++{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Config.Simple+ ( ConfigBool+ , ConfigLast+ , ConfigSet+ , Partial+ , Complete+ , LensFor(..)+ , configLens+ , configLensPartial+ , fromPartialConfig+ ) where++import Control.Lens++import Data.Monoid (Any(..), Last(..))+import Data.Set (Set)++import GHC.Generics+import qualified GHC.Generics as G+import qualified GHC.Generics.Lens as G++import Control.Applicative++data CPartial++data CComplete++data CLensFor k c++newtype LensFor s a =+ LensFor (Lens' s a)++type family ConfigLast a k where+ ConfigLast a CPartial = Last a+ ConfigLast a CComplete = a+ ConfigLast a (CLensFor CPartial root) = LensFor root (Maybe a)+ ConfigLast a (CLensFor CComplete root) = LensFor root a++type family ConfigBool k where+ ConfigBool CPartial = Any+ ConfigBool CComplete = Bool+ ConfigBool (CLensFor CPartial root) = LensFor root Bool+ ConfigBool (CLensFor CComplete root) = LensFor root Bool++type family ConfigSet a k where+ ConfigSet a CPartial = Set a+ ConfigSet a CComplete = Set a+ ConfigSet a (CLensFor CPartial root) = LensFor root (Set a)+ ConfigSet a (CLensFor CComplete root) = LensFor root (Set a)++type Partial config = config CPartial++type Complete config = config CComplete++type LensConfig k config = config (CLensFor k (config k))++fromPartialConfig ::+ ( Generic (Partial config)+ , Generic (Complete config)+ , GFromPartialConfig (Rep (Partial config)) (Rep (Complete config))+ )+ => Partial config+ -> Maybe (Complete config)+fromPartialConfig = fmap G.to . gFromPartialConfig . G.from++class GFromPartialConfig (repPartial :: * -> *) (repComplete :: * -> *) where+ gFromPartialConfig :: repPartial x -> Maybe (repComplete x)++instance GFromPartialConfig fp fc =>+ GFromPartialConfig (M1 i m fp) (M1 i 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)++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++instance GFromPartialConfigMember Any Bool where+ gFromPartialConfigMember = Just . getAny++instance GFromPartialConfigMember (Set a) (Set a) where+ gFromPartialConfigMember = Just++instance GFromPartialConfigMember (Last a) a where+ gFromPartialConfigMember = getLast++configLens' ::+ forall config k proxy.+ ( Generic (config k)+ , Generic (LensConfig k config)+ , GLensFor k (config k) (Rep (config k)) (Rep (LensConfig k config))+ )+ => proxy k+ -> LensConfig k config+configLens' pk = G.to $ gToLensFor pk rootLens+ where+ rootLens ::+ forall x. Generic (config k)+ => Lens' (config k) (Rep (config k) x)+ rootLens = G.generic++configLensPartial ::+ forall config proxy.+ ( Generic (config CPartial)+ , Generic (LensConfig CPartial config)+ , GLensFor CPartial (config CPartial) (Rep (config CPartial)) (Rep (LensConfig CPartial config))+ )+ => LensConfig CPartial config+configLensPartial = configLens' (Nothing :: Maybe CPartial)++configLens ::+ forall config proxy.+ ( Generic (config CComplete)+ , Generic (LensConfig CComplete config)+ , GLensFor CComplete (config CComplete) (Rep (config CComplete)) (Rep (LensConfig CComplete config))+ )+ => LensConfig CComplete config+configLens = configLens' (Nothing :: Maybe CComplete)++class GLensFor k root rep repLens where+ gToLensFor :: proxy k -> Lens' root (rep x) -> repLens x++instance GLensFor k root r rl => GLensFor k root (M1 i m r) (M1 i m rl) where+ gToLensFor pk rootLens = M1 $ gToLensFor pk (rootLens . G._M1)++instance (GLensFor k root ra ral, GLensFor k root rb rbl) =>+ GLensFor k root (ra :*: rb) (ral :*: rbl) where+ gToLensFor pk rootLens =+ gToLensFor pk (rootLens . _1) :*: gToLensFor pk (rootLens . _2)++instance GLensForMember k x y =>+ GLensFor k root (Rec0 x) (Rec0 (LensFor root y)) where+ gToLensFor pk rootLens = K1 $ LensFor $ rootLens . G._K1 . gLensLeaf pk++class GLensForMember k x y where+ gLensLeaf :: proxy k -> Lens' x y++instance GLensForMember CPartial (Last a) (Maybe a) where+ gLensLeaf _ = iso getLast Last++instance GLensForMember CPartial Any Bool where+ gLensLeaf _ = iso getAny Any++instance GLensForMember CPartial (Set a) (Set a) where+ gLensLeaf _ = id++instance GLensForMember CComplete a a where+ gLensLeaf _ = id
+ test/Spec.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeSynonymInstances #-}++import Control.Lens+import Control.Monad++import Data.Set (Set)+import qualified Data.Set as Set+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+import Data.Foldable++import Generics.Deriving.Monoid++import GHC.Generics++import Config.Simple++data ConfigF k = Config+ { _address :: ConfigLast Text k+ , _dryRun :: ConfigBool k+ , _widgets :: ConfigSet Text k+ } deriving (Generic)++type PartialConfig = Partial ConfigF++deriving instance Eq PartialConfig++deriving instance Show PartialConfig++instance Monoid PartialConfig where+ mempty = memptydefault+ mappend = mappenddefault++Config (LensFor address') (LensFor dryRun') (LensFor widgets') =+ configLensPartial++type Config = Complete ConfigF++deriving instance Eq Config++deriving instance Show Config++Config (LensFor address) (LensFor dryRun) (LensFor widgets) = configLens++main :: IO ()+main = do+ let config' =+ mempty & address' <>~ pure "Silverpond" & dryRun' .~ True & widgets' <>~+ Set.singleton "blah"+ 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