proto-lens-combinators (empty) → 0.1.0.0
raw patch · 7 files changed
+476/−0 lines, 7 filesdep +HUnitdep +basedep +data-default-classbuild-type:Customsetup-changed
Dependencies added: HUnit, base, data-default-class, lens-family, proto-lens, proto-lens-combinators, proto-lens-protoc, test-framework, test-framework-hunit, transformers
Files
- LICENSE +30/−0
- Setup.hs +9/−0
- dist/build/autogen/Proto/Combinators.hs +277/−0
- proto-lens-combinators.cabal +42/−0
- src/Data/ProtoLens/Combinators.hs +47/−0
- tests/combinators.proto +16/−0
- tests/combinators_test.hs +55/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Google Inc.++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 Google Inc. 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.
+ Setup.hs view
@@ -0,0 +1,9 @@+-- Copyright 2016 Google Inc. All Rights Reserved.+--+-- Use of this source code is governed by a BSD-style+-- license that can be found in the LICENSE file or at+-- https://developers.google.com/open-source/licenses/bsd++import Data.ProtoLens.Setup++main = defaultMainGeneratingProtos "tests"
+ dist/build/autogen/Proto/Combinators.hs view
@@ -0,0 +1,277 @@+{- This file was auto-generated from combinators.proto by the proto-lens-protoc program. -}+{-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies,+ MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-unused-imports#-}+module Proto.Combinators where+import qualified Prelude+import qualified Data.ProtoLens+import qualified Data.ProtoLens.Message.Enum+import qualified Lens.Family2+import qualified Lens.Family2.Unchecked+import qualified Data.Default.Class+import qualified Data.Text+import qualified Data.Int+import qualified Data.Word+import qualified Data.Map+import qualified Data.ByteString++data Foo = Foo{_Foo'quux :: Prelude.Maybe Data.Int.Int32,+ _Foo'foo :: Prelude.Maybe Foo'Bar,+ _Foo'bar :: Prelude.Maybe Foo'Bar,+ _Foo'baz :: Prelude.Maybe Foo'Bar}+ deriving (Prelude.Show, Prelude.Eq)++type instance Data.ProtoLens.Field "quux" Foo = Data.Int.Int32++instance Data.ProtoLens.HasField "quux" Foo Foo where+ field _+ = (Prelude..) maybe'quux+ (Data.ProtoLens.maybeLens Data.ProtoLens.fieldDefault)++type instance Data.ProtoLens.Field "maybe'quux" Foo =+ Prelude.Maybe Data.Int.Int32++instance Data.ProtoLens.HasField "maybe'quux" Foo Foo where+ field _+ = Lens.Family2.Unchecked.lens _Foo'quux+ (\ x__ y__ -> x__{_Foo'quux = y__})++type instance Data.ProtoLens.Field "foo" Foo = Foo'Bar++instance Data.ProtoLens.HasField "foo" Foo Foo where+ field _+ = (Prelude..) maybe'foo+ (Data.ProtoLens.maybeLens Data.Default.Class.def)++type instance Data.ProtoLens.Field "maybe'foo" Foo =+ Prelude.Maybe Foo'Bar++instance Data.ProtoLens.HasField "maybe'foo" Foo Foo where+ field _+ = Lens.Family2.Unchecked.lens _Foo'foo+ (\ x__ y__ -> x__{_Foo'foo = y__})++type instance Data.ProtoLens.Field "bar" Foo = Foo'Bar++instance Data.ProtoLens.HasField "bar" Foo Foo where+ field _+ = (Prelude..) maybe'bar+ (Data.ProtoLens.maybeLens Data.Default.Class.def)++type instance Data.ProtoLens.Field "maybe'bar" Foo =+ Prelude.Maybe Foo'Bar++instance Data.ProtoLens.HasField "maybe'bar" Foo Foo where+ field _+ = Lens.Family2.Unchecked.lens _Foo'bar+ (\ x__ y__ -> x__{_Foo'bar = y__})++type instance Data.ProtoLens.Field "baz" Foo = Foo'Bar++instance Data.ProtoLens.HasField "baz" Foo Foo where+ field _+ = (Prelude..) maybe'baz+ (Data.ProtoLens.maybeLens Data.Default.Class.def)++type instance Data.ProtoLens.Field "maybe'baz" Foo =+ Prelude.Maybe Foo'Bar++instance Data.ProtoLens.HasField "maybe'baz" Foo Foo where+ field _+ = Lens.Family2.Unchecked.lens _Foo'baz+ (\ x__ y__ -> x__{_Foo'baz = y__})++instance Data.Default.Class.Default Foo where+ def+ = Foo{_Foo'quux = Prelude.Nothing, _Foo'foo = Prelude.Nothing,+ _Foo'bar = Prelude.Nothing, _Foo'baz = Prelude.Nothing}++instance Data.ProtoLens.Message Foo where+ descriptor+ = let quux__field_descriptor+ = Data.ProtoLens.FieldDescriptor "quux"+ (Data.ProtoLens.Int32Field ::+ Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32)+ (Data.ProtoLens.OptionalField maybe'quux)+ foo__field_descriptor+ = Data.ProtoLens.FieldDescriptor "foo"+ (Data.ProtoLens.MessageField ::+ Data.ProtoLens.FieldTypeDescriptor Foo'Bar)+ (Data.ProtoLens.OptionalField maybe'foo)+ bar__field_descriptor+ = Data.ProtoLens.FieldDescriptor "bar"+ (Data.ProtoLens.MessageField ::+ Data.ProtoLens.FieldTypeDescriptor Foo'Bar)+ (Data.ProtoLens.OptionalField maybe'bar)+ baz__field_descriptor+ = Data.ProtoLens.FieldDescriptor "baz"+ (Data.ProtoLens.MessageField ::+ Data.ProtoLens.FieldTypeDescriptor Foo'Bar)+ (Data.ProtoLens.OptionalField maybe'baz)+ in+ Data.ProtoLens.MessageDescriptor+ (Data.Map.fromList+ [(Data.ProtoLens.Tag 1, quux__field_descriptor),+ (Data.ProtoLens.Tag 2, foo__field_descriptor),+ (Data.ProtoLens.Tag 3, bar__field_descriptor),+ (Data.ProtoLens.Tag 4, baz__field_descriptor)])+ (Data.Map.fromList+ [("quux", quux__field_descriptor), ("foo", foo__field_descriptor),+ ("bar", bar__field_descriptor), ("baz", baz__field_descriptor)])++data Foo'Bar = Foo'Bar{_Foo'Bar'fizz ::+ Prelude.Maybe Data.Int.Int32,+ _Foo'Bar'buzz :: Prelude.Maybe Data.Text.Text}+ deriving (Prelude.Show, Prelude.Eq)++type instance Data.ProtoLens.Field "fizz" Foo'Bar = Data.Int.Int32++instance Data.ProtoLens.HasField "fizz" Foo'Bar Foo'Bar where+ field _+ = (Prelude..) maybe'fizz+ (Data.ProtoLens.maybeLens Data.ProtoLens.fieldDefault)++type instance Data.ProtoLens.Field "maybe'fizz" Foo'Bar =+ Prelude.Maybe Data.Int.Int32++instance Data.ProtoLens.HasField "maybe'fizz" Foo'Bar Foo'Bar where+ field _+ = Lens.Family2.Unchecked.lens _Foo'Bar'fizz+ (\ x__ y__ -> x__{_Foo'Bar'fizz = y__})++type instance Data.ProtoLens.Field "buzz" Foo'Bar = Data.Text.Text++instance Data.ProtoLens.HasField "buzz" Foo'Bar Foo'Bar where+ field _+ = (Prelude..) maybe'buzz+ (Data.ProtoLens.maybeLens Data.ProtoLens.fieldDefault)++type instance Data.ProtoLens.Field "maybe'buzz" Foo'Bar =+ Prelude.Maybe Data.Text.Text++instance Data.ProtoLens.HasField "maybe'buzz" Foo'Bar Foo'Bar where+ field _+ = Lens.Family2.Unchecked.lens _Foo'Bar'buzz+ (\ x__ y__ -> x__{_Foo'Bar'buzz = y__})++instance Data.Default.Class.Default Foo'Bar where+ def+ = Foo'Bar{_Foo'Bar'fizz = Prelude.Nothing,+ _Foo'Bar'buzz = Prelude.Nothing}++instance Data.ProtoLens.Message Foo'Bar where+ descriptor+ = let fizz__field_descriptor+ = Data.ProtoLens.FieldDescriptor "fizz"+ (Data.ProtoLens.Int32Field ::+ Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32)+ (Data.ProtoLens.OptionalField maybe'fizz)+ buzz__field_descriptor+ = Data.ProtoLens.FieldDescriptor "buzz"+ (Data.ProtoLens.StringField ::+ Data.ProtoLens.FieldTypeDescriptor Data.Text.Text)+ (Data.ProtoLens.OptionalField maybe'buzz)+ in+ Data.ProtoLens.MessageDescriptor+ (Data.Map.fromList+ [(Data.ProtoLens.Tag 1, fizz__field_descriptor),+ (Data.ProtoLens.Tag 2, buzz__field_descriptor)])+ (Data.Map.fromList+ [("fizz", fizz__field_descriptor),+ ("buzz", buzz__field_descriptor)])++bar ::+ forall msg msg' . Data.ProtoLens.HasField "bar" msg msg' =>+ Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "bar" msg)+ (Data.ProtoLens.Field "bar" msg')+bar+ = Data.ProtoLens.field+ (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "bar")++baz ::+ forall msg msg' . Data.ProtoLens.HasField "baz" msg msg' =>+ Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "baz" msg)+ (Data.ProtoLens.Field "baz" msg')+baz+ = Data.ProtoLens.field+ (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "baz")++buzz ::+ forall msg msg' . Data.ProtoLens.HasField "buzz" msg msg' =>+ Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "buzz" msg)+ (Data.ProtoLens.Field "buzz" msg')+buzz+ = Data.ProtoLens.field+ (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "buzz")++fizz ::+ forall msg msg' . Data.ProtoLens.HasField "fizz" msg msg' =>+ Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "fizz" msg)+ (Data.ProtoLens.Field "fizz" msg')+fizz+ = Data.ProtoLens.field+ (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "fizz")++foo ::+ forall msg msg' . Data.ProtoLens.HasField "foo" msg msg' =>+ Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "foo" msg)+ (Data.ProtoLens.Field "foo" msg')+foo+ = Data.ProtoLens.field+ (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "foo")++maybe'bar ::+ forall msg msg' . Data.ProtoLens.HasField "maybe'bar" msg msg' =>+ Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "maybe'bar" msg)+ (Data.ProtoLens.Field "maybe'bar" msg')+maybe'bar+ = Data.ProtoLens.field+ (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "maybe'bar")++maybe'baz ::+ forall msg msg' . Data.ProtoLens.HasField "maybe'baz" msg msg' =>+ Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "maybe'baz" msg)+ (Data.ProtoLens.Field "maybe'baz" msg')+maybe'baz+ = Data.ProtoLens.field+ (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "maybe'baz")++maybe'buzz ::+ forall msg msg' . Data.ProtoLens.HasField "maybe'buzz" msg msg' =>+ Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "maybe'buzz" msg)+ (Data.ProtoLens.Field "maybe'buzz" msg')+maybe'buzz+ = Data.ProtoLens.field+ (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "maybe'buzz")++maybe'fizz ::+ forall msg msg' . Data.ProtoLens.HasField "maybe'fizz" msg msg' =>+ Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "maybe'fizz" msg)+ (Data.ProtoLens.Field "maybe'fizz" msg')+maybe'fizz+ = Data.ProtoLens.field+ (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "maybe'fizz")++maybe'foo ::+ forall msg msg' . Data.ProtoLens.HasField "maybe'foo" msg msg' =>+ Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "maybe'foo" msg)+ (Data.ProtoLens.Field "maybe'foo" msg')+maybe'foo+ = Data.ProtoLens.field+ (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "maybe'foo")++maybe'quux ::+ forall msg msg' . Data.ProtoLens.HasField "maybe'quux" msg msg' =>+ Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "maybe'quux" msg)+ (Data.ProtoLens.Field "maybe'quux" msg')+maybe'quux+ = Data.ProtoLens.field+ (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "maybe'quux")++quux ::+ forall msg msg' . Data.ProtoLens.HasField "quux" msg msg' =>+ Lens.Family2.Lens msg msg' (Data.ProtoLens.Field "quux" msg)+ (Data.ProtoLens.Field "quux" msg')+quux+ = Data.ProtoLens.field+ (Data.ProtoLens.ProxySym :: Data.ProtoLens.ProxySym "quux")
+ proto-lens-combinators.cabal view
@@ -0,0 +1,42 @@+name: proto-lens-combinators+version: 0.1.0.0+synopsis: Utilities functions to proto-lens.+description:+ Useful things for working with protos.++homepage: https://github.com/google/proto-lens+license: BSD3+license-file: LICENSE+author: Zie Weaver+maintainer: zearen+protolens@google.com+copyright: Google Inc.+category: Data+build-type: Custom+cabal-version: >=1.10+extra-source-files: tests/combinators.proto++library+ default-language: Haskell2010+ hs-source-dirs: src+ exposed-modules: Data.ProtoLens.Combinators+ build-depends: proto-lens == 0.1.*+ -- Used by the custom Setup script (for the test-suite).+ , proto-lens-protoc == 0.1.*+ , base == 4.8.*+ , data-default-class == 0.0.*+ , lens-family == 1.2.*+ , transformers == 0.4.*++Test-Suite combinators_test+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: combinators_test.hs+ hs-source-dirs: tests+ other-modules: Proto.Combinators+ build-depends: HUnit+ , base+ , lens-family+ , proto-lens-combinators+ , proto-lens-protoc+ , test-framework+ , test-framework-hunit
+ src/Data/ProtoLens/Combinators.hs view
@@ -0,0 +1,47 @@+-- Copyright 2016 Google Inc. All Rights Reserved.+--+-- Use of this source code is governed by a BSD-style+-- license that can be found in the LICENSE file or at+-- https://developers.google.com/open-source/licenses/bsd++{-# LANGUAGE RankNTypes #-}+-- | An assorted collection of functions useful when working with ProtoLens+-- protocol buffers. These functions are inspired by functionality found in+-- the protobuf implementation in other languages.+module Data.ProtoLens.Combinators+ ( has+ , clear+ , make+ , modifyInState+ ) where++import Control.Monad.Trans.State (State, execState)+import Data.Default.Class (Default(def))+import Data.Maybe (isJust)+import Lens.Family2 (LensLike, Phantom, Setter, to, (.~))++-- | Turns a 'LensLike' getting a 'Maybe' into a 'Getter' of a 'Bool'+-- that returns @True@ when the 'Maybe' is @Just@ something.+--+-- I.e., makes a getter for a 'Maybe' field that returns whether it's set.+has :: Phantom f => LensLike f a a' (Maybe b) b' -> LensLike f a a' Bool b''+has = (. to isJust)++-- | Sets the provided lens in @a@ to @Nothing@.+clear :: Setter a a' b (Maybe b') -> a -> a'+clear = (.~ Nothing)++-- | Creates a 'Default' and then applies the provided `State` to it. This is+-- convenient for creating complicated structures.+make :: Default def => State def a -> def+make = modifyInState def++-- | Allows one to modify a value in the 'State' monad. Note that this is+-- just for syntactic convenience with @do@ blocks, e.g.+--+-- @+-- newThing = modifyInState thing $ do+-- ...+-- @+modifyInState :: s -> State s a -> s+modifyInState = flip execState
+ tests/combinators.proto view
@@ -0,0 +1,16 @@+syntax = "proto2";++package combinators;++message Foo {+ optional int32 quux = 1;++ message Bar {+ optional int32 fizz = 1;+ optional string buzz = 2;+ }++ optional Bar foo = 2;+ optional Bar bar = 3;+ optional Bar baz = 4;+}
+ tests/combinators_test.hs view
@@ -0,0 +1,55 @@+-- Copyright 2016 Google Inc. All Rights Reserved.+--+-- Use of this source code is governed by a BSD-style+-- license that can be found in the LICENSE file or at+-- https://developers.google.com/open-source/licenses/bsd++{-# LANGUAGE OverloadedStrings #-}+module Main where++import Data.ProtoLens (def)+import Data.ProtoLens.Combinators+import Lens.Family2 ((^.), (.~), (&))+import Lens.Family2.State ((.=), (<~), use, zoom)+import Proto.Combinators+import Test.Framework (defaultMain)+import Test.Framework.Providers.HUnit (hUnitTestToTests)+import Test.HUnit ((~:), (~?=))++main :: IO ()+main = defaultMain $ hUnitTestToTests $ "" ~:+ [ let proto = def & quux .~ 1 & foo .~ def :: Foo+ in "has" ~:+ [ "True" ~: proto ^. has maybe'quux ~?= True+ , "False" ~: proto ^. has maybe'bar ~?= False+ , "Nested" ~:+ [ "True" ~: proto ^. has maybe'foo ~?= True+ , "False" ~: proto ^. has (foo . maybe'buzz) ~?= False+ ]+ ]+ , let proto = def & quux .~ 2 & foo . fizz .~ 3 :: Foo+ in "clear" ~:+ [ "no-op" ~: clear maybe'bar proto ~?= proto+ , "scalar" ~: clear maybe'quux proto ~?= (def & foo . fizz .~ 3)+ , "group" ~: clear maybe'foo proto ~?= (def & quux .~ 2)+ , "nested" ~: clear (foo . maybe'fizz) proto ~?=+ (def & quux .~ 2 & foo .~ def)+ ]+ , let actual :: Foo+ actual = make $ do+ quux .= 4+ foo . buzz .= "A"+ zoom bar $ do+ fizz .= 5+ buzz .= "B"+ zoom baz $ return ()+ expected = def & quux .~ 4 & foo . buzz .~ "A" &+ bar .~ (def & fizz .~ 5 & buzz .~ "B") & baz .~ def+ in "make" ~: actual ~?= expected+ , let original = def & quux .~ 6 & baz . fizz .~ 7 :: Foo+ actual = modifyInState original $ do+ bar . fizz <~ use quux+ quux .= 8+ expected = def & quux .~ 8 & bar . fizz .~ 6 & baz . fizz .~ 7+ in "modifyInState" ~: actual ~?= expected+ ]