packages feed

lens-utils 1.2 → 1.4.2

raw patch · 7 files changed

+195/−55 lines, 7 filesdep +aesondep +containersdep +data-defaultdep ~basedep ~lens

Dependencies added: aeson, containers, data-default, monoid, template-haskell

Dependency ranges changed: base, lens

Files

lens-utils.cabal view
@@ -1,33 +1,43 @@-name: lens-utils-version: 1.2-cabal-version: >=1.10-build-type: Simple-license: Apache-2.0-license-file: LICENSE-copyright: Copyright (C) 2015 Wojciech Danilo-maintainer: Wojciech Danilo <wojciech.danilo@gmail.com>-stability: stable-homepage: https://github.com/wdanilo/lens-utils-bug-reports: https://github.com/wdanilo/lens-utils/issues-synopsis: Collection of missing lens utilities.-category: Text-author: Wojciech Danilo+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 6b0a6fa8e9f8498288aa0e25318be82b6fca0619f852c1d3bd024b814cca8af9 -library-    exposed-modules:-        Control.Lens.Utils-        Control.Lens.Wrapped.Utils-    build-depends:-        base >=4.6 && <4.9,-        lens >=4.13-    default-language: Haskell2010-    default-extensions: ConstraintKinds DataKinds DefaultSignatures-                        DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric-                        DeriveTraversable DoAndIfThenElse EmptyDataDecls FlexibleContexts-                        FlexibleInstances GeneralizedNewtypeDeriving InstanceSigs-                        LambdaCase MultiParamTypeClasses OverloadedStrings-                        StandaloneDeriving TemplateHaskell TupleSections TypeOperators-                        ViewPatterns TypeFamilies-    hs-source-dirs: src-    ghc-options: -Wall -O2+name:           lens-utils+version:        1.4.2+synopsis:       Collection of missing lens utilities.+category:       Data+stability:      experimental+homepage:       https://github.com/luna/lens-utils+bug-reports:    https://github.com/luna/lens-utils/issues+author:         Luna Team+maintainer:     Wojciech Danilo <wojciech.danilo@luna-lang.org>+copyright:      Copyright (C) 2018 Luna Team+license:        Apache-2.0+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10 +library+  hs-source-dirs:+      src+  default-extensions: AllowAmbiguousTypes ApplicativeDo BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse DuplicateRecordFields EmptyDataDecls FlexibleContexts FlexibleInstances FunctionalDependencies GeneralizedNewtypeDeriving InstanceSigs LambdaCase MonadComprehensions MultiWayIf NamedWildCards NegativeLiterals NumDecimals OverloadedLabels PackageImports QuasiQuotes PatternSynonyms RankNTypes RecursiveDo ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeFamilyDependencies TypeOperators UnicodeSyntax ViewPatterns LiberalTypeSynonyms RelaxedPolyRec+  ghc-options: -Wall -O2+  build-depends:+      aeson+    , base >=4.10 && <4.12+    , containers+    , data-default+    , lens+    , monoid+    , template-haskell+  exposed-modules:+      Control.Lens.Aeson+      Control.Lens.Utils+      Control.Lens.Utils.Nested+      Control.Lens.Utils.TH+      Control.Lens.Utils.Wrapped+  other-modules:+      Paths_lens_utils+  default-language: Haskell2010
+ src/Control/Lens/Aeson.hs view
@@ -0,0 +1,31 @@+module Control.Lens.Aeson where++import qualified Data.Aeson          as JSON+import qualified Data.Aeson.Types    as JSON+import qualified Data.Aeson.Encoding as JSON++import qualified Data.List as List+import GHC.Generics (Generic, Rep)+++------------------------------------------+-- === JSON / Yaml conversion utils === --+------------------------------------------++options, optionsDropUnary :: JSON.Options+options          = JSON.defaultOptions { JSON.fieldLabelModifier = List.dropWhile (== '_')}+optionsDropUnary = options { JSON.unwrapUnaryRecords = True }++parse      :: (Generic a, JSON.GFromJSON   JSON.Zero (Rep a)) => JSON.Value -> JSON.Parser a+toEncoding :: (Generic a, JSON.GToEncoding JSON.Zero (Rep a)) => a -> JSON.Encoding+toJSON     :: (Generic a, JSON.GToJSON     JSON.Zero (Rep a)) => a -> JSON.Value+parse      = JSON.genericParseJSON  options+toEncoding = JSON.genericToEncoding options+toJSON     = JSON.genericToJSON     options++parseDropUnary      :: (Generic a, JSON.GFromJSON   JSON.Zero (Rep a)) => JSON.Value -> JSON.Parser a+toEncodingDropUnary :: (Generic a, JSON.GToEncoding JSON.Zero (Rep a)) => a -> JSON.Encoding+toJSONDropUnary     :: (Generic a, JSON.GToJSON     JSON.Zero (Rep a)) => a -> JSON.Value+parseDropUnary      = JSON.genericParseJSON  optionsDropUnary+toEncodingDropUnary = JSON.genericToEncoding optionsDropUnary+toJSONDropUnary     = JSON.genericToJSON     optionsDropUnary
src/Control/Lens/Utils.hs view
@@ -1,3 +1,6 @@ module Control.Lens.Utils (module X) where -import Control.Lens.Wrapped.Utils as X+import Control.Lens               as X hiding (makeLenses, makeClassy)+import Control.Lens.Utils.TH      as X+import Control.Lens.Utils.Nested  as X+import Control.Lens.Utils.Wrapped as X
+ src/Control/Lens/Utils/Nested.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE RankNTypes #-}++module Control.Lens.Utils.Nested where++import Prelude hiding (mempty)+import Control.Lens+import Control.Monad+import Data.List.NonEmpty+import Data.Monoids+import Data.Default+import Data.Maybe+import qualified Data.Map as Map+import           Data.Map (Map)++type NestedCtx     a = (Index a ~ Index (IxValue a), IxValue a ~ IxValue (IxValue a))+type NestedAtCtx   a = (NestedCtx a, At   a, At   (IxValue a))+type NestedIxedCtx a = (NestedCtx a, Ixed a, Ixed (IxValue a))++nestedAt :: (NestedAtCtx a, Mempty (IxValue a)) => NonEmpty (Index a) -> Lens' a (Maybe (IxValue a))+nestedAt = nestedDefAt mempty++nestedDefAt :: NestedAtCtx a => IxValue a -> NonEmpty (Index a) -> Lens' a (Maybe (IxValue a))+nestedDefAt def p = case p of+    (t :| [])       -> at t+    (t :| (e : es)) -> lens (join . fmap (view (nestedDefAt def $ e :| es)) . view (at t))+                     $ \h mv -> h & case h ^. at t of+                                    Just _  -> ix t %~ (nestedDefAt def (e :| es) .~ mv)+                                    Nothing -> maybe id (insertNewNested def p) mv+    where insertNewNested :: NestedAtCtx a => IxValue a -> NonEmpty (Index a) -> IxValue a -> (a -> a)+          insertNewNested def (t :| [])       v = at t .~ Just v+          insertNewNested def (t :| (e : es)) v = at t .~ Just (insertNewNested def (e :| es) v def)+++nestedAt' :: (NestedAtCtx a, Mempty (IxValue a)) => NonEmpty (Index a) -> Lens' a (IxValue a)+nestedAt' ixs = lens (fromMaybe mempty . view (nestedAt ixs)) (\a -> flip (set (nestedAt ixs)) a . Just)+++nestedIx :: NestedIxedCtx a => NonEmpty (Index a) -> Traversal' a (IxValue a)+nestedIx = \case+    (t :| [])     -> ix t+    (t :| (i:is)) -> ix t . nestedIx (i :| is)++emptyMap :: Prism' (Map k a) ()+emptyMap = prism' (\() -> Map.empty) $ guard . Map.null++subMapAt t = non' emptyMap . at t++at' = subMapAt -- FIXME[WD]: make an abstraction with `Empty` class which do not have to be monoid++-- | Warning! This function does not hold lens laws: deleting and re-adding a key destroys everything appart of `a`,+--            so `set l (Just x) (set l Nothing s) /= set l (Just x) s`+unsafeLensedMapAt :: (Ord k, Default v) => k -> Lens' v a -> Lens' (Map k v) (Maybe a)+unsafeLensedMapAt k l f m = f ma <&> \r -> case r of+    Nothing -> maybe m (const (Map.delete k m)) ma+    Just a' -> Map.alter (Just . set l a' . fromMaybe def) k m+    where ma = view l <$> Map.lookup k m
+ src/Control/Lens/Utils/TH.hs view
@@ -0,0 +1,30 @@+module Control.Lens.Utils.TH (makeLenses, makeLenses', makeClassy, makeClassy') where++import Prelude+import Language.Haskell.TH+import Data.Monoid+import Control.Lens                  hiding (makeLenses, makeClassy)+import Control.Lens.Internal.FieldTH (_fieldToDef)+import Data.Char                     (toLower)++makeLenses' :: Name -> DecsQ+makeLenses  :: Name -> DecsQ+makeLenses'     = makeLensesWith (lensRules {_fieldToDef = autoPrefixNamer})+makeLenses name = (<>) <$> makeAutoWrapped name <*> makeLenses' name++makeClassy' :: Name -> DecsQ+makeClassy  :: Name -> DecsQ+makeClassy'     = makeLensesWith (classyRules {_fieldToDef = autoPrefixNamer})+makeClassy name = (<>) <$> makeAutoWrapped name <*> makeClassy' name++makeAutoWrapped :: Name -> DecsQ+makeAutoWrapped name = reify name >>= \case+    TyConI (NewtypeD {}) -> makeWrapped name+    _                    -> return mempty++autoPrefixNamer :: FieldNamer+autoPrefixNamer tn _ n = case nameBase n of+    '_' : '_' : xs -> [TopName . mkName $ toLower t : ts <> ('_' : xs)]+    '_' :  x  : xs -> [TopName . mkName $ toLower x : xs]+    _              -> []+    where (t:ts) = nameBase tn
+ src/Control/Lens/Utils/Wrapped.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE NoMonomorphismRestriction #-}++module Control.Lens.Utils.Wrapped where++import Prelude+import Control.Lens+import Data.Coerce+++wrapped'    = _Wrapped'       ; {-# INLINE wrapped'    #-}+unwrapped'  = _Unwrapped'     ; {-# INLINE unwrapped'  #-}+wrapping'   = _Wrapping'      ; {-# INLINE wrapping'   #-}+unwrapping' = _Unwrapping'    ; {-# INLINE unwrapping' #-}+unwrap'     = view wrapped'   ; {-# INLINE unwrap'     #-}+wrap'       = view unwrapped' ; {-# INLINE wrap'       #-}++wrapped    = _Wrapped         ; {-# INLINE wrapped    #-}+unwrapped  = _Unwrapped       ; {-# INLINE unwrapped  #-}+wrapping   = _Wrapping        ; {-# INLINE wrapping   #-}+unwrapping = _Unwrapping      ; {-# INLINE unwrapping #-}+_unwrap    = view wrapped     ; {-# INLINE _unwrap    #-}+_wrap      = view unwrapped   ; {-# INLINE _wrap      #-}++rewrap     = _Wrapped %~ id ; {-#INLINE rewrap #-}++wrappedM' f = fmap wrap' . f . unwrap' ; {-# INLINE wrappedM' #-}+++wrap   :: forall a. Coercible (Unwrapped a) a => Unwrapped a -> a+unwrap :: forall a. Coercible a (Unwrapped a) => a -> Unwrapped a+wrap   = coerce ; {-# INLINE wrap   #-}+unwrap = coerce ; {-# INLINE unwrap #-}
− src/Control/Lens/Wrapped/Utils.hs 
@@ -1,23 +0,0 @@-{-# LANGUAGE NoMonomorphismRestriction #-}--module Control.Lens.Wrapped.Utils where--import Prelude-import Control.Lens---wrapped'    = _Wrapped'-unwrapped'  = _Unwrapped'-wrapping'   = _Wrapping'-unwrapping' = _Unwrapping'-unwrap'     = view wrapped'-wrap'       = view unwrapped'--wrapped    = _Wrapped-unwrapped  = _Unwrapped-wrapping   = _Wrapping-unwrapping = _Unwrapping-unwrap     = view wrapped-wrap       = view unwrapped--rewrap     = _Wrapped %~ id