module Internal.Data.Basic.TH (mkFromFile, mkFromFiles, printToFile) where
import Control.Monad (fail)
import Internal.Interlude hiding (Type)
import Language.Haskell.TH hiding (Name)
import qualified Language.Haskell.TH.Syntax as TH
import System.FilePath.Lens
import Control.Effects.Signal
import Internal.Data.Basic.TH.Types
import Internal.Data.Basic.TH.Compiler
import Internal.Data.Basic.TH.Generator (schemaValue)
mkFromFile :: FilePath -> Q [Dec]
mkFromFile filename = do
TH.addDependentFile filename
eStatements <- compileSQL $ toS filename
case eStatements of
Left (ParseError e) -> runIO.fail $ toS e
Right statements -> do
r <- runIO $ handleToEither @ParseError $ compileSQLStatements mempty statements
case r of
Left (ParseError e) -> runIO.fail $ toS e
Right context -> do
ctx <- compileContext context
schemaTxt <- runIO $ readFile filename
return (ctx <> schemaValue (toS $ filename ^. basename) schemaTxt)
mkFromFiles :: [FilePath] -> Q [Dec]
mkFromFiles filenames = do
_ <- sequence $ TH.addDependentFile <$> filenames
res <- sequence $ compileSQL.toS <$> filenames
let eStatements = concat <$> sequence res
case eStatements of
Left (ParseError e) -> runIO.fail $ toS e
Right statements -> do
r <- (runIO $ handleToEither @ParseError $ compileSQLStatements mempty statements)
case r of
Left (ParseError e) -> runIO.fail $ toS e
Right context -> runQ $ compileContext context
printToFile :: [FilePath] -> FilePath -> Q [Dec]
printToFile filenames filenameOut = do
res <- sequence $ compileSQL.toS <$> filenames
let eStatements = concat <$> sequence res
case eStatements of
Left (ParseError e) -> runIO.fail $ toS e
Right statements -> do
r <- (runIO $ handleToEither @ParseError $ compileSQLStatements mempty statements)
case r of
Left (ParseError e) -> runIO.fail $ toS e
Right context -> runQ $ do
r <- compileContext context
let out = concatMap (<> "\n\n") $ pprint <$> r
runIO $ writeFile filenameOut $ toS out
return []