<div dir="ltr"><div>Thanks for this solution. I think I could pair this with a data type generated at runtime to index the vector and I'd be in great shape.<br><br>Related question: Does anyone know example code that creates data types at runtime via TH?<br>
<br></div>-M<br><br></div><div class="gmail_extra"><br><br><div class="gmail_quote">On Fri, May 30, 2014 at 6:40 PM, Ben Gamari <span dir="ltr"><<a href="mailto:bgamari.foss@gmail.com" target="_blank">bgamari.foss@gmail.com</a>></span> wrote:<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div class="">Mark Fredrickson <<a href="mailto:mark.m.fredrickson@gmail.com">mark.m.fredrickson@gmail.com</a>> writes:<br>

<br>
> Hello,<br>
><br>
> I writing a program that operates on some static data, currently saved in<br>
> CSV files. Right now I parse the files at run time and then generate<br>
> hashmap tables to connect the different data.<br>
><br>
> Since I'm only ever operating on static data, I'm wondering if I can<br>
> generate module files that capture the records as a sum type. To access the<br>
> fields of the records, I could then imagine functions that exhaustively map<br>
> the constructors to the data.<br>
><br>
> Do any tools to generate .hs files from CSV or other formats exist? Insofar<br>
> as this question has been asked before, the recommendation is "use Template<br>
> Haskell", which makes sense, but is a less complete solution than I'm<br>
> hoping for.<br>
><br>
</div>How does the TH hack below look?<br>
<br>
See this Gist for this code and a test-case. Unfortunately there are a<br>
few gotchas here,<br>
<br>
  1. The record type needs a `Lift` instance[2]. There are a pain to<br>
     write but can be derived[3]<br>
  2. The type of your data can't be defined in the same module as the TH<br>
     splice due to GHC's stage restriction<br>
<br>
Cheers,<br>
<br>
- Ben<br>
<br>
<br>
[1] <a href="https://gist.github.com/bgamari/efad8560ab7dd38e9407" target="_blank">https://gist.github.com/bgamari/efad8560ab7dd38e9407</a><br>
[2] <a href="http://hackage.haskell.org/package/template-haskell-2.9.0.0/docs/Language-Haskell-TH-Syntax.html#t:Lift" target="_blank">http://hackage.haskell.org/package/template-haskell-2.9.0.0/docs/Language-Haskell-TH-Syntax.html#t:Lift</a><br>

[3] <a href="http://hackage.haskell.org/package/th-lift" target="_blank">http://hackage.haskell.org/package/th-lift</a><br>
<br>
<br>
{-# LANGUAGE TemplateHaskell, FlexibleContexts #-}<br>
<br>
module StaticCSV (staticCSV) where<br>
<br>
import Control.Applicative<br>
import Data.Csv as Csv hiding (Name)<br>
import Data.Proxy<br>
import Data.Data<br>
import <a href="http://Language.Haskell.TH" target="_blank">Language.Haskell.TH</a><br>
import Language.Haskell.TH.Syntax (Lift, lift)<br>
import qualified Data.ByteString.Lazy as BSL<br>
import qualified Data.Vector as V<br>
<br>
staticCSV :: (FromRecord a, Lift (V.Vector a)) => FilePath -> Proxy a -> ExpQ<br>
staticCSV fileName ty = do<br>
    contents <- runIO $ BSL.readFile fileName<br>
    csv <- case decode NoHeader contents of<br>
      Right a  -> return $ fmap (flip asProxyTypeOf ty) a<br>
      Left err -> fail err<br>
    [| csv |]<br>
<br>
instance Lift a => Lift (V.Vector a) where<br>
    lift v = do<br>
        list <- ListE <$> mapM lift (V.toList v)<br>
        return $ AppE (VarE 'V.fromList) list<br>
<br>
</blockquote></div><br></div>