{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.RDF.Vocabulary.Generator.VocabularyGenerator
  ( genVocabulary,
  )
where

import Control.Monad (join)
import Data.Char (isLower)
import Data.List (nub, sortBy)
import qualified Data.Map as M
import Data.Maybe (maybeToList)
import Data.RDF
  ( AdjHashMap,
    LValue (..),
    Node (..),
    PrefixMappings (PrefixMappings),
    RDF,
    Rdf,
    TurtleParser (TurtleParser),
    objectOf,
    parseFile,
    prefixMappings,
    query,
    subjectOf,
    triplesOf,
  )
import Data.Text (Text)
import qualified Data.Text as T
import Language.Haskell.TH

-- | Generates 'Node' values for concepts and properties, and
-- 'Namespace' values, for a given schema in the Haskell module in
-- which 'genVocabulary' is used.
--
-- Concepts in the schema are prepended with "_", the names of
-- properties are unchanged.
--
-- For example:
--
-- >>> $(genVocabulary "resources/shacl.ttl")
--
-- creates many 'Node' values including
--
-- @
--     _SPARQLConstraint  :: Node
--     annotationProperty :: Node
-- @
--
-- This is used to auto-generate all modules in Data.RDF.Vocabulary.* at
-- compile time with Template Haskell.
genVocabulary ::
  -- | the filepath of the file containing the schema in RDF Turtle format.
  String ->
  Q [Dec]
genVocabulary :: String -> Q [Dec]
genVocabulary String
file = IO (RDF AdjHashMap) -> Q (RDF AdjHashMap)
forall a. IO a -> Q a
runIO (String -> IO (RDF AdjHashMap)
loadGraph String
file) Q (RDF AdjHashMap) -> (RDF AdjHashMap -> Q [Dec]) -> Q [Dec]
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RDF AdjHashMap -> Q [Dec]
forall a. Rdf a => RDF a -> Q [Dec]
vocabulary

loadGraph :: String -> IO (RDF AdjHashMap)
loadGraph :: String -> IO (RDF AdjHashMap)
loadGraph String
file =
  TurtleParser -> String -> IO (Either ParseFailure (RDF AdjHashMap))
forall p a.
(RdfParser p, Rdf a) =>
p -> String -> IO (Either ParseFailure (RDF a))
forall a.
Rdf a =>
TurtleParser -> String -> IO (Either ParseFailure (RDF a))
parseFile (Maybe BaseUrl -> Maybe Text -> TurtleParser
TurtleParser Maybe BaseUrl
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) String
file IO (Either ParseFailure (RDF AdjHashMap))
-> (Either ParseFailure (RDF AdjHashMap) -> IO (RDF AdjHashMap))
-> IO (RDF AdjHashMap)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either ParseFailure (RDF AdjHashMap)
result -> case Either ParseFailure (RDF AdjHashMap)
result of
    Left ParseFailure
err -> String -> IO (RDF AdjHashMap)
forall a. HasCallStack => String -> a
error (String -> IO (RDF AdjHashMap)) -> String -> IO (RDF AdjHashMap)
forall a b. (a -> b) -> a -> b
$ ParseFailure -> String
forall a. Show a => a -> String
show ParseFailure
err
    Right RDF AdjHashMap
rdfGraph -> RDF AdjHashMap -> IO (RDF AdjHashMap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RDF AdjHashMap
rdfGraph

vocabulary :: Rdf a => RDF a -> Q [Dec]
vocabulary :: forall a. Rdf a => RDF a -> Q [Dec]
vocabulary RDF a
graph =
  let nameDecls :: [(Name, Q Dec)]
nameDecls = do
        Node
subject <- [Node] -> [Node]
forall a. Eq a => [a] -> [a]
nub ([Node] -> [Node]) -> [Node] -> [Node]
forall a b. (a -> b) -> a -> b
$ Triple -> Node
subjectOf (Triple -> Node) -> [Triple] -> [Node]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RDF a -> [Triple]
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> [Triple]
triplesOf RDF a
graph
        Text
iri <- Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Text
toIRI Node
subject
        Name
name <- Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (Maybe Name -> [Name]) -> Maybe Name -> [Name]
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Name
iriToName Text
iri
        let comment :: Maybe Text
comment = Maybe [Text] -> Maybe Text
combineComments (Maybe [Text] -> Maybe Text)
-> ([Triple] -> Maybe [Text]) -> [Triple] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      [Maybe Text] -> Maybe [Text]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Maybe Text] -> Maybe [Text])
-> ([Triple] -> [Maybe Text]) -> [Triple] -> Maybe [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      (Triple -> Maybe Text) -> [Triple] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Node -> Maybe Text
nodeToComment (Node -> Maybe Text) -> (Triple -> Node) -> Triple -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Triple -> Node
objectOf) ([Triple] -> Maybe Text) -> [Triple] -> Maybe Text
forall a b. (a -> b) -> a -> b
$
                      RDF a -> Maybe Node -> Maybe Node -> Maybe Node -> [Triple]
forall rdfImpl.
Rdf rdfImpl =>
RDF rdfImpl -> Maybe Node -> Maybe Node -> Maybe Node -> [Triple]
query RDF a
graph (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
subject) (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
rdfsCommentNode) Maybe Node
forall a. Maybe a
Nothing
        (Name, Q Dec) -> [(Name, Q Dec)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
name, Name -> Text -> Maybe Text -> Q Dec
declareIRI Name
name Text
iri Maybe Text
comment)
      (PrefixMappings Map Text Text
prefixMappings') = RDF a -> PrefixMappings
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> PrefixMappings
prefixMappings RDF a
graph
      namespaceDecls :: [Q Dec]
namespaceDecls = do
        (Text
prefix, Text
iri) <- Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Text
prefixMappings'
        let name :: Name
name = String -> Name
mkName (String -> Name) -> (Text -> String) -> Text -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escape (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"NS"
        Q Dec -> [Q Dec]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Q Dec -> [Q Dec]) -> Q Dec -> [Q Dec]
forall a b. (a -> b) -> a -> b
$ Name -> Text -> Text -> Q Dec
declarePrefix Name
name Text
prefix Text
iri
      iriDecls :: [Q Dec]
iriDecls = ((Name, Q Dec) -> Q Dec) -> [(Name, Q Dec)] -> [Q Dec]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, Q Dec) -> Q Dec
forall a b. (a, b) -> b
snd ([(Name, Q Dec)] -> [Q Dec])
-> ([(Name, Q Dec)] -> [(Name, Q Dec)])
-> [(Name, Q Dec)]
-> [Q Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, Q Dec) -> (Name, Q Dec) -> Ordering)
-> [(Name, Q Dec)] -> [(Name, Q Dec)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Name, Q Dec)
x (Name, Q Dec)
y -> (Name, Q Dec) -> Name
forall a b. (a, b) -> a
fst (Name, Q Dec)
y Name -> Name -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Name, Q Dec) -> Name
forall a b. (a, b) -> a
fst (Name, Q Dec)
x) ([(Name, Q Dec)] -> [Q Dec]) -> [(Name, Q Dec)] -> [Q Dec]
forall a b. (a -> b) -> a -> b
$ [(Name, Q Dec)]
nameDecls
      irisDecl :: Q Dec
irisDecl = [Name] -> Q Dec
declareIRIs ([Name] -> Q Dec) -> [Name] -> Q Dec
forall a b. (a -> b) -> a -> b
$ (Name, Q Dec) -> Name
forall a b. (a, b) -> a
fst ((Name, Q Dec) -> Name) -> [(Name, Q Dec)] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Name, Q Dec)]
nameDecls
   in [Q Dec] -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Q Dec] -> Q [Dec]) -> [Q Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ Q Dec
irisDecl Q Dec -> [Q Dec] -> [Q Dec]
forall a. a -> [a] -> [a]
: [Q Dec]
namespaceDecls [Q Dec] -> [Q Dec] -> [Q Dec]
forall a. Semigroup a => a -> a -> a
<> [Q Dec]
iriDecls

toIRI :: Node -> Maybe Text
toIRI :: Node -> Maybe Text
toIRI (UNode Text
iri) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
iri
toIRI Node
_ = Maybe Text
forall a. Maybe a
Nothing

packFun :: Exp
packFun :: Exp
packFun = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"Data.Text.pack"

unodeFun :: Exp
unodeFun :: Exp
unodeFun = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"Data.RDF.Types.unode"

mkPrefixedNSFun :: Exp
mkPrefixedNSFun :: Exp
mkPrefixedNSFun = Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"Data.RDF.Namespace.mkPrefixedNS"

nodeToComment :: Node -> Maybe Text
nodeToComment :: Node -> Maybe Text
nodeToComment (UNode Text
uri)           = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"See \\<<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
uri Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">\\>."
nodeToComment (BNode Text
_)             = Maybe Text
forall a. Maybe a
Nothing
nodeToComment (BNodeGen Int
_)          = Maybe Text
forall a. Maybe a
Nothing
nodeToComment (LNode (PlainL Text
l))    = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
l
nodeToComment (LNode (PlainLL Text
l Text
_)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
l
nodeToComment (LNode (TypedL Text
l Text
_))  = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
l

combineComments :: Maybe [Text] -> Maybe Text
combineComments :: Maybe [Text] -> Maybe Text
combineComments = Maybe (Maybe Text) -> Maybe Text
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Text) -> Maybe Text)
-> (Maybe [Text] -> Maybe (Maybe Text))
-> Maybe [Text]
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Maybe Text) -> Maybe [Text] -> Maybe (Maybe Text)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Maybe Text
combineComments'
  where
    combineComments' :: [Text] -> Maybe Text
combineComments' [] = Maybe Text
forall a. Maybe a
Nothing
    combineComments' [Text]
comments = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Text] -> Text) -> [Text] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text]
comments

rdfsCommentNode :: Node
rdfsCommentNode :: Node
rdfsCommentNode = Text -> Node
UNode Text
"http://www.w3.org/2000/01/rdf-schema#comment"

declareIRI :: Name -> Text -> Maybe Text -> Q Dec
declareIRI :: Name -> Text -> Maybe Text -> Q Dec
declareIRI Name
name Text
iri Maybe Text
comment =
  let iriLiteral :: Exp
iriLiteral = Lit -> Exp
LitE (Lit -> Exp) -> (String -> Lit) -> String -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL (String -> Exp) -> String -> Exp
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
iri
      unodeLiteral :: Exp
unodeLiteral = Exp -> Exp -> Exp
AppE Exp
unodeFun (Exp -> Exp) -> Exp -> Exp
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
AppE Exp
packFun Exp
iriLiteral
   in Name -> [Q Clause] -> Maybe String -> [Maybe String] -> Q Dec
funD_doc Name
name [Clause -> Q Clause
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> Q Clause) -> Clause -> Q Clause
forall a b. (a -> b) -> a -> b
$ [Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB Exp
unodeLiteral) []]
               (Text -> String
T.unpack (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
comment)
               [Maybe String
forall a. Maybe a
Nothing]

declareIRIs :: [Name] -> Q Dec
declareIRIs :: [Name] -> Q Dec
declareIRIs [Name]
names =
  let iriList :: Exp
iriList = [Exp] -> Exp
ListE (Name -> Exp
VarE (Name -> Exp) -> [Name] -> [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
names)
   in Name -> [Q Clause] -> Maybe String -> [Maybe String] -> Q Dec
funD_doc (String -> Name
mkName String
"iris") [Clause -> Q Clause
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> Q Clause) -> Clause -> Q Clause
forall a b. (a -> b) -> a -> b
$ [Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB Exp
iriList) []]
               (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"All IRIs in this vocabulary.")
               [Maybe String
forall a. Maybe a
Nothing]

-- namespace = mkPrefixedNS "ogit" "http://www.purl.org/ogit/"
declarePrefix :: Name -> Text -> Text -> Q Dec
declarePrefix :: Name -> Text -> Text -> Q Dec
declarePrefix Name
name Text
prefix Text
iri =
  let prefixLiteral :: Exp
prefixLiteral = Exp -> Exp -> Exp
AppE Exp
packFun (Exp -> Exp) -> (Text -> Exp) -> Text -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> Exp
LitE (Lit -> Exp) -> (Text -> Lit) -> Text -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL (String -> Lit) -> (Text -> String) -> Text -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Exp) -> Text -> Exp
forall a b. (a -> b) -> a -> b
$ Text
prefix
      iriLiteral :: Exp
iriLiteral = Exp -> Exp -> Exp
AppE Exp
packFun (Exp -> Exp) -> (Text -> Exp) -> Text -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> Exp
LitE (Lit -> Exp) -> (Text -> Lit) -> Text -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL (String -> Lit) -> (Text -> String) -> Text -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Exp) -> Text -> Exp
forall a b. (a -> b) -> a -> b
$ Text
iri
      namespace :: Exp
namespace = Exp -> Exp -> Exp
AppE (Exp -> Exp -> Exp
AppE Exp
mkPrefixedNSFun Exp
prefixLiteral) Exp
iriLiteral
   in Name -> [Q Clause] -> Maybe String -> [Maybe String] -> Q Dec
funD_doc Name
name [Clause -> Q Clause
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> Q Clause) -> Clause -> Q Clause
forall a b. (a -> b) -> a -> b
$ [Pat] -> Body -> [Dec] -> Clause
Clause [] (Exp -> Body
NormalB Exp
namespace) []]
               (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Namespace prefix for \\<<" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
iri String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">\\>.")
               [Maybe String
forall a. Maybe a
Nothing]

iriToName :: Text -> Maybe Name
iriToName :: Text -> Maybe Name
iriToName Text
iri = String -> Name
mkName (String -> Name) -> (Text -> String) -> Text -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escape (Text -> Name) -> Maybe Text -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text] -> Maybe Text
forall a. [a] -> Maybe a
lastMay ([Text] -> Maybe Text) -> (Text -> [Text]) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
separators)) Text
iri
  where
    separators :: String
separators = [Char
'/', Char
'#']
    lastMay :: [a] -> Maybe a
    lastMay :: forall a. [a] -> Maybe a
lastMay [] = Maybe a
forall a. Maybe a
Nothing
    lastMay [a]
xs = a -> Maybe a
forall a. a -> Maybe a
Just ([a] -> a
forall a. HasCallStack => [a] -> a
last [a]
xs)

escape :: Text -> Text
escape :: Text -> Text
escape Text
name = Text -> Text
escapeKeywords (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> Text -> Text
T.map Char -> Char
escapeOperators Text
name
  where
    escapeOperators :: Char -> Char
escapeOperators Char
c | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
operators = Char
escapeChar
    escapeOperators Char
c = Char
c
    escapeKeywords :: Text -> Text
escapeKeywords Text
name' | Bool -> Bool
not (Char -> Bool
isLower (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
T.head Text
name') = Char
escapeChar Char -> Text -> Text
`T.cons` Text
name'
    escapeKeywords Text
name' | Text
name' Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
keywords = Char
escapeChar Char -> Text -> Text
`T.cons` Text
name'
    escapeKeywords Text
name' = Text
name'
    operators :: String
operators = [Char
'!', Char
'#', Char
'$', Char
'%', Char
'&', Char
'*', Char
'+', Char
'.', Char
'/', Char
'<', Char
'=', Char
'>', Char
'?', Char
'@', Char
'\\', Char
'^', Char
'|', Char
'-', Char
'~']
    keywords :: [Text]
keywords =
      [ Text
"as",
        Text
"case",
        Text
"of",
        Text
"class",
        Text
"data",
        Text
"data family",
        Text
"data instance",
        Text
"default",
        Text
"deriving",
        Text
"deriving instance",
        Text
"do",
        Text
"forall",
        Text
"foreign",
        Text
"hiding",
        Text
"if",
        Text
"then",
        Text
"else",
        Text
"import",
        Text
"infix",
        Text
"infixl",
        Text
"infixr",
        Text
"instance",
        Text
"let",
        Text
"in",
        Text
"mdo",
        Text
"module",
        Text
"newtype",
        Text
"proc",
        Text
"qualified",
        Text
"rec",
        Text
"type",
        Text
"type family",
        Text
"type instance",
        Text
"where"
      ]
    escapeChar :: Char
escapeChar = Char
'_'