--   Copyright 2013 Mario Pastorelli (pastorelli.mario@gmail.com) Samuel Gélineau (gelisam@gmail.com)
--
--   Licensed under the Apache License, Version 2.0 (the "License");
--   you may not use this file except in compliance with the License.
--   You may obtain a copy of the License at
--
--       http://www.apache.org/licenses/LICENSE-2.0
--
--   Unless required by applicable law or agreed to in writing, software
--   distributed under the License is distributed on an "AS IS" BASIS,
--   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--   See the License for the specific language governing permissions and
--   limitations under the License.

-- | Used by Hawk's runtime to format the output of a Hawk expression.
--    You can use this from your user prelude if you want Hawk to print
--    your custom datatypes in a console-friendly format.
module System.Console.Hawk.Representable (

    ListAsRow (listRepr')
  , ListAsRows (listRepr)
  , Row  (repr')
  , Rows (repr)

) where

import Prelude
import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as C8 hiding (hPutStrLn)
import qualified Data.List as L
import Data.Set (Set)
import qualified Data.Set as S
import Data.Map (Map)
import qualified Data.Map as M


-- | A type that instantiate ListAsRow is a type that has a representation
-- when is embedded inside a list
--
-- For example:
--
-- >>> mapM_ Data.ByteString.Lazy.Char8.putStrLn $ repr Data.ByteString.Lazy.Char8.empty "test"
-- test
class (Show a) => ListAsRow a where
    listRepr' :: ByteString -> [a] -> ByteString
    listRepr' ByteString
d = ByteString -> [ByteString] -> ByteString
C8.intercalate ByteString
d ([ByteString] -> ByteString)
-> ([a] -> [ByteString]) -> [a] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
L.map ([Char] -> ByteString
C8.pack ([Char] -> ByteString) -> (a -> [Char]) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show)

instance ListAsRow Bool
instance ListAsRow Float
instance ListAsRow Double
instance ListAsRow Int
instance ListAsRow Integer
instance ListAsRow ()

instance (ListAsRow a) => ListAsRow [a] where
    -- todo check the first delimiter if it should be d
    listRepr' :: ByteString -> [[a]] -> ByteString
listRepr' ByteString
d = ByteString -> [ByteString] -> ByteString
C8.intercalate ByteString
d ([ByteString] -> ByteString)
-> ([[a]] -> [ByteString]) -> [[a]] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> ByteString) -> [[a]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
L.map (ByteString -> [a] -> ByteString
forall a. ListAsRow a => ByteString -> [a] -> ByteString
listRepr' ByteString
d)

instance (Row a) => ListAsRow (Maybe a) where
    listRepr' :: ByteString -> [Maybe a] -> ByteString
listRepr' ByteString
d = ByteString -> [ByteString] -> ByteString
C8.intercalate ByteString
d ([ByteString] -> ByteString)
-> ([Maybe a] -> [ByteString]) -> [Maybe a] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> ByteString) -> [Maybe a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
L.map (ByteString -> Maybe a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d)

instance (ListAsRow a) => ListAsRow (Set a) where
    listRepr' :: ByteString -> [Set a] -> ByteString
listRepr' ByteString
d = ByteString -> [ByteString] -> ByteString
forall a. ListAsRow a => ByteString -> [a] -> ByteString
listRepr' ByteString
d ([ByteString] -> ByteString)
-> ([Set a] -> [ByteString]) -> [Set a] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> ByteString) -> [Set a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
L.map (ByteString -> [a] -> ByteString
forall a. ListAsRow a => ByteString -> [a] -> ByteString
listRepr' ByteString
d ([a] -> ByteString) -> (Set a -> [a]) -> Set a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
S.toList)

instance ListAsRow Char where
    listRepr' :: ByteString -> [Char] -> ByteString
listRepr' ByteString
_ = [Char] -> ByteString
C8.pack

instance ListAsRow ByteString where
    listRepr' :: ByteString -> [ByteString] -> ByteString
listRepr' = ByteString -> [ByteString] -> ByteString
C8.intercalate

instance (Row a, Row b) => ListAsRow (Map a b) where
    listRepr' :: ByteString -> [Map a b] -> ByteString
listRepr' ByteString
d = ByteString -> [ByteString] -> ByteString
forall a. ListAsRow a => ByteString -> [a] -> ByteString
listRepr' ByteString
d ([ByteString] -> ByteString)
-> ([Map a b] -> [ByteString]) -> [Map a b] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map a b -> ByteString) -> [Map a b] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
L.map (ByteString -> [(a, b)] -> ByteString
forall a. ListAsRow a => ByteString -> [a] -> ByteString
listRepr' ByteString
d ([(a, b)] -> ByteString)
-> (Map a b -> [(a, b)]) -> Map a b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
M.toList)

instance (Row a,Row b) => ListAsRow (a,b) where
    listRepr' :: ByteString -> [(a, b)] -> ByteString
listRepr' ByteString
d = ByteString -> [ByteString] -> ByteString
C8.intercalate ByteString
d ([ByteString] -> ByteString)
-> ([(a, b)] -> [ByteString]) -> [(a, b)] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> ByteString) -> [(a, b)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(a
x,b
y) -> [ByteString] -> ByteString
C8.unwords
                  [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
x,ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
y])

instance (Row a,Row b,Row c) => ListAsRow (a,b,c) where
    listRepr' :: ByteString -> [(a, b, c)] -> ByteString
listRepr' ByteString
d = ByteString -> [ByteString] -> ByteString
C8.intercalate ByteString
d ([ByteString] -> ByteString)
-> ([(a, b, c)] -> [ByteString]) -> [(a, b, c)] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b, c) -> ByteString) -> [(a, b, c)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(a
x,b
y,c
z) -> [ByteString] -> ByteString
C8.unwords
                  [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
x,ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
y,ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
z])

instance (Row a,Row b,Row c,Row d) => ListAsRow (a,b,c,d) where
    listRepr' :: ByteString -> [(a, b, c, d)] -> ByteString
listRepr' ByteString
d = ByteString -> [ByteString] -> ByteString
C8.intercalate ByteString
d ([ByteString] -> ByteString)
-> ([(a, b, c, d)] -> [ByteString]) -> [(a, b, c, d)] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b, c, d) -> ByteString) -> [(a, b, c, d)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(a
a,b
b,c
c,d
e) -> [ByteString] -> ByteString
C8.unwords
                  [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a,ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b,ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c,ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e])

instance (Row a,Row b,Row c,Row d,Row e) => ListAsRow (a,b,c,d,e) where
    listRepr' :: ByteString -> [(a, b, c, d, e)] -> ByteString
listRepr' ByteString
d = ByteString -> [ByteString] -> ByteString
C8.intercalate ByteString
d ([ByteString] -> ByteString)
-> ([(a, b, c, d, e)] -> [ByteString])
-> [(a, b, c, d, e)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b, c, d, e) -> ByteString)
-> [(a, b, c, d, e)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(a
a,b
b,c
c,d
e,e
f) -> [ByteString] -> ByteString
C8.unwords
                  [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a,ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b,ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c,ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e,ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f])

instance (Row a,Row b,Row c,Row d,Row e,Row f) => ListAsRow (a,b,c,d,e,f) where
    listRepr' :: ByteString -> [(a, b, c, d, e, f)] -> ByteString
listRepr' ByteString
d = ByteString -> [ByteString] -> ByteString
C8.intercalate ByteString
d ([ByteString] -> ByteString)
-> ([(a, b, c, d, e, f)] -> [ByteString])
-> [(a, b, c, d, e, f)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b, c, d, e, f) -> ByteString)
-> [(a, b, c, d, e, f)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(a
a,b
b,c
c,d
e,e
f,f
g) -> [ByteString] -> ByteString
C8.unwords
                  [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a,ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b,ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c,ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e,ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f
                  ,ByteString -> f -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d f
g])

instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g)
  => ListAsRow (a,b,c,d,e,f,g) where
    listRepr' :: ByteString -> [(a, b, c, d, e, f, g)] -> ByteString
listRepr' ByteString
d = ByteString -> [ByteString] -> ByteString
C8.intercalate ByteString
d ([ByteString] -> ByteString)
-> ([(a, b, c, d, e, f, g)] -> [ByteString])
-> [(a, b, c, d, e, f, g)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b, c, d, e, f, g) -> ByteString)
-> [(a, b, c, d, e, f, g)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(a
a,b
b,c
c,d
e,e
f,f
g,g
h) -> [ByteString] -> ByteString
C8.unwords
                  [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a,ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b,ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c,ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e,ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f
                  ,ByteString -> f -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d f
g,ByteString -> g -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d g
h])

instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h)
  => ListAsRow (a,b,c,d,e,f,g,h) where
    listRepr' :: ByteString -> [(a, b, c, d, e, f, g, h)] -> ByteString
listRepr' ByteString
d = ByteString -> [ByteString] -> ByteString
C8.intercalate ByteString
d ([ByteString] -> ByteString)
-> ([(a, b, c, d, e, f, g, h)] -> [ByteString])
-> [(a, b, c, d, e, f, g, h)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b, c, d, e, f, g, h) -> ByteString)
-> [(a, b, c, d, e, f, g, h)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(a
a,b
b,c
c,d
e,e
f,f
g,g
h,h
i) -> [ByteString] -> ByteString
C8.unwords
                  [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a,ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b,ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c,ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e,ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f
                  ,ByteString -> f -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d f
g,ByteString -> g -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d g
h,ByteString -> h -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d h
i])

instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h,Row i)
  => ListAsRow (a,b,c,d,e,f,g,h,i) where
    listRepr' :: ByteString -> [(a, b, c, d, e, f, g, h, i)] -> ByteString
listRepr' ByteString
d = ByteString -> [ByteString] -> ByteString
C8.intercalate ByteString
d ([ByteString] -> ByteString)
-> ([(a, b, c, d, e, f, g, h, i)] -> [ByteString])
-> [(a, b, c, d, e, f, g, h, i)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b, c, d, e, f, g, h, i) -> ByteString)
-> [(a, b, c, d, e, f, g, h, i)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(a
a,b
b,c
c,d
e,e
f,f
g,g
h,h
i,i
l) -> [ByteString] -> ByteString
C8.unwords
                  [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a,ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b,ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c,ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e,ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f
                  ,ByteString -> f -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d f
g,ByteString -> g -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d g
h,ByteString -> h -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d h
i,ByteString -> i -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d i
l])

instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h,Row i,Row l)
  => ListAsRow (a,b,c,d,e,f,g,h,i,l) where
    listRepr' :: ByteString -> [(a, b, c, d, e, f, g, h, i, l)] -> ByteString
listRepr' ByteString
d = ByteString -> [ByteString] -> ByteString
C8.intercalate ByteString
d ([ByteString] -> ByteString)
-> ([(a, b, c, d, e, f, g, h, i, l)] -> [ByteString])
-> [(a, b, c, d, e, f, g, h, i, l)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b, c, d, e, f, g, h, i, l) -> ByteString)
-> [(a, b, c, d, e, f, g, h, i, l)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(a
a,b
b,c
c,d
e,e
f,f
g,g
h,h
i,i
l,l
m) -> [ByteString] -> ByteString
C8.unwords
                  [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a,ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b,ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c,ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e,ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f
                  ,ByteString -> f -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d f
g,ByteString -> g -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d g
h,ByteString -> h -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d h
i,ByteString -> i -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d i
l,ByteString -> l -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d l
m])



-- | A Row is something that can be expressed as a record.
-- The output of repr' should be formatted such that
-- it can be read and processed from the command line.
--
-- For example:
--
-- >>> putStrLn $ show [1,2,3,4]
-- [1,2,3,4]
--
-- >>> Data.ByteString.Lazy.Char8.putStrLn $ repr' (Data.ByteString.Lazy.Char8.pack " ") [1,2,3,4]
-- 1 2 3 4
class (Show a) => Row a where
    repr' :: ByteString -- ^ columns delimiter
          -> a           -- ^ value to represent
          -> ByteString
    repr' ByteString
_ = [Char] -> ByteString
C8.pack ([Char] -> ByteString) -> (a -> [Char]) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show

instance Row Bool
instance Row Float
instance Row Double
instance Row Int
instance Row Integer
instance Row ()

instance Row Char where
    repr' :: ByteString -> Char -> ByteString
repr' ByteString
_ = Char -> ByteString
C8.singleton

instance (ListAsRow a) => Row [a] where
    repr' :: ByteString -> [a] -> ByteString
repr' = ByteString -> [a] -> ByteString
forall a. ListAsRow a => ByteString -> [a] -> ByteString
listRepr'

instance (ListAsRow a) => Row (Set a) where
    repr' :: ByteString -> Set a -> ByteString
repr' ByteString
d = ByteString -> [a] -> ByteString
forall a. ListAsRow a => ByteString -> [a] -> ByteString
listRepr' ByteString
d ([a] -> ByteString) -> (Set a -> [a]) -> Set a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
S.toList

instance (Row a,Row b) => Row (Map a b) where
    repr' :: ByteString -> Map a b -> ByteString
repr' ByteString
d = ByteString -> [(a, b)] -> ByteString
forall a. ListAsRow a => ByteString -> [a] -> ByteString
listRepr' ByteString
d ([(a, b)] -> ByteString)
-> (Map a b -> [(a, b)]) -> Map a b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
M.toList

instance Row ByteString where
    repr' :: ByteString -> ByteString -> ByteString
repr' ByteString
_ = ByteString -> ByteString
forall a. a -> a
id

instance (Row a) => Row (Maybe a) where
    repr' :: ByteString -> Maybe a -> ByteString
repr' ByteString
_ Maybe a
Nothing = ByteString
C8.empty
    repr' ByteString
d (Just a
x) = ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
x -- check if d is correct here

instance (Row a,Row b) => Row (a,b) where
    repr' :: ByteString -> (a, b) -> ByteString
repr' ByteString
d (a
a,b
b) = ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append` ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b)
    --repr' d (a,b) = repr' d [repr' d a,repr' d b]

instance (Row a,Row b,Row c) => Row (a,b,c) where
    repr' :: ByteString -> (a, b, c) -> ByteString
repr' ByteString
d (a
a,b
b,c
c) =  ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
                      (ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append` ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c)))

instance (Row a,Row b,Row c,Row d) => Row (a,b,c,d) where
    repr' :: ByteString -> (a, b, c, d) -> ByteString
repr' ByteString
d (a
a,b
b,c
c,d
e) = ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
                        (ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
                        (ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append` ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e)))))

instance (Row a,Row b,Row c,Row d,Row e) => Row (a,b,c,d,e) where
    repr' :: ByteString -> (a, b, c, d, e) -> ByteString
repr' ByteString
d (a
a,b
b,c
c,d
e,e
f) = ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
                        (ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
                        (ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
                        (ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append` ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f)))))))

instance (Row a,Row b,Row c,Row d,Row e,Row f) => Row (a,b,c,d,e,f) where
    repr' :: ByteString -> (a, b, c, d, e, f) -> ByteString
repr' ByteString
d (a
a,b
b,c
c,d
e,e
f,f
g) = ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
                            (ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
                            (ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
                            (ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
                            (ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append` ByteString -> f -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d f
g)))))))))

instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g) => Row (a,b,c,d,e,f,g) where
    repr' :: ByteString -> (a, b, c, d, e, f, g) -> ByteString
repr' ByteString
d (a
a,b
b,c
c,d
e,e
f,f
g,g
h) = ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
                              (ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
                              (ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
                              (ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
                              (ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
                              (ByteString -> f -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d f
g ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append` ByteString -> g -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d g
h)))))))))))

instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h)
        => Row (a,b,c,d,e,f,g,h) where
    repr' :: ByteString -> (a, b, c, d, e, f, g, h) -> ByteString
repr' ByteString
d (a
a,b
b,c
c,d
e,e
f,f
g,g
h,h
i) =
        ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> f -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d f
g ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> g -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d g
h ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append` ByteString -> h -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d h
i)))))))))))))

instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h,Row i)
        => Row (a,b,c,d,e,f,g,h,i) where
    repr' :: ByteString -> (a, b, c, d, e, f, g, h, i) -> ByteString
repr' ByteString
d (a
a,b
b,c
c,d
e,e
f,f
g,g
h,h
i,i
l) =
        ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> f -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d f
g ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> g -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d g
h ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> h -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d h
i ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append` ByteString -> i -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d i
l)))))))))))))))

instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h,Row i,Row l)
        => Row (a,b,c,d,e,f,g,h,i,l) where
    repr' :: ByteString -> (a, b, c, d, e, f, g, h, i, l) -> ByteString
repr' ByteString
d (a
a,b
b,c
c,d
e,e
f,f
g,g
h,h
i,i
l,l
m) =
        ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> f -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d f
g ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> g -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d g
h ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> h -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d h
i ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append`
       (ByteString -> i -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d i
l ByteString -> ByteString -> ByteString
`C8.append` (ByteString
d ByteString -> ByteString -> ByteString
`C8.append` ByteString -> l -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d l
m)))))))))))))))))


-- | A type that instantiate ListAsRows is a type that has a representation
-- when is embedded inside a list
--
-- Note: we use this class for representing a list of chars as String
-- instead of the standard list representation. Without this repr "test" would
-- yield ['t','e','s','r'] instead of "test".
--
-- For example:
--
-- >>> mapM_ Data.ByteString.Lazy.Char8.putStrLn $ repr Data.ByteString.Lazy.Char8.empty "test"
-- test
class (Row a) => ListAsRows a where
    listRepr :: ByteString -- ^ column delimiter
               -> [a]         -- ^ list of values to represent
               -> [ByteString]
    listRepr ByteString
d = (a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
L.map (ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d)

instance ListAsRows ByteString
instance ListAsRows Bool
instance ListAsRows Double
instance ListAsRows Float
instance ListAsRows Int
instance ListAsRows Integer
instance (Row a) => ListAsRows (Maybe a)
instance ListAsRows ()
instance (ListAsRow a,ListAsRows a) => ListAsRows [a]
instance (Row a,Row b) => ListAsRows (a,b)
instance (Row a,Row b,Row c) => ListAsRows (a,b,c)
instance (Row a,Row b,Row c,Row d) => ListAsRows (a,b,c,d)
instance (Row a,Row b,Row c,Row d,Row e) => ListAsRows (a,b,c,d,e)
instance (Row a,Row b,Row c,Row d,Row e,Row f) => ListAsRows (a,b,c,d,e,f)
instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g) => ListAsRows (a,b,c,d,e,f,g)
instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h)
  => ListAsRows (a,b,c,d,e,f,g,h)
instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h,Row i)
  => ListAsRows (a,b,c,d,e,f,g,h,i)
instance (Row a,Row b,Row c,Row d,Row e,Row f,Row g,Row h,Row i,Row l)
  => ListAsRows (a,b,c,d,e,f,g,h,i,l)

instance ListAsRows Char where
    listRepr :: ByteString -> [Char] -> [ByteString]
listRepr ByteString
_ = (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[]) (ByteString -> [ByteString])
-> ([Char] -> ByteString) -> [Char] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
C8.pack

instance (ListAsRow a,ListAsRows a) => ListAsRows (Set a) where
    listRepr :: ByteString -> [Set a] -> [ByteString]
listRepr ByteString
d = ByteString -> [[a]] -> [ByteString]
forall a. ListAsRows a => ByteString -> [a] -> [ByteString]
listRepr ByteString
d ([[a]] -> [ByteString])
-> ([Set a] -> [[a]]) -> [Set a] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> [a]) -> [Set a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
L.map Set a -> [a]
forall a. Set a -> [a]
S.toList

instance (Row a,Row b) => ListAsRows (Map a b) where
    listRepr :: ByteString -> [Map a b] -> [ByteString]
listRepr ByteString
d = ByteString -> [[(a, b)]] -> [ByteString]
forall a. ListAsRows a => ByteString -> [a] -> [ByteString]
listRepr ByteString
d ([[(a, b)]] -> [ByteString])
-> ([Map a b] -> [[(a, b)]]) -> [Map a b] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map a b -> [(a, b)]) -> [Map a b] -> [[(a, b)]]
forall a b. (a -> b) -> [a] -> [b]
L.map Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
M.toList

instance (ListAsRows a) => Rows [a] where
    repr :: ByteString -> [a] -> [ByteString]
repr = ByteString -> [a] -> [ByteString]
forall a. ListAsRows a => ByteString -> [a] -> [ByteString]
listRepr


-- | A type that instantiate Rows is a type that can be represented as
-- a list of rows, where typically a row is a line.
--
-- For example:
--
-- >>> mapM_ Data.ByteString.Lazy.Char8.putStrLn $ repr (Data.ByteString.Lazy.Char8.singleton '\n') [1,2,3,4]
-- 1
-- 2
-- 3
-- 4
class (Show a) => Rows a where
    -- | Return a representation of the given value as list of strings.
    repr :: ByteString -- ^ rows delimiter
         -> a           -- ^ value to represent
         -> [C8.ByteString]
    repr ByteString
_ = (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[]) (ByteString -> [ByteString])
-> (a -> ByteString) -> a -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
C8.pack ([Char] -> ByteString) -> (a -> [Char]) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. Show a => a -> [Char]
show


instance Rows Bool
instance Rows Double
instance Rows Float
instance Rows Int
instance Rows Integer

instance Rows () where
    repr :: ByteString -> () -> [ByteString]
repr ByteString
_ = [ByteString] -> () -> [ByteString]
forall a b. a -> b -> a
const [ByteString
C8.empty]

instance Rows Char where
    repr :: ByteString -> Char -> [ByteString]
repr ByteString
_ = (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[]) (ByteString -> [ByteString])
-> (Char -> ByteString) -> Char -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString
C8.singleton

instance Rows ByteString where
    repr :: ByteString -> ByteString -> [ByteString]
repr ByteString
_ = (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[])

instance (Rows a) => Rows (Maybe a) where
    repr :: ByteString -> Maybe a -> [ByteString]
repr ByteString
d = [ByteString] -> (a -> [ByteString]) -> Maybe a -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ByteString
C8.empty] (ByteString -> a -> [ByteString]
forall a. Rows a => ByteString -> a -> [ByteString]
repr ByteString
d)

instance (Row a, Row b) => Rows (Map a b) where
    repr :: ByteString -> Map a b -> [ByteString]
repr ByteString
d = ByteString -> [(a, b)] -> [ByteString]
forall a. ListAsRows a => ByteString -> [a] -> [ByteString]
listRepr ByteString
d ([(a, b)] -> [ByteString])
-> (Map a b -> [(a, b)]) -> Map a b -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
M.toList

instance (ListAsRows a) => Rows (Set a) where
    repr :: ByteString -> Set a -> [ByteString]
repr ByteString
d = ByteString -> [a] -> [ByteString]
forall a. ListAsRows a => ByteString -> [a] -> [ByteString]
listRepr ByteString
d ([a] -> [ByteString]) -> (Set a -> [a]) -> Set a -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
S.toList

instance (Row a, Row b) => Rows (a,b) where
    repr :: ByteString -> (a, b) -> [ByteString]
repr ByteString
d (a
x,b
y) = [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
x,ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
y]

instance (Row a, Row b, Row c) => Rows (a,b,c) where
    repr :: ByteString -> (a, b, c) -> [ByteString]
repr ByteString
d (a
a,b
b,c
c) = [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a, ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b, ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c]

instance (Row a, Row b, Row c, Row d) => Rows (a,b,c,d) where
    repr :: ByteString -> (a, b, c, d) -> [ByteString]
repr ByteString
d (a
a,b
b,c
c,d
e) = [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a, ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b, ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c, ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e]

instance (Row a, Row b, Row c, Row d, Row e) => Rows (a,b,c,d,e) where
    repr :: ByteString -> (a, b, c, d, e) -> [ByteString]
repr ByteString
d (a
a,b
b,c
c,d
e,e
f) = [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a, ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b, ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c, ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e, ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f]

instance (Row a, Row b, Row c, Row d, Row e, Row f) => Rows (a,b,c,d,e,f) where
    repr :: ByteString -> (a, b, c, d, e, f) -> [ByteString]
repr ByteString
d (a
a,b
b,c
c,d
e,e
f,f
g) = [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a, ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b, ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c,ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e
                           ,ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f, ByteString -> f -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d f
g]

instance (Row a, Row b, Row c, Row d, Row e, Row f, Row g)
       => Rows (a,b,c,d,e,f,g) where
    repr :: ByteString -> (a, b, c, d, e, f, g) -> [ByteString]
repr ByteString
d (a
a,b
b,c
c,d
e,e
f,f
g,g
h) = [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a, ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b, ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c,ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e
                             ,ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f, ByteString -> f -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d f
g, ByteString -> g -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d g
h]

instance (Row a, Row b, Row c, Row d, Row e, Row f, Row g, Row h)
       => Rows (a,b,c,d,e,f,g,h) where
    repr :: ByteString -> (a, b, c, d, e, f, g, h) -> [ByteString]
repr ByteString
d (a
a,b
b,c
c,d
e,e
f,f
g,g
h,h
i) = [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a, ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b, ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c, ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e
                               ,ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f, ByteString -> f -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d f
g, ByteString -> g -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d g
h, ByteString -> h -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d h
i]

instance (Row a, Row b, Row c, Row d, Row e, Row f, Row g, Row h, Row i)
       => Rows (a,b,c,d,e,f,g,h,i) where
    repr :: ByteString -> (a, b, c, d, e, f, g, h, i) -> [ByteString]
repr ByteString
d (a
a,b
b,c
c,d
e,e
f,f
g,g
h,h
i,i
l) = [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a, ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b, ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c, ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e
                                 ,ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f, ByteString -> f -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d f
g, ByteString -> g -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d g
h, ByteString -> h -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d h
i
                                 , ByteString -> i -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d i
l]

instance (Row a, Row b, Row c, Row d, Row e, Row f, Row g, Row h, Row i, Row l)
       => Rows (a,b,c,d,e,f,g,h,i,l) where
    repr :: ByteString -> (a, b, c, d, e, f, g, h, i, l) -> [ByteString]
repr ByteString
d (a
a,b
b,c
c,d
e,e
f,f
g,g
h,h
i,i
l,l
m) = [ByteString -> a -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d a
a, ByteString -> b -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d b
b, ByteString -> c -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d c
c, ByteString -> d -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d d
e
                                   ,ByteString -> e -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d e
f, ByteString -> f -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d f
g, ByteString -> g -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d g
h, ByteString -> h -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d h
i
                                   ,ByteString -> i -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d i
l, ByteString -> l -> ByteString
forall a. Row a => ByteString -> a -> ByteString
repr' ByteString
d l
m]