hw-mquery 0.1.0.1 → 0.1.0.3

raw patch · 13 files changed

+312/−122 lines, 13 filesdep +hedgehogdep +hw-hspec-hedgehogdep +lensdep ~ansi-wl-pprintdep ~dlistPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hedgehog, hw-hspec-hedgehog, lens, semigroups

Dependency ranges changed: ansi-wl-pprint, dlist

API changes (from Hackage documentation)

Files

• LICENSE +26/−17
• README.md +16/−14
• hw-mquery.cabal +72/−48
• src/HaskellWorks/Data/Entry.hs +1/−1
• src/HaskellWorks/Data/MQuery.hs +37/−11
• src/HaskellWorks/Data/Micro.hs +10/−9
• src/HaskellWorks/Data/Mini.hs +8/−7
• src/HaskellWorks/Data/Row.hs +9/−10
• src/HaskellWorks/Data/Shows.hs +1/−1
• test/HaskellWorks/Data/MQuerySpec.hs +28/−4
• test/HaskellWorks/Data/Model/Example.hs +46/−0
• test/HaskellWorks/Data/Model/Lens.hs +12/−0
• test/HaskellWorks/Data/Model/Type.hs +46/−0

@@ -1,21 +1,30 @@-MIT License+Copyright John Ky (c) 2016 -Copyright (c) 2016 John Ky+All rights reserved. -Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met: -The above copyright notice and this permission notice shall be included in all-copies or substantial portions of the Software.+    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer. -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE-SOFTWARE.+    * 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 Author name here 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.

@@ -1,24 +1,26 @@ # hw-mquery-[![0.0-branch](https://circleci.com/gh/haskell-works/hw-mquery/tree/0.0-branch.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-mquery/tree/0.0-branch)+[![master](https://circleci.com/gh/haskell-works/hw-mquery/tree/master.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-mquery/tree/master)  ```-import           Control.Monad+import Control.Monad+import Data.Function+import Data.List+import HaskellWorks.Data.Json.Load+import HaskellWorks.Data.Json.PartialValue+import HaskellWorks.Data.Micro+import HaskellWorks.Data.MQuery+import HaskellWorks.Data.Row+import HaskellWorks.Diagnostics+import Text.PrettyPrint.ANSI.Leijen+ import qualified Data.DList as DL-import           Data.Function-import           Data.List-import           HaskellWorks.Data.LoadJson-import           HaskellWorks.Data.Micro-import           HaskellWorks.Data.MQuery-import           HaskellWorks.Data.Json.PartialValue-import           HaskellWorks.Data.Row-import           HaskellWorks.Diagnostics-import           Text.PrettyPrint.ANSI.Leijen ```  ```-!json <- loadJsonPartial "data/78mb.json"-!json <- loadJsonWithIndex "data/78mb.json"-!json <- loadJsonWithPoppy512Index "data/78mb.json"+!json <- loadJsonPartial "../data/78mb.json"+!json <- loadJsonWithIndex "../data/78mb.json"+!json <- loadJsonWithPoppy512Index "../data/78mb.json"+!json <- loadJsonWithPoppy512SMinMaxIndex "../data/78mb.json" let q = MQuery (DL.singleton json) ``` 

@@ -1,55 +1,79 @@-name:                   hw-mquery-version:                0.1.0.1-synopsis:               Conduits for tokenizing streams.-description:            Please see README.md-homepage:               http://github.com/haskell-works/hw-mquery#readme-license:                MIT-license-file:           LICENSE-author:                 John Ky-maintainer:             newhoggy@gmail.com-copyright:              2016 John Ky-category:               Data, Conduit-build-type:             Simple-extra-source-files:     README.md-cabal-version:          >= 1.22+cabal-version:  2.2 -executable hw-mquery-example-  hs-source-dirs:       app-  main-is:              Main.hs-  ghc-options:          -threaded -rtsopts -with-rtsopts=-N -O2 -Wall -msse4.2-  build-depends:        base                          >= 4          && < 5-                      , hw-mquery-  default-language:     Haskell2010+name:           hw-mquery+version:        0.1.0.3+synopsis:       Monadic query DSL+description:    Please see README.md+category:       Data+homepage:       http://github.com/haskell-works/hw-mquery#readme+bug-reports:    https://github.com/haskell-works/hw-mquery/issues+author:         John Ky+maintainer:     newhoggy@gmail.com+copyright:      2018 John Ky+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md +source-repository head+  type: git+  location: https://github.com/haskell-works/hw-mquery++common base+  build-depends:+      base                >= 4          && < 5+    , ansi-wl-pprint      >= 0.6.8      && < 0.7+    , dlist               >= 0.8.0      && < 0.9+    , lens                >= 4.17       && < 4.18+    , semigroups          >= 0.18.5     && < 0.19+  ghc-options: -Wall -O2 -msse4.2+  default-language: Haskell2010+ library-  hs-source-dirs:       src-  exposed-modules:      HaskellWorks.Data.AtLeastSize-                      , HaskellWorks.Data.Entry-                      , HaskellWorks.Data.Micro-                      , HaskellWorks.Data.Mini-                      , HaskellWorks.Data.MQuery-                      , HaskellWorks.Data.Row-                      , HaskellWorks.Data.Shows-                      , HaskellWorks.Data.ToBool+  import: base+  hs-source-dirs:+      src -  build-depends:        base                          >= 4          && < 5-                      , ansi-wl-pprint-                      , dlist+  exposed-modules:+      HaskellWorks.Data.AtLeastSize+      HaskellWorks.Data.Entry+      HaskellWorks.Data.Micro+      HaskellWorks.Data.Mini+      HaskellWorks.Data.MQuery+      HaskellWorks.Data.Row+      HaskellWorks.Data.Shows+      HaskellWorks.Data.ToBool+  other-modules:+      Paths_hw_mquery+  autogen-modules:+      Paths_hw_mquery -  default-language:     Haskell2010-  ghc-options:          -Wall -O2 -msse4.2+executable hw-mquery-example+  import: base+  main-is: Main.hs+  hs-source-dirs:+      app+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      hw-mquery  test-suite hw-mquery-test-  type:                 exitcode-stdio-1.0-  hs-source-dirs:       test-  main-is:              Spec.hs-  other-modules:        HaskellWorks.Data.MQuerySpec-  build-depends:        base                          >= 4          && < 5-                      , hspec-                      , QuickCheck-  ghc-options:          -threaded -rtsopts -with-rtsopts=-N -Wall-  default-language:     Haskell2010--source-repository head-  type:     git-  location: https://github.com/haskell-works/hw-mquery+  import: base+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      QuickCheck+    , hedgehog+    , hspec+    , hw-hspec-hedgehog+    , hw-mquery+  other-modules:+      HaskellWorks.Data.Model.Example+      HaskellWorks.Data.Model.Lens+      HaskellWorks.Data.Model.Type+      HaskellWorks.Data.MQuerySpec+  build-tools: hspec-discover

@@ -1,6 +1,6 @@ module HaskellWorks.Data.Entry where -import           Text.PrettyPrint.ANSI.Leijen+import Text.PrettyPrint.ANSI.Leijen  data Entry k v = Entry k v 

@@ -6,15 +6,18 @@  module HaskellWorks.Data.MQuery where -import           Control.Monad-import           Data.List-import qualified Data.DList                           as DL-import           GHC.Base-import           HaskellWorks.Data.Entry-import           HaskellWorks.Data.Row-import           HaskellWorks.Data.ToBool-import           Text.PrettyPrint.ANSI.Leijen+import Control.Lens+import Control.Monad+import Data.List+import Data.Semigroup               (Semigroup, (<>))+import GHC.Base+import HaskellWorks.Data.Entry+import HaskellWorks.Data.Row+import HaskellWorks.Data.ToBool+import Text.PrettyPrint.ANSI.Leijen hiding ((<>)) +import qualified Data.DList as DL+ newtype MQuery a = MQuery (DL.DList a)  deriving instance Functor     MQuery@@ -22,6 +25,7 @@ deriving instance Monad       MQuery deriving instance Alternative MQuery deriving instance MonadPlus   MQuery+deriving instance Foldable    MQuery  class IsPredicate a where   type ArgOf a@@ -44,7 +48,7 @@  satisfying :: (a -> Bool) -> a -> MQuery a satisfying p a | p a  = MQuery $ DL.singleton a-satisfying _ _        = MQuery   DL.empty+satisfying _ _ = MQuery   DL.empty  key :: Entry k v -> MQuery k key (Entry k _) = MQuery $ DL.singleton k@@ -90,5 +94,27 @@  uniq :: Eq a => [a] -> [a] uniq (a:b:cs) | a == b  =   uniq (b:cs)-uniq (a:b:cs)           = a:uniq (b:cs)-uniq cs                 = cs+uniq (a:b:cs) = a:uniq (b:cs)+uniq cs       = cs++infixl 1 >>^.+infixl 1 >>^..++instance Semigroup (MQuery a) where+  MQuery a <> MQuery b = MQuery (a `DL.append` b)++instance Monoid (MQuery a) where+  mempty = MQuery DL.empty+  mappend (MQuery a) (MQuery b) = MQuery (a `DL.append` b)++(/^.) :: Monad m => s -> Getting a s a -> m a+(/^.) a g = return (a ^. g)++(/^..) :: (Monad m, Foldable t, Monoid (m a)) => s -> Getting (t a) s (t a) -> m a+(/^..) a g = foldMap return (a ^. g)++(>>^.) :: Monad m => m a -> Getting b a b -> m b+(>>^.) q g = q >>= (/^. g)++(>>^..) :: (Monad m, Foldable t, Monoid (m a), Monoid (m b)) => m a -> Getting (t b) a (t b) -> m b+(>>^..) q g = q >>= (/^.. g)

@@ -1,12 +1,13 @@-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE ScopedTypeVariables #-}  module HaskellWorks.Data.Micro where -import qualified Data.DList                           as DL-import           Text.PrettyPrint.ANSI.Leijen+import Text.PrettyPrint.ANSI.Leijen +import qualified Data.DList as DL+ newtype Micro a = Micro a  prettyVs :: Pretty a => [a] -> Doc@@ -24,10 +25,10 @@   pretty (Micro xs) = case length xs of     xsLen | xsLen == 0    -> text "[]"     xsLen | xsLen <= 10   -> text "[" <> prettyVs xs <> text "]"-    _                     -> text "[" <> prettyVs (take 10 xs) <> text ", ..]"+    _     -> text "[" <> prettyVs (take 10 xs) <> text ", ..]"  instance Pretty a => Pretty (Micro (DL.DList a)) where   pretty (Micro dxs) = case DL.toList dxs of-    xs@(_:_:_:_:_:_:_:_:_:_:_:_:_)  -> text "[" <> prettyVs (take 50 xs) <> text ", ..]"-    []                              -> text "[]"-    xs                              -> text "[" <> prettyVs          xs  <> text "]"+    xs@(_:_:_:_:_:_:_:_:_:_:_:_:_) -> text "[" <> prettyVs (take 50 xs) <> text ", ..]"+    []                             -> text "[]"+    xs                             -> text "[" <> prettyVs          xs  <> text "]"

@@ -1,19 +1,20 @@-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE FlexibleInstances #-}  module HaskellWorks.Data.Mini where -import qualified Data.DList                           as DL-import           HaskellWorks.Data.AtLeastSize-import           HaskellWorks.Data.Micro-import           Text.PrettyPrint.ANSI.Leijen+import HaskellWorks.Data.AtLeastSize+import HaskellWorks.Data.Micro+import Text.PrettyPrint.ANSI.Leijen +import qualified Data.DList as DL+ newtype Mini a = Mini a  instance Pretty (Micro a) => Pretty (Mini [a]) where   pretty (Mini xs) | xs `atLeastSize` 11  = text "[" <> nest 2 (prettyVs (take 10 (Micro `map` xs))) <> text ", ..]"   pretty (Mini xs) | xs `atLeastSize` 1   = text "[" <> nest 2 (prettyVs (take 10 (Micro `map` xs))) <> text "]"-  pretty (Mini _ )                        = text "[]"+  pretty (Mini _ ) = text "[]"  instance Pretty (Mini a) => Pretty (Mini (DL.DList a)) where   pretty (Mini xs) = vcat (punctuate (text ",") ((pretty . Mini) `map` take 10 (DL.toList xs)))

@@ -1,23 +1,22 @@-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE FlexibleInstances #-}  module HaskellWorks.Data.Row where -import qualified Data.DList                   as DL-import           Text.PrettyPrint.ANSI.Leijen+import Text.PrettyPrint.ANSI.Leijen +import qualified Data.DList as DL+ type MaxChars = Int  data Row a = Row MaxChars a  instance Pretty a => Pretty (Row (DL.DList a)) where   pretty (Row maxChars xs) = vcat (((bold . yellow) (text "==> ") <>) `map` prettyRows)-    where-      prettyRows :: [Doc]-      prettyRows = (\row -> text (take maxChars (displayS (renderCompact (pretty row)) []))) `map` DL.toList xs+    where prettyRows :: [Doc]+          prettyRows = (\row -> text (take maxChars (displayS (renderCompact (pretty row)) []))) `map` DL.toList xs  prettyRowOfString :: Show a => Row (DL.DList a) -> Doc prettyRowOfString (Row _ xs) = vcat (((bold . yellow) (text "==> ") <>) `map` prettyRows)-  where-    prettyRows :: [Doc]-    prettyRows = (text . show) `map` DL.toList xs+  where prettyRows :: [Doc]+        prettyRows = (text . show) `map` DL.toList xs

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleContexts #-}  module HaskellWorks.Data.Shows where 

@@ -1,12 +1,36 @@ module HaskellWorks.Data.MQuerySpec (spec) where -import           Test.Hspec+import Control.Lens+import HaskellWorks.Data.Model.Example+import HaskellWorks.Data.MQuery+import HaskellWorks.Hspec.Hedgehog+import Hedgehog+import Test.Hspec +import qualified Data.DList                   as DL+import qualified Data.Foldable                as F+import qualified HaskellWorks.Data.Model.Lens as L+ {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}-{-# ANN module ("HLint: redundant bracket"          :: String) #-}+{-# ANN module ("HLint: ignore Redundant bracket"          :: String) #-}  spec :: Spec spec = describe "HaskellWorks.Data.MQuerySpec" $ do-  it "Stub" $ do-    1 `shouldBe` (1 :: Int)+  it "Select into simple lens to boolean field" $ requireProperty $ do+    let q = MQuery $ DL.fromList exampleMounts+    let actual = F.toList $ q >>^. L.readOnly+    actual === [True, False, False, False]+  it "Select into simple lens to list" $ requireProperty $ do+    let q = MQuery $ DL.fromList exampleMounts+    let actual = F.toList $ q >>^. L.options+    actual === [[], ["nosuid" , "noauto"], [], ["noexec"]]+  it "Select into lens to a foldable" $ requireProperty $ do+    let q = MQuery $ DL.fromList exampleMounts+    let actual = F.toList $ q >>^.. L.options+    actual === ["nosuid" , "noauto" , "noexec"]+  it "Select into lens to a foldable" $ requireProperty $ do+    let q = MQuery $ DL.fromList exampleMounts+    let actual = F.toList $ q <&> view L.options+    actual === [[] , ["nosuid" , "noauto"] , [] , ["noexec"]]+

@@ -0,0 +1,46 @@+module HaskellWorks.Data.Model.Example where++import HaskellWorks.Data.Model.Type++exampleMounts :: [Mount]+exampleMounts =+  [ Mount+    { mountPoint    = "/"+    , mountStorage  = StorageDisk+      { storageDevice = Just "/dev/sda1"+      , storageLabel  = Nothing+      }+    , mountFsType   = "btrfs"+    , mountReadOnly = True+    , mountOptions  = []+    }+  , Mount+    { mountPoint = "/var"+    , mountStorage = StorageDisk+      { storageLabel  = Just "8f3ba6f4-5c70-46ec-83af-0d5434953e5f"+      , storageDevice = Nothing+      }+    , mountFsType   = "ext4"+    , mountReadOnly = False+    , mountOptions  = ["nosuid", "noauto"]+    }+  , Mount+    { mountPoint    = ""+    , mountStorage = StorageTmpFs+      { storageSizeMB = 64+      }+    , mountFsType   = ""+    , mountReadOnly = False+    , mountOptions  = []+    }+  , Mount+    { mountPoint    = "/mypath"+    , mountStorage = StorageNfs+      { storageServer     = "my.nfs.server"+      , storageRemotePath = "/exports/mypath"+      }+    , mountFsType   = ""+    , mountReadOnly = False+    , mountOptions  = ["noexec"]+    }+  ]

@@ -0,0 +1,12 @@+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE TemplateHaskell        #-}++module HaskellWorks.Data.Model.Lens where++import Control.Lens+import HaskellWorks.Data.Model.Type++makeFields ''Storage+makeFields ''Mount

@@ -0,0 +1,46 @@+module HaskellWorks.Data.Model.Type where++data Storage+  = StorageDisk+    { storageDevice :: Maybe String+    , storageLabel  :: Maybe String+    }+  | StorageTmpFs+    { storageSizeMB :: Int+    }+  | StorageNfs+    { storageServer     :: String+    , storageRemotePath :: String+    } deriving (Eq, Show)++-- storageDisk :: Storage+-- storageDisk = Storage+--   { storageDevice = Nothing+--   , storageLabel  = Nothing+--   }++-- storageTmpFs :: Int -> StorageTmpFs+-- storageTmpFs = StorageTmpFs++-- storageNfs :: String -> String -> Storage+-- storageNfs server remotePath = StorageNfs+--   { storageServer     = server+--   , storageRemotePath = remotePath+--   }++data Mount = Mount+  { mountPoint    :: String+  , mountStorage  :: Storage+  , mountFsType   :: String+  , mountReadOnly :: Bool+  , mountOptions  :: [String]+  } deriving (Eq, Show)++-- mount :: String -> Storage -> String -> Mount+-- mount point storage fsType = MountPoint+--   { mountPoint    = point+--   , mountStorage  = storage+--   , mountFsType   = fsType+--   , mountReadOnly = False+--   , mountOptions  = []+--   }