{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-} 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) -- | Generates haskell code from an SQL file. 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 -- actually a compile error Right context -> do ctx <- compileContext context schemaTxt <- runIO $ readFile filename return (ctx <> schemaValue (toS $ filename ^. basename) schemaTxt) -- MonadIO Identity -- | Generates haskell code from multiple SQL files. 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 -- actually a compile error Right context -> runQ $ compileContext context -- | Allows you to print generated template haskell code to a file 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 -- actually a compile error Right context -> runQ $ do r <- compileContext context let out = concatMap (<> "\n\n") $ pprint <$> r runIO $ writeFile filenameOut $ toS out return []