smap (empty) → 0.1.0

raw patch · 9 files changed

+546/−0 lines, 9 filesdep +attoparsecdep +basedep +bytestringsetup-changed

Dependencies added: attoparsec, base, bytestring, hashable, optparse-applicative, resourcet, siphash, smap, streaming, streaming-bytestring, strict, text, transformers, unordered-containers

Files

• ChangeLog.md +3/−0
• LICENSE +30/−0
• README.md +150/−0
• Setup.hs +2/−0
• app/Main.hs +7/−0
• smap.cabal +105/−0
• src/Smap/Commands.hs +116/−0
• src/Smap/Flags.hs +131/−0
• test/Spec.hs +2/−0

@@ -0,0 +1,3 @@+# Changelog for smap++## Unreleased changes

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2019++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 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.

@@ -0,0 +1,150 @@+# smap - a command line tool for sets and maps++## Installation:++To install from Hackage, run:++```bash+cabal install smap+```++To install from source, you can use that or download this repo and run++```bash+stack install smap+```++You will need [cabal](https://www.haskell.org/cabal/) or [stack](https://www.haskellstack.org) if you don't already have one of them. ++## Tutorial:++The setup:++```bash+cat > patients << EOF+Bob Smith+Jane Doe+John Smith+Carol Carell+EOF++cat > has_cold << EOF+Jane Doe+John Smith+EOF++cat > has_mumps << EOF+Jane Doe+Carol Carell+EOF+```++### Simple usage (sets)++#### cat - Set Union (and Deduplication)++Sick patients:++```bash+$ smap cat has_cold has_mumps+Jane Doe+John Smith+Carol Carell+```++You can also use `-` instead of a filename to represent stdin/stdout. (This works for any command.)++```bash+$ cat has_cold | smap cat - has_mumps+Jane Doe+John Smith+Carol Carell+```++If you don't provide any arguments, `cat` will assume you mean stdin.++```bash+$ cat has_cold has_mumps | smap cat+Jane Doe+John Smith+Carol Carell+```++#### sub - Set subtraction++Healthy patients:++```bash+$ smap sub patients has_cold has_mumps+Bob Smith+```++#### int - Set intersection++Patients with both a cold and mumps:++```bash+$ smap int has_cold has_mumps+Jane Doe+```++#### xor - Symmetric difference++Patients who only have a cold or mumps, but not both:++```bash+$ smap xor has_cold has_mumps+Carol Carell+John Smith+```++### Advanced usage (maps)++When using `smap` with sets, the behavior is pretty straightforward. It gets a bit more complicated when+dealing with maps.++If you provide `smap` with a filepath, it will construct a map where the keys equal the values. (This+is equivalent to a set). If you pass in `+file1,file2` +as an argument, `smap` will construct a map using lines from file1 as keys and lines from file2 as values. ++We can get a list of patient last names using `cut -f 2 -d ' ' <patient file>`++#### Pick one patient from each family:++```bash+$ smap cat +<(cut -f 2 -d ' ' patients),patients+Bob Smith+Jane Doe+Carol Carell+```++To understand the above:++* `<(cut -f 2 -d ' ' patients)` gets a list of all the patients' last names and creates a virtual file with this list. See [bash process substitution](https://www.tldp.org/LDP/abs/html/process-sub.html).+* `+<(cut -f 2 -d ' ' patients),patients` constructs a stream where the keys are the last names and the values are the whole names.++`cat` deduplicates by key, so if we see a second (or third, or fourth, etc.) person from a given family we don't print them out.+++#### Patients who have family members with a cold:++```bash+$ smap int +<(cut -f 2 -d ' ' patients),patients <(cut -f 2 -d ' ' has_cold)+Bob Smith+Jane Doe+John Smith+```++To understand the above:++* `<(cut -f 2 -d ' ' patients)` gets a list of all the patients' last names.+* `+<(cut -f 2 -d ' ' patients),patients` constructs a stream where the keys are the last names and the values are the whole names.+* `<(cut -f 2 -d ' ' has_cold)` gets a list of family names of everyone who has a cold.++So `int` is filtering the first argument (treated as a `key,value` stream) by the keys present in the second argument.++### Approximate mode++If you're processing lots of lines and running up against memory limits, +you can use the `--approximate` option to keep track of a 64-bit hash +of each line instead of the entire line.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,7 @@+module Main where++import Smap.Commands (run)+import Smap.Flags (command)++main :: IO ()+main = run =<< command

@@ -0,0 +1,105 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: f9b3c8428fd796fc574a982c19dc5a090f0a419b37f6c465b3466cea621b02fc++name:           smap+version:        0.1.0+synopsis:       A command line tool for working with sets and maps+description:    Please see the README on GitHub at <https://github.com/wyager/smap>+category:       Text+homepage:       https://github.com/wyager/smap#readme+bug-reports:    https://github.com/wyager/smap/issues+author:         Will Yager+maintainer:     will@yager.io+copyright:      2019 Will Yager+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/wyager/smap++library+  exposed-modules:+      Smap.Commands+      Smap.Flags+  other-modules:+      Paths_smap+  hs-source-dirs:+      src+  default-extensions: TupleSections RankNTypes ScopedTypeVariables LambdaCase BangPatterns+  ghc-options: -O2 -Wall -fexpose-all-unfoldings -optP-Wno-nonportable-include-path+  build-depends:+      attoparsec+    , base >=4.7 && <5+    , bytestring+    , hashable+    , optparse-applicative+    , resourcet+    , siphash+    , streaming+    , streaming-bytestring+    , strict+    , text+    , transformers+    , unordered-containers+  default-language: Haskell2010++executable smap+  main-is: Main.hs+  other-modules:+      Paths_smap+  hs-source-dirs:+      app+  default-extensions: TupleSections RankNTypes ScopedTypeVariables LambdaCase BangPatterns+  ghc-options: -rtsopts -Wall -O2 -fspecialize-aggressively -optP-Wno-nonportable-include-path+  build-depends:+      attoparsec+    , base >=4.7 && <5+    , bytestring+    , hashable+    , optparse-applicative+    , resourcet+    , siphash+    , smap+    , streaming+    , streaming-bytestring+    , strict+    , text+    , transformers+    , unordered-containers+  default-language: Haskell2010++test-suite smap-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_smap+  hs-source-dirs:+      test+  default-extensions: TupleSections RankNTypes ScopedTypeVariables LambdaCase BangPatterns+  ghc-options: -rtsopts+  build-depends:+      attoparsec+    , base >=4.7 && <5+    , bytestring+    , hashable+    , optparse-applicative+    , resourcet+    , siphash+    , smap+    , streaming+    , streaming-bytestring+    , strict+    , text+    , transformers+    , unordered-containers+  default-language: Haskell2010

@@ -0,0 +1,116 @@+module Smap.Commands (run) where++import Prelude hiding (filter, subtract, init, sin)+import qualified Data.HashMap.Strict as Map (insert, empty, foldrWithKey, alter, member)+import Data.HashMap.Strict as Map (HashMap)+import Data.Hashable (Hashable)+import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Streaming.Char8 as BS8+import qualified Streaming.Prelude as P+import qualified Streaming as S+import Control.Monad (foldM)+import Control.Monad.Trans.Class (lift)+import Data.Strict.Tuple (Pair((:!:)))+import qualified Control.Monad.Trans.Resource as Resource+import Control.Monad.IO.Class (MonadIO)+import Crypto.MAC.SipHash (SipKey(..), SipHash(..), hash)+import Data.Word (Word64)+import Smap.Flags+  ( Hdl(Std, File)+  , SetDescriptor(Keyed, UnKeyed)+  , Command(Union, Subtract, Intersect, Xor)+  , Accuracy(Approximate, Exact)+  )++force :: Monad m => S.Stream (BS8.ByteString m) m r -> S.Stream (S.Of ByteString) m r+force = S.mapsM BS8.toStrict++duplicate :: forall a m . Monad m => S.Stream (S.Of a) m () -> Stream m a a+duplicate = P.map (\x -> x :!: x)++type Stream m k v = S.Stream (S.Of (Pair k v)) m ()++type SetOperation+  =  forall k+   . (Hashable k, Eq k)+  => [Stream (Resource.ResourceT IO) k ByteString] -- Input maps+  -> Stream (Resource.ResourceT IO) k ByteString -- Output map++cat :: SetOperation+cat streams = foldM filter Map.empty streams *> return ()+ where+  filter seen = P.foldM_ filter' (return seen) return . S.hoist lift+   -- for some strange reason I can't import alterF from Data.HashMap.Strict+  filter' (seen :: HashMap k ()) (bs :!: v) = +    if bs `Map.member` seen+      then return seen+      else P.yield (bs :!: v) >> return (Map.insert bs () seen)++filterFirstSetWith :: (Bool -> Bool) -> SetOperation+filterFirstSetWith _                []           = return ()+filterFirstSetWith includeIfPresent (first : seconds) = do+  subtract <- lift $ collects seconds+  P.filter (\(k :!: _) -> includeIfPresent (k `Map.member` subtract)) first+ where+  collects = foldM collect Map.empty+  collect subs = P.fold_ (\s (k :!: _) -> Map.insert k () s) subs id++sub :: SetOperation+sub = filterFirstSetWith not++intersect :: SetOperation+intersect = filterFirstSetWith id++xor :: SetOperation+xor = go Map.empty+ where+  go parity []       = Map.foldrWithKey (\k v -> (P.yield (k :!: v) >>)) (return ()) parity+  go parity (x : xs) = do+    parity' <- lift $ P.fold_ toggle parity id x+    go parity' xs+    where toggle hm (k :!: v) = Map.alter (maybe (Just v) (const Nothing)) k hm+++keyMap :: Monad m => (k1 -> k2) -> Stream m k1 v -> Stream m k2 v+keyMap f = P.map (\(k :!: v) -> (f k :!: v))++sip :: SipKey -> ByteString -> Word64+sip key bs = let SipHash h = hash key bs in h++hin :: (MonadIO m, Resource.MonadResource m) => Hdl -> BS8.ByteString m ()+hin Std         = BS8.stdin+hin (File path) = BS8.readFile path++sin :: (MonadIO m, Resource.MonadResource m) => SetDescriptor -> Stream m ByteString ByteString+sin (UnKeyed hdl  ) = duplicate $ force $ BS8.lines $ hin hdl+sin (Keyed hks hvs) = S.zipsWith'+  (\q (k P.:> ks) (v P.:> vs) -> (k :!: v) P.:> (q ks vs))+  (f hks)+  (f hvs)+  where f = force . BS8.lines . hin++hout :: (MonadIO m, Resource.MonadResource m) => Hdl -> BS8.ByteString m a -> m a+hout Std         = BS8.stdout+hout (File path) = BS8.writeFile path++format :: Monad m => Stream m k ByteString -> BS8.ByteString m ()+format = BS8.unlines . S.maps (\((_k :!: v) P.:> r) -> BS8.fromStrict v >> return r)++run :: Command -> IO ()+run cmd = case cmd of+  Subtract accuracy p ms o -> withAccuracy accuracy sub (p : ms) o+  Intersect accuracy is o  -> withAccuracy accuracy intersect is o+  Xor       accuracy is o  -> withAccuracy accuracy xor is o+  Union     accuracy is o  -> withAccuracy accuracy cat inputs o+   where+    inputs = case is of+      [] -> [UnKeyed Std]+      xs -> xs+ where+  withAccuracy accuracy (op :: SetOperation) inputs output = case accuracy of+    Exact           -> approximateWith id+    Approximate key -> approximateWith (sip key)+   where+    approximateWith approximator =+      Resource.runResourceT $ hout output $ format $ op $ fmap (keyMap approximator . sin) inputs+

@@ -0,0 +1,131 @@+module Smap.Flags+  ( Hdl(Std, File)+  , SetDescriptor(Keyed, UnKeyed)+  , Command(Union, Subtract, Intersect, Xor)+  , Accuracy(Approximate, Exact)+  , command+  )+where++import qualified Data.Attoparsec.Text as A+import qualified Data.Text as Text+import qualified Options.Applicative as O+import Control.Applicative (many, (<|>))+import Crypto.MAC.SipHash (SipKey(..))++data Hdl = Std -- stdin/stdout+         | File FilePath++data SetDescriptor = Keyed Hdl Hdl -- Keys are in the first file, values in the second (map behavior)+                   | UnKeyed Hdl -- key = value (set behavior)++data Accuracy = Approximate SipKey -- Don't keep the actual value as a key, just its hash+              | Exact -- Keep the actual value as a key++data Command = Union Accuracy [SetDescriptor] Hdl+             | Subtract Accuracy SetDescriptor [SetDescriptor] Hdl+             | Intersect Accuracy [SetDescriptor] Hdl+             | Xor Accuracy [SetDescriptor] Hdl++hdl :: A.Parser Hdl+hdl = stdin <|> path+ where+  stdin = Std <$ A.char '-'+  path  = File . Text.unpack <$> A.takeWhile (/= ',')++setExplanation :: String+setExplanation = "Use '-' for stdin. Use +keyfile,valfile for separate keys and values."++multiSetExplanation :: String+multiSetExplanation = "Can specify 0 or more files. " ++ setExplanation++outHdl :: O.Parser Hdl+outHdl = O.option+  (aToO hdl)+  (O.metavar "OUTFILE" <> O.short 'o' <> O.long "out" <> O.value Std <> O.help "Defaults to stdout."+  )++inFiles :: O.Parser [SetDescriptor]+inFiles = many $ O.argument (aToO setDescriptor) (O.metavar "FILE*" <> O.help multiSetExplanation)++setDescriptor :: A.Parser SetDescriptor+setDescriptor =+  (keyed <|> unkeyed)+    <*    (A.endOfInput A.<?> "more filepath characters than expected")+    A.<?> "Could not parse filepath"+ where+  unkeyed = UnKeyed <$> hdl+  keyed   = do+    _ <- A.char '+'+    k <- hdl+    _ <- A.char ','+    v <- hdl+    return (Keyed k v)++aToO :: A.Parser a -> O.ReadM a+aToO p = O.eitherReader (A.parseOnly p . Text.pack)++accuracy :: O.Parser Accuracy+accuracy = approx <|> exact+ where+  approx = O.flag'+    (Approximate (SipKey 0 0))+    (O.short 'a' <> O.long "approximate" <> O.help+      (concat+        [ "For deduplication, store a 64-bit siphash rather than the whole line. "+        , "Can save memory, depending on the set operation"+        ]+      )+    )+  exact = pure Exact++catCommand :: O.Mod O.CommandFields Command+catCommand = O.command "cat" $ O.info+  (value O.<**> O.helper)+  (O.fullDesc <> O.progDesc "Set union. Output everything from the input sets, deduplicated.")+  where value = Union <$> accuracy <*> inFiles <*> outHdl++subCommand :: O.Mod O.CommandFields Command+subCommand = O.command "sub" $ O.info+  (value O.<**> O.helper)+  (O.fullDesc <> O.progDesc+    (concat+      [ "Set subtraction. "+      , "Given stream A and sets B,C,..., output values in A but not in B,C,... "+      , "Does not deduplicate values from A."+      ]+    )+  )+ where+  value = Subtract <$> accuracy <*> plus <*> minuses <*> outHdl+  plus  = O.argument (aToO setDescriptor) (O.metavar "PLUSFILE" <> O.help setExplanation)+  minuses =+    many $ O.argument (aToO setDescriptor) (O.metavar "MINUSFILE*" <> O.help multiSetExplanation)++intersectCommand :: O.Mod O.CommandFields Command+intersectCommand = O.command "int" $ O.info+  (value O.<**> O.helper)+  (O.fullDesc <> O.progDesc+    "Set intersection. Output values which are in all input sets. Deduplicates values."+  )+  where value = Intersect <$> accuracy <*> inFiles <*> outHdl++xorCommand :: O.Mod O.CommandFields Command+xorCommand = O.command "xor" $ O.info+  (value O.<**> O.helper)+  (O.fullDesc <> O.progDesc+    (concat+      [ "Set xor/symmetric difference. "+      , "Given files A and B, output all values which are A or B but not both. "+      , "Given more than 2 files, output everything that appears in an odd number of files."+      ]+    )+  )+  where value = Xor <$> accuracy <*> inFiles <*> outHdl++command :: IO Command+command = O.execParser+  (O.info+    ((O.subparser (catCommand <> subCommand <> intersectCommand <> xorCommand)) O.<**> O.helper)+    (O.fullDesc <> O.progDesc "Use -h for help. Available commands: cat, sub, int, xor.")+  )

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"