GetSchemas.hs

module GetSchemas where
import GHC
import GHC.Paths
import GHC.Types.Avail
import GHC.Types.Name
import GHC.Driver.Session
import GHC.Driver.Env
import GHC.Utils.Monad
import GHC.Iface.Binary
import GHC.Iface.Syntax
import System.Process
import System.FilePath
import Data.Char (isSpace)

trim :: String -> String
trim = f . f
   where f = reverse . dropWhile isSpace

isIfaceId :: IfaceDecl -> Bool
isIfaceId (IfaceId {}) = True
isIfaceId _ = False

isTableSchema :: IfaceType -> Bool
isTableSchema (IfaceTyConApp tycon _) = "TableSchema" == (occNameString . nameOccName $ ifaceTyConName tycon)
isTableSchema _ = False

getKeaModelSchemas :: IO [String]
getKeaModelSchemas = do
    iface <- runGhc (Just libdir) $ do
        projroot <- trim <$> liftIO (readProcess "stack" ["path", "--project-root"] "")
        distdir <- trim <$> liftIO (readProcess "stack" ["path", "--dist-dir"] "")
        hsc <- getSession
        liftIO $ readBinIface (targetProfile $ hsc_dflags hsc) (hsc_NC hsc) CheckHiWay QuietBinIFace (projroot </> distdir </> "build/Kea/Model.hi")

    -- yeah i could toss it in a set for faster performance who cares
    let exports = map (occNameString . nameOccName . availName) $ mi_exports iface
    pure $ filter (`elem` exports) . map (occNameString . nameOccName . ifName) . filter (isTableSchema . ifType)  . filter isIfaceId . map snd $ mi_decls iface