diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2016-12-17 Evan Cofsky + + * liblawless.cabal: Add new tests and Arbitrary module. + + * Tests/TestAesonEncoding.hs: Tests for the JSON field encoding + logic. + + * Source/Arbitrary.hs: Instances of Arbitrary for various useful + types. + + * Tests: Use new Arbitrary instances. + 2016-12-16 Evan Cofsky * liblawless.cabal (0.14.0.3): diff --git a/Examples/ZFS/Types/ZName.hs b/Examples/ZFS/Types/ZName.hs --- a/Examples/ZFS/Types/ZName.hs +++ b/Examples/ZFS/Types/ZName.hs @@ -12,7 +12,7 @@ module Types.ZName where import Lawless -import Yaml +import Aeson import Text data ZNDateTime = ISO8601 deriving (Show, Eq, Ord, Generic) diff --git a/Examples/ZFS/Types/ZPool.hs b/Examples/ZFS/Types/ZPool.hs --- a/Examples/ZFS/Types/ZPool.hs +++ b/Examples/ZFS/Types/ZPool.hs @@ -12,7 +12,7 @@ module Types.ZPool where import Lawless -import Yaml +import Aeson import Types.ZName data ZPool = ZPool { diff --git a/Examples/ZFS/Types/ZPools.hs b/Examples/ZFS/Types/ZPools.hs --- a/Examples/ZFS/Types/ZPools.hs +++ b/Examples/ZFS/Types/ZPools.hs @@ -13,7 +13,7 @@ module Types.ZPools where import Lawless -import Yaml +import Aeson import Set import Types.ZPool diff --git a/Source/Aeson.hs b/Source/Aeson.hs --- a/Source/Aeson.hs +++ b/Source/Aeson.hs @@ -2,16 +2,18 @@ module Data.Aeson, module Data.Aeson.Types, module Data.JsonSchema.Draft4, + module Generics, lawlessJSONOptions, lawlessToJSONEncoding, lawlessParseJSON ) where import Lawless +import Generics import Data.Char import Data.Aeson import Data.Aeson.Types -import GHC.Generics (Generic, Rep) +import GHC.Generics (Rep) import Data.JsonSchema.Draft4 dropLensPrefix ∷ [Char] → [Char] @@ -27,7 +29,6 @@ constructorTagModifier = camelTo2 '_' ∘ dropLensPrefix, allNullaryToStringTag = False, omitNothingFields = False, - unwrapUnaryRecords = True, sumEncoding = ObjectWithSingleField} lawlessToJSONEncoding ∷ ∀ a. (GToEncoding (Rep a), Generic a) ⇒ a → Encoding diff --git a/Source/Arbitrary.hs b/Source/Arbitrary.hs new file mode 100644 --- /dev/null +++ b/Source/Arbitrary.hs @@ -0,0 +1,41 @@ +{-| +Module: Arbitrary +Description: Provides Arbitrary instances of several types in this and other libraries. +Copyright: © 2016 All rights reserved. +License: GPL-3 +Maintainer: Evan Cofsky <> +Stability: experimental +Portability: POSIX +-} + +module Arbitrary where + +import Lawless +import Test.QuickCheck (Arbitrary(..), listOf1, suchThat) +import Text +import Time +import Textual.SepList +import Data.Time +import Data.Time.Clock +import Data.Time.Calendar + +instance Arbitrary (SepList Char) where + arbitrary = + foldl1Of folded (<>) ∘ over traversed sepList <$> listOf1 arbitrary + +instance Arbitrary Text where + arbitrary = view packed <$> listOf1 arbitrary + +instance Arbitrary Day where + arbitrary = toEnum <$> arbitrary + +instance Arbitrary DiffTime where + arbitrary = + fromRational <$> suchThat arbitrary (\t → t ≥ 0.0 ∧ t ≤ 86401.0) + +instance Arbitrary UTCTime where + arbitrary = + UTCTime <$> arbitrary <*> arbitrary + +instance Arbitrary Time where + arbitrary = review _Time <$> arbitrary diff --git a/Source/Lawless.hs b/Source/Lawless.hs --- a/Source/Lawless.hs +++ b/Source/Lawless.hs @@ -16,11 +16,12 @@ module Data.Maybe, module Data.Either, module Data.Semigroup, - module Control.Applicative + module Control.Applicative, + module Data.Text.IO ) where import Applicative -import Base hiding (print) +import Base hiding (print, putStr, putStrLn) import Bool import Either import Functor @@ -46,3 +47,4 @@ import Data.Function.Unicode as UNI import Data.Ord.Unicode as UNI import Prelude.Unicode ((⋅)) +import Data.Text.IO diff --git a/Source/Text.hs b/Source/Text.hs --- a/Source/Text.hs +++ b/Source/Text.hs @@ -1,23 +1,9 @@ -{-# Language NoMonomorphismRestriction #-} - -module Text - ( +module Text ( module Data.Text, module Data.Text.Lens, - nfcText, - nfcUtf8ByteString, - nfcUtf8 - ) where + module Data.Text.ICU.Normalized.NFC + ) where -import qualified Data.Text.ICU.Normalized.NFC as NFC +import Data.Text.ICU.Normalized.NFC import Data.Text (Text, null, empty) import Data.Text.Lens - --- | Converts between 'Text' and 'NFCText' -nfcText = NFC.strict - --- | Converts between a UTF-8 ByteString and an NFCText -nfcUtf8ByteString = NFC.utf8ByteString - --- | Converts between a String and an NFCText -nfcUtf8 = NFC.utf8 diff --git a/Source/Yaml.hs b/Source/Yaml.hs deleted file mode 100644 --- a/Source/Yaml.hs +++ /dev/null @@ -1,11 +0,0 @@ --- | Yaml exports - -module Yaml ( - module Data.Yaml, - module Aeson, - module Generics - ) where - -import Generics -import Data.Yaml -import Aeson hiding (decode, encode) diff --git a/Tests/Main.hs b/Tests/Main.hs --- a/Tests/Main.hs +++ b/Tests/Main.hs @@ -7,6 +7,7 @@ import qualified TestSepList as TS import qualified TestAeson as TJ import qualified TestTemporary as TM +import qualified TestAesonEncoding as TE main :: IO () -main = defaultMain [TT.properties, TS.properties, TJ.properties, TM.properties] +main = defaultMain [TT.properties, TS.properties, TJ.properties, TM.properties, TE.properties] diff --git a/Tests/TestAeson.hs b/Tests/TestAeson.hs --- a/Tests/TestAeson.hs +++ b/Tests/TestAeson.hs @@ -13,6 +13,7 @@ import Data.String (String) import Lawless +import Arbitrary import Aeson import Text import Generics @@ -31,9 +32,6 @@ toEncoding = lawlessToJSONEncoding instance FromJSON TestData where parseJSON = lawlessParseJSON - -instance Arbitrary Text where - arbitrary = pack <$> arbitrary instance Arbitrary TestData where arbitrary = TestData <$> arbitrary <*> arbitrary diff --git a/Tests/TestAesonEncoding.hs b/Tests/TestAesonEncoding.hs new file mode 100644 --- /dev/null +++ b/Tests/TestAesonEncoding.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +{-| +Module: TestAesonEncoding +Description: Tests that our encoding/decoding options produce the correct results. +Copyright: © 2016 All rights reserved. +License: GPL-3 +Maintainer: Evan Cofsky <> +Stability: experimental +Portability: POSIX +-} + +module TestAesonEncoding where + +import Test.Framework +import Test.Framework.TH +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.QuickCheck + +import Lawless hiding (elements) +import Aeson +import Data.Char (toLower) +import Data.Aeson.Types (camelTo2) + +data FieldLabel = FieldLabel { + _flPrefix ∷ [Char], + _flMiddle ∷ [Char], + _flSuffix ∷ [Char] + } deriving (Eq, Ord, Show) +makeLenses ''FieldLabel + +flLabel ∷ Getter FieldLabel [Char] +flLabel = to (\f → concatOf traversed ["_", f ^. flPrefix, f ^. flMiddle, f ^. flSuffix]) + +flModLabel ∷ Getter FieldLabel [Char] +flModLabel = to (fieldLabelModifier lawlessJSONOptions ∘ view flLabel) + +lowers = elements ['a'..'z'] +uppers = elements ['A'..'Z'] +others = elements $ concatOf traversed [['a'..'z'], ['A'..'Z'], ['0'..'9'], "_"] + +instance Arbitrary FieldLabel where + arbitrary = FieldLabel <$> listOf1 lowers <*> ((:[]) <$> uppers) <*> listOf others + +prop_TestDropLens :: FieldLabel -> Property +prop_TestDropLens fl = + let + efl = fl ^. flModLabel + in + collect "Test dropping the Lens prefix" $ + (toLower <$> (fl ^. flMiddle) ^.. taking 1 traversed) === efl ^.. taking 1 traversed + +properties ∷ Test +properties = $(testGroupGenerator) diff --git a/Tests/TestSepList.hs b/Tests/TestSepList.hs --- a/Tests/TestSepList.hs +++ b/Tests/TestSepList.hs @@ -4,6 +4,7 @@ module TestSepList (properties) where import Lawless +import Arbitrary import Textual import Test.Framework @@ -14,10 +15,6 @@ import qualified Data.ByteString.Lazy as L import Data.Binary - - -instance Arbitrary (SepList Char) where - arbitrary = foldl1Of folded (<>) . over traversed sepList <$> listOf1 arbitrary prop_Semigroup :: SepList Char -> SepList Char -> Property prop_Semigroup (a :: SepList Char) (b :: SepList Char) = diff --git a/Tests/TestTemporary.hs b/Tests/TestTemporary.hs --- a/Tests/TestTemporary.hs +++ b/Tests/TestTemporary.hs @@ -14,6 +14,7 @@ module TestTemporary where import Lawless +import Arbitrary import Test.Framework import Test.Framework.TH import Test.Framework.Providers.QuickCheck2 (testProperty) @@ -24,9 +25,6 @@ import System.IO hiding (utf8) import Test.QuickCheck.Monadic import Data.Text.Encoding (encodeUtf8) - -instance Arbitrary Text where - arbitrary = view packed <$> listOf1 arbitrary prop_CheckBuffering (line ∷ Text) = monadicIO $ do let l = encodeUtf8 line diff --git a/Tests/TestTime.hs b/Tests/TestTime.hs --- a/Tests/TestTime.hs +++ b/Tests/TestTime.hs @@ -15,20 +15,8 @@ import Data.Binary import Lawless +import Arbitrary import Time - -instance Arbitrary Day where - arbitrary = toEnum <$> arbitrary - -instance Arbitrary DiffTime where - arbitrary = fromRational <$> suchThat arbitrary (\t -> t >= 0.0 && t <= 86401.0) - -instance Arbitrary UTCTime where - arbitrary = - UTCTime <$> arbitrary <*> arbitrary - -instance Arbitrary Time where - arbitrary = review _Time <$> arbitrary prop_PrismToTime :: UTCTime -> Property prop_PrismToTime (ut :: UTCTime) = diff --git a/liblawless.cabal b/liblawless.cabal --- a/liblawless.cabal +++ b/liblawless.cabal @@ -1,5 +1,5 @@ name: liblawless -version: 0.14.0.4 +version: 0.16.0 synopsis: Prelude based on protolude for GHC 8 and beyond. license: GPL-3 license-file: LICENSE @@ -27,11 +27,12 @@ source-repository this type: git location: location: git+ssh://lambdanow.us/projects/haskellnow/liblawless.git - tag: v0.14.0.4 + tag: v0.16.0 library exposed-modules: Aeson + Arbitrary Boomerang Exception Generics @@ -47,7 +48,6 @@ Textual.SepList Time Tree - Yaml default-extensions: NoImplicitPrelude UnicodeSyntax @@ -98,14 +98,14 @@ semigroups >= 0.18.2 && < 0.19, stm >= 2.4.4 && < 2.5, stm-containers >= 0.2.15 && < 0.3, + QuickCheck >= 2.8.2 && < 2.9, temporary >= 1.2.0 && < 1.3, text >= 1.2.2 && < 1.3, text-icu >= 0.7.0 && < 0.8, - text-icu-normalized >= 0.1.6 && < 0.2, + text-icu-normalized >= 0.3.0 && < 0.4, text-printer >= 0.4 && < 0.5, time >= 1.6.0 && < 1.7, transformers >= 0.5.2 && < 0.6, - yaml >= 0.8.20 && < 0.9, zippers >= 0.2.2 && < 0.3 hs-source-dirs: Source default-language: Haskell2010 @@ -123,6 +123,7 @@ Paths_liblawless build-depends: QuickCheck, + aeson < 1.0, base >= 4.9 && < 4.10, binary >= 0.7.5.0, bytestring,