Add parser for the required types.

Added parsers and serializers for all but the following types:
* Lambda     100
* Projection 104
* Unary Primitive 101
* Exception -128
* GUID

The remaining types should be easy to express, but I want to
try to write a parser for q itself, now.

closes #2

Author: jkozlowski

.ghci

@@ -1,9 +1,58 @@
+import Data.List
+
 :{
-:def test const (
-     do putStrLn "Press any key to run tests, q to stop..."
+:def test (\args ->
+     do let createPattern p = if (null p)
+                                then "**"
+                                else if "*" `isSuffixOf` p
+                                       then p
+                                       else "**" ++ p ++ "**"
+            pattern = createPattern args
+            cmd p = unlines [ ":reload"
+                            , ":main --pattern " ++ p
+                            , ":test " ++ p
+                            ]
+        putStrLn $ "Going to run: " ++ pattern
+        putStrLn "Press any key to run tests, q to stop, anything else changes the test pattern..."
         x <- getLine
         return $ if (x == "q")
                     then ""
-                    else ":reload \n :main \n :test"
+                    else if null x
+                            then cmd pattern
+                            else let pattern' = createPattern x
+                                 in cmd $ createPattern x
      )
+:}
+
+-- -*- mode: haskell; -*-
+-- Begin copied material.
+-- <http://www.cs.kent.ac.uk/people/staff/cr3/toolbox/haskell/dot-squashed.ghci641>
+:{
+:def redir \varcmd -> return $
+        case break Data.Char.isSpace varcmd of
+            (var,_:cmd) -> unlines
+                [":set -fno-print-bind-result"
+                ,"tmp <- System.Directory.getTemporaryDirectory"
+                ,"(f,h) <- System.IO.openTempFile tmp \"ghci\""
+                ,"sto <- GHC.Handle.hDuplicate System.IO.stdout"
+                ,"GHC.Handle.hDuplicateTo h System.IO.stdout"
+                ,"System.IO.hClose h"
+                ,cmd
+                ,"GHC.Handle.hDuplicateTo sto System.IO.stdout"
+                ,"let readFileNow f = readFile f >>= \\t->Data.List.length t `seq` return t"
+                ,var++" <- readFileNow f"
+                ,"System.Directory.removeFile f"
+                ]
+            _ -> "putStrLn \"usage: :redir <var> <cmd>\""
+:}
+
+--- Integration with the hlint code style tool
+:{
+:def hlint \extra -> return $ unlines
+        [":unset +t +s"
+        ,":set -w"
+        ,":redir hlintvar1 :show modules"
+        ,":cmd return $ \":! hlint \" ++ unwords (map (takeWhile (/=',') . drop 2 . dropWhile (/= '(')) $ lines hlintvar1) ++ \" \" ++ " ++ show extra
+        ,":set +t +s -Wall"
+        ]
 :}

.gitignore

@@ -11,7 +11,6 @@ cabal.sandbox.config
 *.log
 .#*
 *.iml
-q/
 .idea
 out/
 report.html

.travis.yml

@@ -1,16 +1,28 @@
 language: haskell
+ghc: 7.8.3
+
+cache:
+  directories:
+  - ~/.cabal
 
 before_install:
-  - cabal install --only-dependencies --enable-tests
+  - sudo apt-get update -qq
+  - sudo apt-get install -qq --force-yes libgd2-xpm ia32-libs ia32-libs-multiarch
+  - sed -f use-stackage.sed ~/.cabal/config > ~/.cabal/config.tmp
+  - rm ~/.cabal/config
+  - mv ~/.cabal/config.tmp ~/.cabal/config
+  - cat ~/.cabal/config
+  - cabal update
   - cabal install hpc-coveralls --avoid-reinstalls
 
 script:
-  - cat cabal.config >> ~/.cabal/config # use stackage - find a better way to do this
-  - cabal update
   - cabal install --only-dependencies --enable-tests
   - cabal configure --enable-tests --enable-library-coverage
   - cabal build
   - run-cabal-test --show-details=always
+#  - hlint src
+#  - hlint tests
+#  - hlint benchmarks
 
 after_script:
   - hpc-coveralls --exclude-dir=tests kdb-haskell-tests

Makefile

@@ -5,6 +5,7 @@ CABALSANDBOX := ".cabal-sandbox"
 all: install hpc bench haddock run
 
 bench: install
+	cabal configure --enable-benchmarks
 	cabal build
 	cabal bench --benchmark-options="-o report.html"
 

README.md

@@ -6,6 +6,9 @@ kdb-haskell
 
 A repository that (in the future) will hold a kdb+ driver in Haskell.
 
+Status:
+* Parser and serializer for most kdb+ types is implemented with good test coverage.
+
 * [Download free kdb+](http://kx.com/software-download.php)
 * [Useful working driver](http://code.kx.com/wsvn/code/contrib/sagrawal/kx/haskell/kx.hs)
 * https://blog.engineyard.com/2014/the-second-contributor

benchmarks/Benchmark.hs

@@ -12,12 +12,19 @@
 module Main where
 
 import           Criterion.Main
+import           Criterion.Measurement
+import           Data.ByteString ()
+import           Data.Fixed (Pico)
+import           Data.Ratio
 import           Data.Int (Int16)
-import           Database.Kdb.Internal.Types (Value(..), cV, s, li)
+import           Data.Monoid ((<>))
+import           Database.Kdb.Internal.Types
 import           Foreign.C.Types (CChar)
 import           Text.Printf (printf)
-import qualified Control.Monad                as CM (forM_)
+import           Test.QuickCheck (Gen, arbitrary, listOf1, choose, generate, vectorOf, suchThat)
+import qualified Control.Monad                as CM
 import qualified Data.ByteString.Char8        as C
+import qualified Data.Time                    as Time
 import qualified Data.Vector                  as V
 import qualified Data.Vector.Storable         as SV
 import qualified Data.Vector.Storable.Mutable as MSV
@@ -31,42 +38,29 @@ import System.IO.Unsafe (unsafePerformIO)
 import Network.Socket hiding (recv)
 import Network.Socket.ByteString (recv, sendAll)
 
-fillS :: [[CChar]] -> Value
-fillS x = let (x',y') = createS x
-          in SV x' y'
-{-# INLINE fillS #-}
-
-createS :: [[CChar]] -> (Int, SV.Vector CChar)
-createS cl = unsafePerformIO $ do
-            v <- MSV.new (Prelude.length . Prelude.concat $ cl)
-            fill v 0 $ Prelude.concat cl
-            SV.unsafeFreeze v >>= \x -> return (Prelude.length cl,x)
-          where
-            fill _ _ [] = return ()
-            fill v i (x:xs) = MSV.unsafeWrite v i x >> fill v (i + 1) xs
-
--- | Constructor for T - a Q table - we must always build it using this function
--- 2 bytes for table header - 1 additional byte for dict type header
-fillT :: V.Vector Value -> Value
-fillT !xs = T (V.foldl' (\x y -> x + KT.size y) 3 xs) xs
-{-# INLINE fillT #-}
-
 -- function to convert list of bytestring into hex digits - useful for debugging kx IPC bytes
 bprint :: C.ByteString -> String
 bprint x = ("0x" ++ ) $ foldl (++) "" $ fmap (printf "%02x") $ C.unpack x
 
-main :: IO ()
-main = do
-  let shortv = HV (SV.fromList[1..10]) -- short list - for benchmark testing
-      il1 = IV $ SV.enumFromN 1 5000000 -- list of int
-      il2 = IV $ SV.enumFromN 1 5000000 -- list of int
-      il3 = IV $ SV.enumFromN 1 5000000 -- list of int
-      l1 = L (V.fromList [il1,il2,il3]) -- general list of int
-      sl1 = fillS [[97,0],[98,0],[99,0]] -- symbol list: `a`b`c
-      t = fillT (V.fromList [sl1,l1]) -- table t:([] a:til 5000000;b:til 5000000;c:til 5000000)
-      sl2 = s "t" -- atomic symbol `t
-      cl1 = cV "insert" -- string ".u.insert"
-      gl1 = li [cl1,sl2,t] -- general list (".u.insert";`t;t). t is the table from above
+-- test:([]kbool:();kbyte:();kshort:();kint:();klong:();
+-- kreal:();kfloat:();kchar:();ksymbol:();kboolv:();kbytev:();kshortv:();kintv:();
+-- klongv:();krealv:();kfloatv:();kcharv:();ksymbolv:())
+
+-- .u.upd:{[t;x] if not -16=type first first x;a:.z.n; x:$[0>type first x;a,x;(enlist(count first x)#a),x]]; t insert x}
+-- write schema statement: simply send a char vector
+
+main1 :: IO ()
+main1 = do
+--  let shortv = KShortV (SV.fromList[1..10]) -- short list - for benchmark testing
+--      il1 = V . KIntV $ SV.enumFromN 1 5000000 -- list of int
+--      il2 = V . KIntV $ SV.enumFromN 1 5000000 -- list of int
+--      il3 = V . KIntV $ SV.enumFromN 1 5000000 -- list of int
+--      l1 = KList (V.fromList [il1,il2,il3]) -- general list of int
+--      sl1 = symV ["a", "b", "c"]
+--      t = KT.table' (V.fromList [sl1,l1]) -- table t:([] a:til 5000000;b:til 5000000;c:til 5000000)
+--      sl2 = s "t" -- atomic symbol `t
+--      cl1 = charV "insert" -- string ".u.insert"
+--      gl1 = list [cl1,sl2,t] -- general list (".u.insert";`t;t). t is the table from above
 {--
   defaultMain [
         bench "ShortV" $ whnf SV.fromList ([1..10]::[Int16])
@@ -84,8 +78,58 @@ main = do
   connect sock (addrAddress serveraddr)
   sendAll sock "user:pwd\1\0"
   msg <- recv sock 1024
-  print "Received authentication"
+  putStrLn "Received authentication"
   print $ bprint msg
-  CM.forM_ [1..1] $ \x -> sendAll sock $ IPC.asyncIPC gl1
+
+  -- send the schema
+  sendAll sock . IPC.asyncIPC $ charV schema
+
+  -- Gen the rows
+  rows <- setupEnv 100
+
+  -- Send the rows
+  CM.forM_ rows $ \x -> sendAll sock $ IPC.asyncIPC x
+
+  -- Close the socket
   sClose sock
 
+setupEnv :: Int -> IO [KT.Value]
+setupEnv count = CM.replicateM count (generate randomRow)
+
+benchmark :: IO ()
+benchmark = defaultMain [
+    env (setupEnv 1000000) $ \ ~rows ->
+        bgroup "bla" [
+            bench "length" $ nf (map IPC.asyncIPC) rows
+        ]
+   ]
+
+--benchmark2 :: IO ()
+--benchmark2 = do
+--    (m, time) <- flip measure 1 $ env setupEnv $ \ ~rows ->
+--        bgroup "bla" [
+--            bench "length" $ nf (map IPC.asyncIPC) rows
+--        ]
+--    return ()
+
+main2 :: IO ()
+main2 = do
+  addrinfos <- getAddrInfo Nothing (Just "127.0.0.1") (Just "7777")
+  let serveraddr = head addrinfos
+  sock <- socket (addrFamily serveraddr) Stream defaultProtocol
+  connect sock (addrAddress serveraddr)
+
+  -- Login
+  sendAll sock "user:pwd\1\0"
+  msg <- recv sock 1024
+  putStrLn "Received authentication"
+  print $ bprint msg
+
+  -- Send the schema
+  sendAll sock . IPC.asyncIPC $ charV schema
+
+  sClose sock
+
+main :: IO ()
+main = main1
+

cabal.config

@@ -1,2 +1,2 @@
--- Lock the package database
-remote-repo: stackage:http://www.stackage.org/stackage/7cbdc905d399a45de2128a2d8e67e22636f309a1
+-- Stackage build for GHC 7.8 + Haskell Platform, 2014-09-24, inclusive
+remote-repo: stackage:http://www.stackage.org/stackage/92c5686ff52b79d727431993e2f21b1b7b869d1b

kdb-haskell.cabal

@@ -1,4 +1,3 @@
-
 name:               kdb-haskell
 version:            0.1.0
 synopsis:           Haskell bindings for KDB+.
@@ -33,19 +32,21 @@ library
   exposed-modules:    
   other-modules:      Database.Kdb.Internal.Types
                     , Database.Kdb.Internal.IPC
+                    , Database.Kdb.Internal.DateTimeTypes
   default-language:   Haskell2010
   build-depends:      base >= 4 && < 5
-                    , mtl
+                    , deepseq
+                    , cpu
+                    , time
+                    , attoparsec
                     , bytestring
+                      -- see if possible to get rid of: necessary for the
+                      -- conversions between Word32/Word64 and Float/Double.
+                    , array
                     , vector
-                    , text
-                    , containers
-                    , binary
-                    , lens
                     , QuickCheck
-                    , directory
   hs-source-dirs:     src
-  ghc-options:       -Wall 
+  ghc-options:       -Wall
                      -fwarn-incomplete-patterns
                      -funbox-strict-fields
 
@@ -55,37 +56,73 @@ test-suite kdb-haskell-tests
   main-is:            Test.hs
   type:               exitcode-stdio-1.0
   build-depends:      base
+                    , deepseq
+                    , deepseq-generics
+                    , cpu
                     , bytestring
+                    , array
                     , base16-bytestring
                     , containers
                     , vector
+                    , attoparsec
                     , text
                     , time
+                    , timezone-series  >= 0.1.3
+                    , timezone-olson
+                    , tzdata == 0.1.20140612.0
                     , binary
                     , mtl
                     , lens
                     -- Testing
                     , tasty
                     , tasty-quickcheck
+                    --, tasty-smallcheck
                     , tasty-hunit
                     , QuickCheck
+                    , quickcheck-io
+                    , network
+                    , process
+                    , directory
+                    , system-filepath
+                    , resourcet
+                    , transformers
+                    , retry
                     , Cabal
-  Ghc-Options:       -Wall
+                    -- This needs to be disabled for now, until I figure out
+                    -- why this fails to build.
+                    --, hlint
+  ghc-options:       -Wall
                      -O0
-                     -funbox-strict-fields 
+                     -funbox-strict-fields
 
 benchmark kdb-haskell-benchmark
   type:               exitcode-stdio-1.0
   hs-source-dirs:     src
+                    , tests
                     , benchmarks
   main-is:            Benchmark.hs
   build-depends:      base
-                    , mtl
-                    , vector
+                    , deepseq
+                    , deepseq-generics
+                    , cpu
                     , bytestring
+                    , array
+                    , base16-bytestring
+                    , containers
+                    , vector
+                    , attoparsec
+                    , text
+                    , time
+                    , timezone-series >= 0.1.3
+                    , binary
+                    , mtl
+                    , lens
+                    -- Benchmark deps
                     , network
+                    , time
                     , criterion
-                    , random
+                    , QuickCheck
   ghc-options:       -Wall
                      -O2
                      -funbox-strict-fields
+                     -rtsopts