packages feed

hw-mquery 0.0.0.1 → 0.1.0.0

raw patch · 12 files changed

+356/−173 lines, 12 filesdep +ansi-wl-pprintdep −arraydep −attoparsecdep −bytestringdep ~basenew-component:exe:hw-mquery-example

Dependencies added: ansi-wl-pprint

Dependencies removed: array, attoparsec, bytestring, conduit, containers, hw-bits, hw-conduit, hw-diagnostics, hw-json, hw-parser, hw-prim, hw-rankselect, mmap, mono-traversable, parsec, resourcet, text, transformers, vector, word8

Dependency ranges changed: base

Files

README.md view
@@ -2,9 +2,59 @@ [![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)  ```-λ> import HaskellWorks.Data.MQuery-λ> import qualified Data.DList as DL-λ> !json <- loadJsonPartial "data/78mb.json"-λ> let q = MQuery (DL.singleton json)-λ> q >>= expandArray >>= expandObject+import           Control.Monad+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"+let q = MQuery (DL.singleton json)+```++```+putPretty $ q >>= item & limit 10+putPretty $ q >>= item & page 10 1+putPretty $ q >>= item >>= hasKV "founded_year" (JsonPartialNumber 2005) & limit 10+putPretty $ q >>= item >>= entry+putPretty $ q >>= item >>= entry >>= named "name" & limit 10+putPretty $ q >>= item >>= entry >>= satisfying (\(k, _) -> k == "name") >>= value & limit 10+putPretty $ q >>= item >>= entry >>= satisfying ((== "name") . fst) >>= value & limit 10+putPretty $ q >>= (item >=> entry >=> key) & limit 10+putPretty $ q >>= item >>= entry >>= key & limit 100 & onList (uniq . sort)+putPretty $ (q >>= item >>= entry & limit 1) >>= field "name" & limit 10+putPretty $ do {j <- q; e <- item j; (k, v) <- entry e; return k}+putPretty $ do {j <- q; e <- item j; (k, v) <- entry e; guard (k == "name"); return v}+```++### Decoding+#### Line separated base 64 encoded gzipped json+while read in; do echo "$in" | base64 --decode | gunzip; echo ""; done < file.lgz > firehose.json++### Profiling with stack traces+```+mafia build -p+cabal repl --ghc-options='-fexternal-interpreter -prof'+```++```+import HaskellWorks.Data.Succinct.BalancedParens+import HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512+import HaskellWorks.Data.Positioning+import qualified Data.Vector.Storable as DVS+import HaskellWorks.Data.Vector.VectorLike+(jsonBS, jsonIb, jsonBp) <- loadJsonRawWithIndex "firehose.json"+let bp1 = SimpleBalancedParens jsonBp+let bp2 = SimpleBalancedParens (makePoppy512 jsonBp)+let bp3 = makePoppy512 jsonBp ```
+ app/Main.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++-- import           Control.Monad+-- import qualified Data.DList as DL+-- import           Data.Function+-- import           HaskellWorks.Data.LoadJson+-- import           HaskellWorks.Data.Micro+-- import           HaskellWorks.Data.MQuery++main :: IO ()+main = do+  putStrLn "Hello world"+  -- !json <- loadJsonWithPoppy512SMinMaxIndex "firehose.json"+  -- let q = MQuery (DL.singleton json)+  -- putPretty $ q >>= (+  --   item  >=> entry >=> named "attack"+  --         >=> entry >=> named "instances"+  --         >=> entry >=> named "instance"+  --         >=> item+  --         >=> entry >=> named "dataset"+  --         >=> item >=> having (entry >=> named "name") >=> having (entry >=> named "name" >=> asString >=> valueOf "protos_bytes")+  --         >=> entry >=> named "item"+  --         >=> item >=> having (entry >=> named "name" >=> asString >=> valueOf "tcp")+  --         >=> entry >=> named "class"+  --         >=> entry >=> named "current"+  --         >=> entry >=> named "value"+  --         >=> castAsInteger) & aggregate sum
hw-mquery.cabal view
@@ -1,5 +1,5 @@ name:                   hw-mquery-version:                0.0.0.1+version:                0.1.0.0 synopsis:               Conduits for tokenizing streams. description:            Please see README.md homepage:               http://github.com/haskell-works/hw-mquery#readme@@ -13,32 +13,28 @@ extra-source-files:     README.md cabal-version:          >= 1.22 +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+ library   hs-source-dirs:       src-  exposed-modules:      HaskellWorks.Data.LoadJson+  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+   build-depends:        base                          >= 4          && < 5-                      , array-                      , attoparsec-                      , bytestring-                      , conduit-                      , containers+                      , ansi-wl-pprint                       , dlist-                      , hw-bits-                      , hw-conduit-                      , hw-diagnostics-                      , hw-json-                      , hw-parser-                      , hw-prim                       >= 0.0.3.1-                      , hw-rankselect                 >= 0.0.0.5-                      , mmap-                      , mono-traversable-                      , resourcet-                      , text-                      , vector-                      , word8    default-language:     Haskell2010   ghc-options:          -Wall -O2 -msse4.2@@ -49,22 +45,8 @@   main-is:              Spec.hs   other-modules:        HaskellWorks.Data.MQuerySpec   build-depends:        base                          >= 4          && < 5-                      , attoparsec-                      , bytestring-                      , containers-                      , conduit                       , hspec-                      , hw-bits-                      , hw-conduit-                      , hw-mquery-                      , hw-prim                       >= 0.0.3.1-                      , hw-rankselect                 >= 0.0.0.5-                      , mmap-                      , parsec                       , QuickCheck-                      , resourcet-                      , transformers-                      , vector   ghc-options:          -threaded -rtsopts -with-rtsopts=-N -Wall   default-language:     Haskell2010
+ src/HaskellWorks/Data/AtLeastSize.hs view
@@ -0,0 +1,10 @@++module HaskellWorks.Data.AtLeastSize where++class AtLeastSize a where+  atLeastSize :: a -> Int -> Bool++instance AtLeastSize [a] where+  atLeastSize  _      0         = True+  atLeastSize (_:as)  n | n > 0 = atLeastSize as (n - 1)+  atLeastSize  _      _         = False
+ src/HaskellWorks/Data/Entry.hs view
@@ -0,0 +1,8 @@+module HaskellWorks.Data.Entry where++import           Text.PrettyPrint.ANSI.Leijen++data Entry k v = Entry k v++instance (Pretty k, Pretty v) => Pretty (Entry k v) where+  pretty (Entry k v) = pretty k <> text ": " <> pretty v
− src/HaskellWorks/Data/LoadJson.hs 
@@ -1,40 +0,0 @@-{-# LANGUAGE BangPatterns               #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE ScopedTypeVariables        #-}--module HaskellWorks.Data.LoadJson where--import           Control.Monad-import qualified Data.ByteString                                  as BS-import qualified Data.Vector.Storable                             as DVS-import           Data.Word-import           HaskellWorks.Data.Bits.BitShown-import           HaskellWorks.Data.Decode-import           HaskellWorks.Data.FromByteString-import           HaskellWorks.Data.Json.PartialValue-import           HaskellWorks.Data.Json.Succinct.Cursor-import           HaskellWorks.Data.Json.Succinct.Index-import           HaskellWorks.Data.Json.Succinct.PartialIndex-import           HaskellWorks.Data.Json.Value-import           HaskellWorks.Data.Succinct.BalancedParens.Simple-import           HaskellWorks.Diagnostics.Time--readJson :: String -> IO (JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))-readJson path = do-  bs <- BS.readFile path-  putStrLn "Read file"-  !cursor <- measure (fromByteString bs :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))-  putStrLn "Created cursor"-  return cursor--loadJson :: String -> IO (Either DecodeError [JsonValue])-loadJson filename = do-  !cursor <- readJson filename-  let !jsonResult = (jsonIndexAt >=> jsonValueAt) cursor-  return $ (:[]) `fmap` jsonResult--loadJsonPartial :: String -> IO JsonPartialValue-loadJsonPartial filename = do-  !cursor <- readJson filename-  let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor)-  return jsonResult
src/HaskellWorks/Data/MQuery.hs view
@@ -2,14 +2,19 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TypeFamilies               #-}  module HaskellWorks.Data.MQuery where  import           Control.Monad+import           Data.List import qualified Data.DList                           as DL import           GHC.Base-import           HaskellWorks.Data.Json.PartialValue-import           HaskellWorks.Data.Mini+import           HaskellWorks.Data.Entry+-- import           HaskellWorks.Data.Json.PartialValue+import           HaskellWorks.Data.Row+import           HaskellWorks.Data.ToBool+import           Text.PrettyPrint.ANSI.Leijen  newtype MQuery a = MQuery (DL.DList a) @@ -19,39 +24,123 @@ deriving instance Alternative MQuery deriving instance MonadPlus   MQuery -instance Show (MQuery JsonPartialValue) where-  showsPrec _ (MQuery das) = shows (Mini (Mini `fmap` das))+class IsPredicate a where+  type ArgOf a+  toPredicate :: ArgOf a -> (a -> Bool) -instance Show (MQuery (String, JsonPartialValue)) where-  showsPrec _ (MQuery das) = shows (Mini (Mini `fmap` das))+mQuery :: MQuery a -> DL.DList a+mQuery (MQuery a) = a -expandArray :: JsonPartialValue -> MQuery JsonPartialValue-expandArray jpv = case jpv of-  JsonPartialArray es -> MQuery $ DL.fromList es-  _                   -> MQuery   DL.empty+instance ToBool (MQuery a) where+  toBool = toBool . mQuery -expandObject :: JsonPartialValue -> MQuery (String, JsonPartialValue)-expandObject jpv = case jpv of-  JsonPartialObject fs  -> MQuery $ DL.fromList fs-  _                     -> MQuery   DL.empty+-- instance Pretty (MQuery JsonPartialValue) where+--   pretty = pretty . Row 120 . mQuery -selectField :: String -> (String, JsonPartialValue) -> MQuery JsonPartialValue-selectField fieldName (fieldName', jpv) | fieldName == fieldName' = MQuery $ DL.singleton jpv-selectField _         _                                           = MQuery   DL.empty+instance Pretty (MQuery String) where+  pretty x = prettyRowOfString (Row 120 (mQuery x)) -jsonKeys :: JsonPartialValue -> [String]-jsonKeys jpv = case jpv of-  JsonPartialObject fs  -> fst `map` fs-  _                     -> []+instance Pretty (MQuery Integer) where+  pretty x = prettyRowOfString (Row 120 (mQuery x)) -hasKey :: String -> JsonPartialValue -> Bool-hasKey fieldName jpv = fieldName `elem` jsonKeys jpv+instance Pretty (MQuery Int) where+  pretty x = prettyRowOfString (Row 120 (mQuery x)) -inArray :: MQuery JsonPartialValue -> MQuery JsonPartialValue-inArray jpvs = jpvs >>= expandArray+-- instance Pretty (MQuery (Entry String JsonPartialValue)) where+--   pretty (MQuery das) = pretty (Row 120 das)+--+-- hasKV :: String -> JsonPartialValue -> JsonPartialValue -> MQuery JsonPartialValue+-- hasKV k v (JsonPartialObject xs)  = if (k, v) `elem` xs then MQuery (DL.singleton (JsonPartialObject xs)) else MQuery DL.empty+-- hasKV _ _  _                      = MQuery DL.empty+--+-- item :: JsonPartialValue -> MQuery JsonPartialValue+-- item jpv = case jpv of+--   JsonPartialArray es -> MQuery $ DL.fromList es+--   _                   -> MQuery   DL.empty+--+-- entry :: JsonPartialValue -> MQuery (Entry String JsonPartialValue)+-- entry jpv = case jpv of+--   JsonPartialObject fs  -> MQuery $ DL.fromList (uncurry Entry `map` fs)+--   _                     -> MQuery   DL.empty+--+-- asString :: JsonPartialValue -> MQuery String+-- asString jpv = case jpv of+--   JsonPartialString s -> MQuery $ DL.singleton s+--   _                   -> MQuery   DL.empty+--+-- asInteger :: JsonPartialValue -> MQuery Integer+-- asInteger jpv = case jpv of+--   JsonPartialNumber n -> MQuery $ DL.singleton (floor n)+--   _                   -> MQuery   DL.empty+--+-- castAsInteger :: JsonPartialValue -> MQuery Integer+-- castAsInteger jpv = case jpv of+--   JsonPartialString n -> MQuery $ DL.singleton (read n)+--   JsonPartialNumber n -> MQuery $ DL.singleton (floor n)+--   _                   -> MQuery   DL.empty+--+-- named :: String -> Entry String JsonPartialValue -> MQuery JsonPartialValue+-- named fieldName (Entry fieldName' jpv) | fieldName == fieldName'  = MQuery $ DL.singleton jpv+-- named _         _                                                 = MQuery   DL.empty -jsonSize :: JsonPartialValue -> MQuery JsonPartialValue-jsonSize jpv = case jpv of-  JsonPartialArray  es  -> MQuery (DL.singleton (JsonPartialNumber (fromIntegral (length es))))-  JsonPartialObject es  -> MQuery (DL.singleton (JsonPartialNumber (fromIntegral (length es))))-  _                     -> MQuery (DL.singleton (JsonPartialNumber 0))+satisfying :: (a -> Bool) -> a -> MQuery a+satisfying p a | p a  = MQuery $ DL.singleton a+satisfying _ _        = MQuery   DL.empty++key :: Entry k v -> MQuery k+key (Entry k _) = MQuery $ DL.singleton k++value :: Entry k v -> MQuery v+value (Entry _ v) = MQuery $ DL.singleton v++dlTake :: Int -> DL.DList a -> DL.DList a+dlTake n = DL.fromList . take n . DL.toList++select :: ToBool b => a -> (a -> b) -> MQuery a+select a f = if toBool (f a) then MQuery (DL.singleton a) else MQuery DL.empty++-- jsonKeys :: JsonPartialValue -> [String]+-- jsonKeys jpv = case jpv of+--   JsonPartialObject fs  -> fst `map` fs+--   _                     -> []+--+-- hasKey :: String -> JsonPartialValue -> Bool+-- hasKey fieldName jpv = fieldName `elem` jsonKeys jpv+--+-- jsonSize :: JsonPartialValue -> MQuery JsonPartialValue+-- jsonSize jpv = case jpv of+--   JsonPartialArray  es  -> MQuery (DL.singleton (JsonPartialNumber (fromIntegral (length es))))+--   JsonPartialObject es  -> MQuery (DL.singleton (JsonPartialNumber (fromIntegral (length es))))+--   _                     -> MQuery (DL.singleton (JsonPartialNumber 0))++having :: (a -> MQuery b) -> a -> MQuery a+having p a = case p a of+  MQuery das -> case DL.toList das of+    _:_ -> MQuery (DL.singleton a)+    _   -> MQuery  DL.empty++valueOf :: Eq a => a -> a -> MQuery a+valueOf a b = if a == b then MQuery (DL.singleton b) else MQuery DL.empty++limit :: Int -> MQuery a -> MQuery a+limit n (MQuery xs) = MQuery ((DL.fromList . take n . DL.toList) xs)++skip :: Int -> MQuery a -> MQuery a+skip n (MQuery xs) = MQuery ((DL.fromList . drop n . DL.toList) xs)++page :: Int -> Int -> MQuery a -> MQuery a+page size n (MQuery xs) = MQuery ((DL.fromList . take size . drop (size * n) . DL.toList) xs)++sorted :: Ord a => MQuery a -> MQuery a+sorted (MQuery xs) = MQuery ((DL.fromList . sort . DL.toList) xs)++onList :: ([a] -> [a]) -> MQuery a -> MQuery a+onList f (MQuery xs) = MQuery ((DL.fromList . f . DL.toList) xs)++aggregate :: ([a] -> b) -> MQuery a -> MQuery b+aggregate f (MQuery xs) = MQuery (DL.fromList [f (DL.toList xs)])++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
src/HaskellWorks/Data/Micro.hs view
@@ -1,37 +1,48 @@ {-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE ScopedTypeVariables        #-}  module HaskellWorks.Data.Micro where  import qualified Data.DList                           as DL-import           Data.List-import           HaskellWorks.Data.Json.PartialValue+-- import           HaskellWorks.Data.Json.PartialValue+import           Text.PrettyPrint.ANSI.Leijen  newtype Micro a = Micro a -instance Show (Micro JsonPartialValue) where-  showsPrec _ v = case v of-    Micro (JsonPartialString s ) -> shows s-    Micro (JsonPartialNumber n ) -> shows n-    Micro (JsonPartialObject []) -> ("{}" ++)-    Micro (JsonPartialObject _ ) -> ("{..}" ++)-    Micro (JsonPartialArray [] ) -> ("[]" ++)-    Micro (JsonPartialArray _  ) -> ("[..]" ++)-    Micro (JsonPartialBool w   ) -> shows w-    Micro  JsonPartialNull       -> ("null" ++)-    Micro (JsonPartialError s  ) -> ("<error " ++) . shows s . (">" ++)+prettyVs :: Pretty a => [a] -> Doc+prettyVs (kv:kvs) = pretty kv <> foldl (<>) empty ((\jv -> text ", " <> pretty jv) `map` kvs)+prettyVs []       = empty -instance Show (Micro (String, JsonPartialValue)) where-  showsPrec _ (Micro (fieldName, jpv)) = shows fieldName . (": " ++) . shows (Micro jpv)+putPretty :: Pretty a => a -> IO ()+putPretty a = putDoc (pretty a <> hardline) -instance Show a => Show (Micro [a]) where-  show (Micro xs) = case length xs of-    xsLen | xsLen == 0    -> "[]"-    xsLen | xsLen <= 50   -> "[" ++ intercalate ", " (show `map` xs) ++ "]"-    _                     -> "[" ++ intercalate ", " (show `map` take 50 xs) ++ ", ..]"+prettyKvs :: Pretty (Micro a) => [a] -> Doc+prettyKvs (kv:kvs) = pretty (Micro kv) <> foldl (<>) empty ((\jv -> text ", " <> pretty (Micro jv)) `map` kvs)+prettyKvs []       = empty -instance Show a => Show (Micro (DL.DList a)) where-  showsPrec _ (Micro dxs) = case DL.toList dxs of-    xs@(_:_:_:_:_:_:_:_:_:_:_:_:_)  -> (("[" ++ intercalate ", " (show `map` take 50 xs) ++ ", ..]") ++)-    []                              -> ("[]" ++)-    xs                              -> (("[" ++ intercalate ", " (show `map` xs) ++ "]") ++)+-- instance Pretty (Micro JsonPartialValue) where+--   pretty (Micro (JsonPartialString s )) = dullgreen (text (show s))+--   pretty (Micro (JsonPartialNumber n )) = cyan      (text (show n))+--   pretty (Micro (JsonPartialObject [])) = text "{}"+--   pretty (Micro (JsonPartialObject _ )) = text "{..}"+--   pretty (Micro (JsonPartialArray [] )) = text "[]"+--   pretty (Micro (JsonPartialArray _  )) = text "[..]"+--   pretty (Micro (JsonPartialBool w   )) = red (text (show w))+--   pretty (Micro  JsonPartialNull      ) = text "null"+--   pretty (Micro (JsonPartialError s  )) = text "<error " <> text s <> text ">"+--+-- instance Pretty (Micro (String, JsonPartialValue)) where+--   pretty (Micro (fieldName, jpv)) = red (text (show fieldName)) <> text ": " <> pretty (Micro jpv)++instance Pretty a => Pretty (Micro [a]) where+  pretty (Micro xs) = case length xs of+    xsLen | xsLen == 0    -> text "[]"+    xsLen | xsLen <= 10   -> text "[" <> prettyVs 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 "]"
src/HaskellWorks/Data/Mini.hs view
@@ -1,50 +1,40 @@+{-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE ScopedTypeVariables        #-}  module HaskellWorks.Data.Mini where  import qualified Data.DList                           as DL-import           Data.List-import           HaskellWorks.Data.Json.PartialValue+import           HaskellWorks.Data.AtLeastSize+-- import           HaskellWorks.Data.Json.PartialValue import           HaskellWorks.Data.Micro+import           Text.PrettyPrint.ANSI.Leijen  newtype Mini a = Mini a -instance Show a => Show (Mini [a]) where-  show (Mini xs) = case length xs of-    xsLen | xsLen == 0    -> "[]"-    xsLen | xsLen <= 50   -> "[" ++ intercalate ", " (show `map` xs) ++ "]"-    _                     -> "[" ++ intercalate ", " (show `map` take 50 xs) ++ ", ..]"--instance Show a => Show (Mini (DL.DList a)) where-  showsPrec _ (Mini dxs) = case DL.toList dxs of-    xs@(_:_:_:_:_:_:_:_:_:_:_:_:_)  -> (("[" ++ intercalate ", " (show `map` take 50 xs) ++ ", ..]") ++)-    []                              -> ("[]" ++)-    xs                              -> (("[" ++ intercalate ", " (show `map` xs) ++ "]") ++)+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 "[]" -instance Show (Mini JsonPartialValue) where-  showsPrec _ mjpv = case mjpv of-    Mini (JsonPartialString s   ) -> shows s-    Mini (JsonPartialNumber n   ) -> shows n-    Mini (JsonPartialObject []  ) -> ("{}" ++)-    Mini (JsonPartialObject kvs ) -> case kvs of-      (_:_:_:_:_:_:_:_:_:_:_:_:_) -> ("{" ++) . showKvs kvs . (", ..}" ++)-      []                          -> ("{}" ++)-      _                           -> ("{" ++) . showKvs kvs . ("}" ++)-    Mini (JsonPartialArray []   ) -> ("[]" ++)-    Mini (JsonPartialArray vs   ) -> case vs of-      (_:_:_:_:_:_:_:_:_:_:_:_:_) -> ("[" ++) . showVs vs . (", ..]" ++)-      []                          -> ("[]" ++)-      _                           -> ("[" ++) . showVs vs . ("]" ++)-    Mini (JsonPartialBool w     ) -> shows w-    Mini  JsonPartialNull         -> ("null" ++)-    Mini (JsonPartialError s    ) -> ("<error " ++) . shows s . (">" ++)-    where showKvs :: [(String, JsonPartialValue)] -> String -> String-          showKvs (kv:kvs) = shows (Micro kv) . foldl (.) id ((\jv -> (", " ++) . shows (Micro jv)) `map` kvs)-          showKvs []       = id-          showVs :: [JsonPartialValue] -> String -> String-          showVs (kv:kvs) = shows (Micro kv) . foldl (.) id ((\jv -> (", " ++) . shows (Micro jv)) `map` kvs)-          showVs []       = id+instance Pretty (Mini a) => Pretty (Mini (DL.DList a)) where+  pretty (Mini xs) = vcat (punctuate (text ",") ((pretty . Mini) `map` take 10 (DL.toList xs))) -instance Show (Mini (String, JsonPartialValue)) where-  showsPrec _ (Mini (fieldName, jpv)) = shows fieldName . (": " ++) . shows (Mini jpv)+-- instance Pretty (Mini JsonPartialValue) where+--   pretty mjpv = case mjpv of+--     Mini (JsonPartialString s   ) -> dullgreen  (text (show s))+--     Mini (JsonPartialNumber n   ) -> cyan       (text (show n))+--     Mini (JsonPartialObject []  ) -> text "{}"+--     Mini (JsonPartialObject kvs ) -> case kvs of+--       (_:_:_:_:_:_:_:_:_:_:_:_:_) -> text "{" <> prettyKvs kvs <> text ", ..}"+--       []                          -> text "{}"+--       _                           -> text "{" <> prettyKvs kvs <> text "}"+--     Mini (JsonPartialArray []   ) -> text "[]"+--     Mini (JsonPartialArray vs   ) | vs `atLeastSize` 11 -> text "[" <> nest 2 (prettyVs (Micro `map` take 10 vs)) <> text ", ..]"+--     Mini (JsonPartialArray vs   ) | vs `atLeastSize` 1  -> text "[" <> nest 2 (prettyVs (Micro `map` take 10 vs)) <> text "]"+--     Mini (JsonPartialArray _    )                       -> text "[]"+--     Mini (JsonPartialBool w     ) -> red (text (show w))+--     Mini  JsonPartialNull         -> text "null"+--     Mini (JsonPartialError s    ) -> text "<error " <> text s <> text ">"+--+-- instance Pretty (Mini (String, JsonPartialValue)) where+--   pretty (Mini (fieldName, jpv)) = text (show fieldName) <> text ": " <> pretty (Mini jpv)
+ src/HaskellWorks/Data/Row.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}++module HaskellWorks.Data.Row where++import qualified Data.DList                   as DL+import           Text.PrettyPrint.ANSI.Leijen++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++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
+ src/HaskellWorks/Data/Shows.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE FlexibleContexts           #-}++module HaskellWorks.Data.Shows where++import HaskellWorks.Data.Micro++showsVs :: Show a => [a] -> String -> String+showsVs (kv:kvs) = shows kv . foldl (.) id ((\jv -> (", " ++) . shows jv) `map` kvs)+showsVs []       = id++showKvs :: Show (Micro a) => [a] -> String -> String+showKvs (kv:kvs) = shows (Micro kv) . foldl (.) id ((\jv -> (", " ++) . shows (Micro jv)) `map` kvs)+showKvs []       = id
+ src/HaskellWorks/Data/ToBool.hs view
@@ -0,0 +1,17 @@++module HaskellWorks.Data.ToBool where++import qualified Data.DList as DL++class ToBool a where+  toBool :: a -> Bool++instance ToBool Bool where+  toBool = id++instance ToBool [a] where+  toBool (_:_)  = True+  toBool    _   = False++instance ToBool (DL.DList a) where+  toBool = toBool . DL.toList