{-# LANGUAGE CPP, DataKinds, OverloadedStrings, QuasiQuotes, TemplateHaskell, TypeOperators #-} module Main (manualGeneration, main) where import Control.Monad (unless) import Data.Functor.Identity import Data.Char import Data.List (find) import Data.Monoid (First(..)) import qualified Data.Text as T import Language.Haskell.TH as TH import Language.Haskell.TH.Syntax (addDependentFile) import Frames import Frames.CSV (produceCSV) import DataCSV import Pipes.Prelude (toListM) import PrettyTH import System.IO (hClose) import System.IO.Temp (withSystemTempFile) import Test.Hspec as H import Test.HUnit.Lang (assertFailure) -- | Extract all example @(CSV, generatedCode)@ pairs from -- @test/examples.toml@ csvTests :: [(CsvExample, String)] csvTests = $(do addDependentFile "test/examples.toml" csvExamples <- TH.runIO (examplesFrom "test/examples.toml") ListE <$> mapM (\x@(CsvExample _ c _) -> [e|(x,$(generateCode "Row" c))|]) csvExamples) -- | Detect type-compatible re-used names and do not attempt to -- re-generate definitions for them. This does not do the right thing -- since the generated declarations are never turned into actual -- declarations, they do not affect the `lookupTypeName` call that is -- designed to prevent duplicate declarations. overlappingGeneration :: String overlappingGeneration = m ++ "\n\n" ++ e where m = $(do csvExamples <- TH.runIO (examplesFrom "test/examples.toml") let Just (CsvExample _ managers _) = find (\(CsvExample k _ _) -> k == "managers") csvExamples generateCode "ManagerRec" managers) e = $(do csvExamples <- TH.runIO (examplesFrom "test/examples.toml") let Just (CsvExample _ employees _) = find (\(CsvExample k _ _) -> k == "employees") csvExamples generateCode "EmployeeRec" employees) -- | To generate example generated code from raw CSV data, add the csv -- to @examples.toml@ and set the @generated@ key to an empty -- string. Then load this file into a REPL that has @:set -- -XTemplateHaskell@ and evaluate @putStrLn $(manualGeneration -- "employees")@, for example. -- -- Note that to load this file into a REPL may require some fiddling -- with the path to the examples file in the 'csvTests' splice above. manualGeneration :: String -> Q Exp manualGeneration k = do csvExamples <- TH.runIO (examplesFrom "test/examples.toml") maybe (error ("Table " ++ k ++ " not found")) (generateCode "Row") (getFirst $ foldMap aux csvExamples) where aux :: CsvExample -> First String aux (CsvExample k' c _) = if k == k' then pure c else mempty type ManagersRow = Record ["id" :-> Int, "manager" :-> Text, "age" :-> Int, "pay" :-> Double] newtype Code = Code String instance Show Code where show (Code x) = x instance Eq Code where Code a == Code b = filter (not . isSpace) a == filter (not . isSpace) b main :: IO () main = do hspec $ do describe "Haskell type generation" $ mapM_ (\(CsvExample k _ g, g') -> it k (Code g' `shouldBe` Code g)) csvTests describe "Multiple tables" $ do _g <- H.runIO $ generatedFrom "test/examples.toml" "managers_employees" it "Shouldn't duplicate columns" pending describe "Writing CSV Data" $ do let csvInput = case find ((== "managers") . name . fst) csvTests of Just (ex,_) -> csv ex Nothing -> error "Couldn't find managers test data" frame <- H.runIO $ withSystemTempFile "FramesSpecOutput" $ \fp h -> do hClose h writeFile fp csvInput inCoreAoS (readTable fp) :: IO (Frame ManagersRow) let Identity csvOutput = toListM (produceCSV frame) frame2 <- H.runIO $ withSystemTempFile "FramesSpecOutput" $ \fp h -> do hClose h writeFile fp (unlines csvOutput) inCoreAoS (readTable fp) :: IO (Frame ManagersRow) -- The test data isn't formatted quite how we'd do it: text -- fields aren't quoted, and salaries represented as Doubles -- do not have decimal points. let csvInput' = T.replace "Joe" "\"Joe\"" . T.replace "Sarah" "\"Sarah\"" . T.replace "\"80,000\"" "80000.0" $ T.pack csvInput it "Produces expected output" $ T.unlines (map T.pack csvOutput) `shouldBe` csvInput' it "Produces parseable output" $ unless (frame == frame2) (assertFailure "Reparsed CSV differs from input")