{-# LANGUAGE CPP, DataKinds, GADTs, KindSignatures, OverloadedStrings,
             QuasiQuotes, RecordWildCards, RoleAnnotations,
             ScopedTypeVariables, TemplateHaskell, TupleSections,
             TypeApplications, TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
-- | Code generation of types relevant to Frames use-cases. Generation
-- may be driven by an automated inference process or manual use of
-- the individual helpers.
module Frames.TH where
import Control.Arrow (second)
import Data.Char (toLower)
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy(..))
import qualified Data.Text as T
import Data.Vinyl
import Data.Vinyl.TypeLevel (RIndex)
import Frames.Col ((:->))
import Frames.ColumnTypeable
import Frames.ColumnUniverse
import Frames.CSV
import Frames.Rec(Record)
import Frames.Utils
import qualified GHC.Types as GHC
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import qualified Pipes as P
import qualified Pipes.Prelude as P
import qualified Pipes.Safe as P
import Data.Vinyl.CoRec (ShowF)

-- | Generate a column type.
recDec :: [Type] -> Type
recDec :: [Type] -> Type
recDec = Type -> Type -> Type
AppT (Name -> Type
ConT ''Record) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Type] -> Type
go
  where go :: [Type] -> Type
go [] = Type
PromotedNilT
        go (Type
t:[Type]
cs) = Type -> Type -> Type
AppT (Type -> Type -> Type
AppT Type
PromotedConsT Type
t) ([Type] -> Type
go [Type]
cs)

-- | Declare a type synonym for a column.
mkColSynDec :: TypeQ -> Name -> DecQ
mkColSynDec :: TypeQ -> Name -> DecQ
mkColSynDec TypeQ
colTypeQ Name
colTName = forall (m :: * -> *).
Quote m =>
Name -> [TyVarBndr ()] -> m Type -> m Dec
tySynD Name
colTName [] TypeQ
colTypeQ

-- | Declare lenses for working with a column.
mkColLensDec :: Name -> Type -> T.Text -> DecsQ
mkColLensDec :: Name -> Type -> Text -> DecsQ
mkColLensDec Name
colTName Type
colTy Text
colPName = forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [DecQ
tySig, DecQ
val, DecQ
tySig', DecQ
val']
  where nm :: Name
nm = String -> Name
mkName forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
colPName
        nm' :: Name
nm' = String -> Name
mkName forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
colPName forall a. Semigroup a => a -> a -> a
<> String
"'"
        -- tySig = sigD nm [t|Proxy $(conT colTName)|]
        tySig :: DecQ
tySig = forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
nm [t|forall f rs.
                           (Functor f,
                            RElem $(conT colTName) rs (RIndex $(conT colTName) rs))
                         => ($(pure colTy) -> f $(pure colTy))
                         -> Record rs
                         -> f (Record rs)
                         |]
        tySig' :: DecQ
tySig' = forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
nm' [t|forall f g rs.
                            (Functor f,
                             RElem $(conT colTName) rs (RIndex $(conT colTName) rs))
                          => (g $(conT colTName) -> f (g $(conT colTName)))
                          -> Rec g rs
                          -> f (Rec g rs)
                          |]
        val :: DecQ
val = forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
nm)
                   (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [e|rlens @($(conT colTName)) . rfield |])
                   []
        val' :: DecQ
val' = forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
nm')
                    (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [e|rlens' @($(conT colTName))|])
                    []

lowerHead :: T.Text -> Maybe T.Text
lowerHead :: Text -> Maybe Text
lowerHead = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, Text) -> Text
aux forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons
  where aux :: (Char, Text) -> Text
aux (Char
c,Text
t) = Char -> Text -> Text
T.cons (Char -> Char
toLower Char
c) Text
t

-- | For each column, we declare a type synonym for its type, and a
-- Proxy value of that type.
colDec :: T.Text -> String -> T.Text
       -> Either (String -> Q [Dec]) Type
       -> Q (Type, [Dec])
colDec :: Text
-> String
-> Text
-> Either (String -> DecsQ) Type
-> Q (Type, [Dec])
colDec Text
prefix String
rowName Text
colName Either (String -> DecsQ) Type
colTypeGen = do
  (Type
colTy, [Dec]
extraDecs) <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> DecsQ) -> Q (Type, [Dec])
colDecsHelper (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,[])) Either (String -> DecsQ) Type
colTypeGen
  let colTypeQ :: TypeQ
colTypeQ = [t|$(litT . strTyLit $ T.unpack colName) :-> $(return colTy)|]
  Dec
syn <- TypeQ -> Name -> DecQ
mkColSynDec TypeQ
colTypeQ Name
colTName'
  [Dec]
lenses <- Name -> Type -> Text -> DecsQ
mkColLensDec Name
colTName' Type
colTy Text
colPName
  forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Type
ConT Name
colTName', Dec
syn forall a. a -> [a] -> [a]
: [Dec]
extraDecs forall a. [a] -> [a] -> [a]
++ [Dec]
lenses)
  where colTName :: Text
colTName = Text -> Text
sanitizeTypeName (Text
prefix forall a. Semigroup a => a -> a -> a
<> Text -> Text
capitalize1 Text
colName)
        colPName :: Text
colPName = forall a. a -> Maybe a -> a
fromMaybe Text
"colDec impossible" (Text -> Maybe Text
lowerHead Text
colTName)
        colTName' :: Name
colTName' = String -> Name
mkName forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
colTName
        colDecsHelper :: (String -> DecsQ) -> Q (Type, [Dec])
colDecsHelper String -> DecsQ
f =
          let qualName :: String
qualName = String
rowName forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (Text -> Text
capitalize1 Text
colName)
          in (Name -> Type
ConT (String -> Name
mkName String
qualName),) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> DecsQ
f String
qualName

-- | Splice for manually declaring a column of a given type. For
-- example, @declareColumn "x2" ''Double@ will declare a type synonym
-- @type X2 = "x2" :-> Double@ and a lens @x2@.
declareColumn :: T.Text -> Name -> DecsQ
declareColumn :: Text -> Name -> DecsQ
declareColumn = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Name -> DecsQ
declarePrefixedColumn Text
T.empty

-- | Splice for manually declaring a column of a given type in which
-- the generated type synonym's name has a prefix applied to the
-- column name. For example, @declarePrefixedColumn "x2" "my"
-- ''Double@ will declare a type synonym @type MyX2 = "x2" :-> Double@
-- and a lens @myX2@.
declarePrefixedColumn :: T.Text -> T.Text -> Name -> DecsQ
declarePrefixedColumn :: Text -> Text -> Name -> DecsQ
declarePrefixedColumn Text
colName Text
prefix Name
colTypeName =
  (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeQ -> Name -> DecQ
mkColSynDec TypeQ
colTypeQ Name
colTName'
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Name -> Type -> Text -> DecsQ
mkColLensDec Name
colTName' Type
colTy Text
colPName
  where prefix' :: Text
prefix' = Text -> Text
capitalize1 Text
prefix
        colTName :: Text
colTName = Text -> Text
sanitizeTypeName (Text
prefix' forall a. Semigroup a => a -> a -> a
<> Text -> Text
capitalize1 Text
colName)
        colPName :: Text
colPName = forall a. a -> Maybe a -> a
fromMaybe Text
"colDec impossible" (Text -> Maybe Text
lowerHead Text
colTName)
        colTName' :: Name
colTName' = String -> Name
mkName forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
colTName
        colTy :: Type
colTy = Name -> Type
ConT Name
colTypeName
        colTypeQ :: TypeQ
colTypeQ = [t|$(litT . strTyLit $ T.unpack colName) :-> $(return colTy)|]

-- * Default CSV Parsing

-- | Control how row and named column types are generated. The type
-- argument is a type-level list of the possible column types.
data RowGen (a :: [GHC.Type]) =
  RowGen { forall (a :: [*]). RowGen a -> [String]
columnNames    :: [String]
           -- ^ Use these column names. If empty, expect a
           -- header row in the data file to provide
           -- column names.
         , forall (a :: [*]). RowGen a -> String
tablePrefix    :: String
           -- ^ A common prefix to use for every generated
           -- declaration.
         , forall (a :: [*]). RowGen a -> Text
separator      :: Separator
           -- ^ The string that separates the columns on a
           -- row.
         , forall (a :: [*]). RowGen a -> String
rowTypeName    :: String
           -- ^ The row type that enumerates all
           -- columns.
         , forall (a :: [*]). RowGen a -> Proxy a
columnUniverse :: Proxy a
           -- ^ A record field that mentions the phantom type list of
           -- possible column types. Having this field prevents record
           -- update syntax from losing track of the type argument.
         , forall (a :: [*]). RowGen a -> Int
inferencePrefix :: Int
           -- ^ Number of rows to inspect to infer a type for each
           -- column. Defaults to 1000.
         , forall (a :: [*]).
RowGen a -> Text -> Producer [Text] (SafeT IO) ()
lineReader :: Separator -> P.Producer [T.Text] (P.SafeT IO) ()
           -- ^ A producer of rows of ’T.Text’ values that were
           -- separated by a 'Separator' value.
         }

-- -- | Shorthand for a 'Proxy' value of 'ColumnUniverse' applied to the
-- -- given type list.
colQ :: Name -> Q Exp
colQ :: Name -> Q Exp
colQ Name
n = [e| (Proxy :: Proxy (ColumnUniverse $(conT n))) |]

-- | A default 'RowGen'. This instructs the type inference engine to
-- get column names from the data file, use the default column
-- separator (a comma), infer column types from the default 'Columns'
-- set of types, and produce a row type with name @Row@.
rowGen :: FilePath -> RowGen CommonColumns
rowGen :: String -> RowGen CommonColumns
rowGen = forall (a :: [*]).
[String]
-> String
-> Text
-> String
-> Proxy a
-> Int
-> (Text -> Producer [Text] (SafeT IO) ())
-> RowGen a
RowGen [] String
"" Text
defaultSep String
"Row" forall {k} (t :: k). Proxy t
Proxy Int
1000 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadSafe m =>
String -> Text -> Producer [Text] m ()
produceTokens

-- | Like 'rowGen', but will also generate custom data types for
-- 'Categorical' variables with up to 8 distinct variants.
rowGenCat :: FilePath -> RowGen CommonColumnsCat
rowGenCat :: String -> RowGen CommonColumnsCat
rowGenCat = forall (a :: [*]).
[String]
-> String
-> Text
-> String
-> Proxy a
-> Int
-> (Text -> Producer [Text] (SafeT IO) ())
-> RowGen a
RowGen [] String
"" Text
defaultSep String
"Row" forall {k} (t :: k). Proxy t
Proxy Int
1000 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadSafe m =>
String -> Text -> Producer [Text] m ()
produceTokens

-- -- | Generate a type for each row of a table. This will be something
-- -- like @Record ["x" :-> a, "y" :-> b, "z" :-> c]@.
-- tableType :: String -> FilePath -> DecsQ
-- tableType n fp = tableType' (rowGen fp) { rowTypeName = n }

-- | Like 'tableType', but additionally generates a type synonym for
-- each column, and a proxy value of that type. If the CSV file has
-- column names \"foo\", \"bar\", and \"baz\", then this will declare
-- @type Foo = "foo" :-> Int@, for example, @foo = rlens \@Foo@, and
-- @foo' = rlens' \@Foo@.
tableTypes :: String -> FilePath -> DecsQ
tableTypes :: String -> String -> DecsQ
tableTypes String
n String
fp = forall (a :: [*]) c.
(c ~ CoRec ColInfo a, ColumnTypeable c, Semigroup c,
 RPureConstrained (ShowF ColInfo) a) =>
RowGen a -> DecsQ
tableTypes' (String -> RowGen CommonColumns
rowGen String
fp) { rowTypeName :: String
rowTypeName = String
n }

-- * Customized Data Set Parsing

-- | Inspect no more than this many lines when inferring column types.
prefixSize :: Int
prefixSize :: Int
prefixSize = Int
1000

-- | Generate a type for a row of a table. This will be something like
-- @Record ["x" :-> a, "y" :-> b, "z" :-> c]@.  Column type synonyms
-- are /not/ generated (see 'tableTypes'').
-- tableType' :: forall a. (ColumnTypeable a, Monoid a)
--            => RowGen a -> DecsQ
-- tableType' (RowGen {..}) =
--     pure . TySynD (mkName rowTypeName) [] <$>
--     (runIO (P.runSafeT (readColHeaders opts lineSource)) >>= recDec')
--   where recDec' = recDec . map (second colType) :: [(T.Text, a)] -> Q Type
--         colNames' | null columnNames = Nothing
--                   | otherwise = Just (map T.pack columnNames)
--         opts = ParserOptions colNames' separator (RFC4180Quoting '\"')
--         lineSource = lineReader separator >-> P.take prefixSize

-- | Tokenize the first line of a ’P.Producer’.
colNamesP :: Monad m => P.Producer [T.Text] m () -> m [T.Text]
colNamesP :: forall (m :: * -> *). Monad m => Producer [Text] m () -> m [Text]
colNamesP Producer [Text] m ()
src = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
P.next Producer [Text] m ()
src

-- | Generate a type for a row of a table all of whose columns remain
-- unparsed 'Text' values.
tableTypesText' :: forall a c.
                   (c ~ CoRec ColInfo a, ColumnTypeable c, Semigroup c)
                => RowGen a -> DecsQ
tableTypesText' :: forall (a :: [*]) c.
(c ~ CoRec ColInfo a, ColumnTypeable c, Semigroup c) =>
RowGen a -> DecsQ
tableTypesText' RowGen {Int
String
[String]
Proxy a
Text
Text -> Producer [Text] (SafeT IO) ()
lineReader :: Text -> Producer [Text] (SafeT IO) ()
inferencePrefix :: Int
columnUniverse :: Proxy a
rowTypeName :: String
separator :: Text
tablePrefix :: String
columnNames :: [String]
lineReader :: forall (a :: [*]).
RowGen a -> Text -> Producer [Text] (SafeT IO) ()
inferencePrefix :: forall (a :: [*]). RowGen a -> Int
columnUniverse :: forall (a :: [*]). RowGen a -> Proxy a
rowTypeName :: forall (a :: [*]). RowGen a -> String
separator :: forall (a :: [*]). RowGen a -> Text
tablePrefix :: forall (a :: [*]). RowGen a -> String
columnNames :: forall (a :: [*]). RowGen a -> [String]
..} =
  do [Text]
colNames <- forall a. IO a -> Q a
runIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
SafeT m r -> m r
P.runSafeT forall a b. (a -> b) -> a -> b
$
                 forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *). Monad m => Producer [Text] m () -> m [Text]
colNamesP (Text -> Producer [Text] (SafeT IO) ()
lineReader Text
separator))
                       forall (f :: * -> *) a. Applicative f => a -> f a
pure
                       (ParserOptions -> Maybe [Text]
headerOverride ParserOptions
opts)
     let headers :: [(Text, Type)]
headers = forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
colNames (forall a. a -> [a]
repeat (Name -> Type
ConT ''T.Text))
     ([Type]
colTypes, [Dec]
colDecs) <- forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
unzip
                            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Type -> Q (Type, [Dec])
mkColDecs) [(Text, Type)]
headers
     let recTy :: Dec
recTy = Name -> [TyVarBndr ()] -> Type -> Dec
TySynD (String -> Name
mkName String
rowTypeName) [] ([Type] -> Type
recDec [Type]
colTypes)
         optsName :: Name
optsName = case String
rowTypeName of
                      [] -> forall a. HasCallStack => String -> a
error String
"Row type name shouldn't be empty"
                      Char
h:String
t -> String -> Name
mkName forall a b. (a -> b) -> a -> b
$ Char -> Char
toLower Char
h forall a. a -> [a] -> [a]
: String
t forall a. [a] -> [a] -> [a]
++ String
"Parser"
     Dec
optsTy <- forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
optsName [t|ParserOptions|]
     Dec
optsDec <- forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
optsName) (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift ParserOptions
opts) []

     forall (m :: * -> *) a. Monad m => a -> m a
return (Dec
recTy forall a. a -> [a] -> [a]
: Dec
optsTy forall a. a -> [a] -> [a]
: Dec
optsDec forall a. a -> [a] -> [a]
: [Dec]
colDecs)
  where colNames' :: Maybe [Text]
colNames' | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
columnNames = forall a. Maybe a
Nothing
                  | Bool
otherwise = forall a. a -> Maybe a
Just (forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
columnNames)
        opts :: ParserOptions
opts = Maybe [Text] -> Text -> QuotingMode -> ParserOptions
ParserOptions Maybe [Text]
colNames' Text
separator (Char -> QuotingMode
RFC4180Quoting Char
'\"')
        mkColDecs :: Text -> Type -> Q (Type, [Dec])
mkColDecs Text
colNm Type
colTy = do
          let safeName :: String
safeName = Text -> String
T.unpack (Text -> Text
sanitizeTypeName Text
colNm)
          Maybe Name
mColNm <- String -> Q (Maybe Name)
lookupTypeName (String
tablePrefix forall a. [a] -> [a] -> [a]
++ String
safeName)
          case Maybe Name
mColNm of
            Just Name
n -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Type
ConT Name
n, [])
            Maybe Name
Nothing -> Text
-> String
-> Text
-> Either (String -> DecsQ) Type
-> Q (Type, [Dec])
colDec (String -> Text
T.pack String
tablePrefix) String
rowTypeName Text
colNm (forall a b. b -> Either a b
Right Type
colTy)

-- | Generate a type for a row of a table. This will be something like
-- @Record ["x" :-> a, "y" :-> b, "z" :-> c]@. Additionally generates
-- a type synonym for each column, and a proxy value of that type. If
-- the CSV file has column names \"foo\", \"bar\", and \"baz\", then
-- this will declare @type Foo = "foo" :-> Int@, for example, @foo =
-- rlens \@Foo@, and @foo' = rlens' \@Foo@.
tableTypes' :: forall a c. (c ~ CoRec ColInfo a, ColumnTypeable c, Semigroup c, RPureConstrained (ShowF ColInfo) a)
            => RowGen a -> DecsQ
tableTypes' :: forall (a :: [*]) c.
(c ~ CoRec ColInfo a, ColumnTypeable c, Semigroup c,
 RPureConstrained (ShowF ColInfo) a) =>
RowGen a -> DecsQ
tableTypes' (RowGen {Int
String
[String]
Proxy a
Text
Text -> Producer [Text] (SafeT IO) ()
lineReader :: Text -> Producer [Text] (SafeT IO) ()
inferencePrefix :: Int
columnUniverse :: Proxy a
rowTypeName :: String
separator :: Text
tablePrefix :: String
columnNames :: [String]
lineReader :: forall (a :: [*]).
RowGen a -> Text -> Producer [Text] (SafeT IO) ()
inferencePrefix :: forall (a :: [*]). RowGen a -> Int
columnUniverse :: forall (a :: [*]). RowGen a -> Proxy a
rowTypeName :: forall (a :: [*]). RowGen a -> String
separator :: forall (a :: [*]). RowGen a -> Text
tablePrefix :: forall (a :: [*]). RowGen a -> String
columnNames :: forall (a :: [*]). RowGen a -> [String]
..}) =
  do [(Text, c)]
headers <- forall a. IO a -> Q a
runIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
SafeT m r -> m r
P.runSafeT
                forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(ColumnTypeable a, Semigroup a, Monad m, Show a) =>
ParserOptions -> Producer [Text] m () -> m [(Text, a)]
readColHeaders ParserOptions
opts Producer [Text] (SafeT IO) ()
lineSource :: Q [(T.Text, c)]
     ([Type]
colTypes, [Dec]
colDecs) <- (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
unzip)
                            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Either (String -> DecsQ) Type -> Q (Type, [Dec])
mkColDecs)
                                     (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. ColumnTypeable a => a -> Either (String -> DecsQ) Type
colType) [(Text, c)]
headers)
     let recTy :: Dec
recTy = Name -> [TyVarBndr ()] -> Type -> Dec
TySynD (String -> Name
mkName String
rowTypeName) [] ([Type] -> Type
recDec [Type]
colTypes)
         optsName :: Name
optsName = case String
rowTypeName of
                      [] -> forall a. HasCallStack => String -> a
error String
"Row type name shouldn't be empty"
                      Char
h:String
t -> String -> Name
mkName forall a b. (a -> b) -> a -> b
$ Char -> Char
toLower Char
h forall a. a -> [a] -> [a]
: String
t forall a. [a] -> [a] -> [a]
++ String
"Parser"
     Dec
optsTy <- forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
optsName [t|ParserOptions|]
     Dec
optsDec <- forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
optsName) (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB forall a b. (a -> b) -> a -> b
$ forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift ParserOptions
opts) []
     forall (m :: * -> *) a. Monad m => a -> m a
return (Dec
recTy forall a. a -> [a] -> [a]
: Dec
optsTy forall a. a -> [a] -> [a]
: Dec
optsDec forall a. a -> [a] -> [a]
: [Dec]
colDecs)
     -- (:) <$> (tySynD (mkName n) [] (recDec' headers))
     --     <*> (concat <$> mapM (uncurry $ colDec (T.pack prefix)) headers)
  where colNames' :: Maybe [Text]
colNames' | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
columnNames = forall a. Maybe a
Nothing
                  | Bool
otherwise = forall a. a -> Maybe a
Just (forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
columnNames)
        opts :: ParserOptions
opts = Maybe [Text] -> Text -> QuotingMode -> ParserOptions
ParserOptions Maybe [Text]
colNames' Text
separator (Char -> QuotingMode
RFC4180Quoting Char
'\"')
        lineSource :: Producer [Text] (SafeT IO) ()
lineSource = Text -> Producer [Text] (SafeT IO) ()
lineReader Text
separator forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
P.>-> forall (m :: * -> *) a. Functor m => Int -> Pipe a a m ()
P.take Int
inferencePrefix
        mkColDecs :: T.Text -> Either (String -> Q [Dec]) Type -> Q (Type, [Dec])
        mkColDecs :: Text -> Either (String -> DecsQ) Type -> Q (Type, [Dec])
mkColDecs Text
colNm Either (String -> DecsQ) Type
colTy = do
          let safeName :: String
safeName = String
tablePrefix forall a. [a] -> [a] -> [a]
++ (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
sanitizeTypeName forall a b. (a -> b) -> a -> b
$ Text
colNm)
          Maybe Name
mColNm <- String -> Q (Maybe Name)
lookupTypeName String
safeName
          case Maybe Name
mColNm of
            Just Name
n -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Type
ConT Name
n, []) -- Column's type was already defined
            Maybe Name
Nothing -> Text
-> String
-> Text
-> Either (String -> DecsQ) Type
-> Q (Type, [Dec])
colDec (String -> Text
T.pack String
tablePrefix) String
rowTypeName Text
colNm Either (String -> DecsQ) Type
colTy