> -- | This module contains a collection of utility functions
> {-# LANGUAGE FlexibleContexts #-}
> module Database.HsSqlPpp.Utility
>     (-- * ast utils
>      resetAnnotations
>     ,queryType
>     --,canonicalizeTypeName
>     --,canonicalizeTypeNames
>      -- * typechecked ast utils
>     ,addExplicitCasts
>     ,addImplicitCasts
>     ,tcTreeInfo
>     ,emacsShowErrors
>     ) where
> import Data.Generics.Uniplate.Data
> import Data.Data
> import Data.List
> import Data.Maybe
> import Database.HsSqlPpp.Internals.AstInternal
> import Database.HsSqlPpp.Internals.TypesInternal
> import Database.HsSqlPpp.Internals.ParseInternal
> import Database.HsSqlPpp.Internals.Catalog.CatalogTypes
> --import Database.HsSqlPpp.Catalog
> import Database.HsSqlPpp.Parse
> import Database.HsSqlPpp.TypeCheck
> --import Text.Parsec.Prim
> --import Control.Monad.Identity
> import qualified Data.Text.Lazy as L
> -- | replace all the annotations in a tree with 'emptyAnnotation'
> resetAnnotations :: Data a => a -> a
> resetAnnotations = transformBi (const emptyAnnotation)
> -- | Gets the type of the sql source passed in. Expects the string to contain
> -- a query expr
> queryType :: Catalog -> L.Text -> Maybe Type
> queryType cat src = do
>   ast <- either (const Nothing) Just $ parseQueryExpr defaultParseFlags "" Nothing src
>   fmap teType $ anType $ getAnnotation $ typeCheckQueryExpr defaultTypeCheckFlags cat ast
> -- | Gets some information useful for checking a typechecked tree
> -- returns the type of the top level node, a list of type errors from
> -- the tree, a list of the queryexpr nodes, and a list of the scalar
> -- exprs respectively, which have their type as nothing which indicates
> -- that the typechecking didn't complete successfully
> tcTreeInfo :: Data a =>
>               a
>            -> (Maybe TypeExtra,[([TypeError],Maybe SourcePosition)]
>               ,[QueryExpr],[ScalarExpr])
> tcTreeInfo ast =
>   let noTypeSEs :: [ScalarExpr]
>       noTypeSEs = [x | x <- universeBi ast
>                      , isNothing (anType (getAnnotation x))]
>       noTypeQEs :: [QueryExpr]
>       noTypeQEs = [x | x <- universeBi ast
>                      , isNothing (anType (getAnnotation x))]
>       -- get the list of type errors with source positions
>       -- from the typechecked ast
>       tes :: [([TypeError],Maybe SourcePosition)]
>       tes = [(e,sp) | a@(Annotation {}) <- universeBi ast
>                     , let e = anErrs a
>                     , let sp = anSrc a
>                     , not (null e)]
>       ty = anType $ getAnnotation ast
>   in (ty,tes,noTypeQEs,noTypeSEs)
> -- | show a type error list in emacs format
> emacsShowErrors :: [([TypeError],Maybe SourcePosition)] -> String
> emacsShowErrors tes =
>   intercalate "\n" $ map se tes
>   where
>     se (es,sp) =
>       (case sp of
>          Nothing -> "unknown source"
>          Just (fn,l,c) -> fn ++ ":" ++ show l ++ ":" ++ show c ++ ":")
>       ++ " " ++ intercalate "\n" (map show es)