{- |
    Module      :  $Header$
    Description :  Split module into code fragments
    Copyright   :  (c) 2014 - 2016 Björn Peemöller
                       2016        Jan Tikovsky
                       2016 - 2017 Finn Teegen
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    This module arranges the tokens of the module into different code
    categories for HTML presentation. The parsed and qualified module
    is used to establish links between used identifiers and their definitions.

    The fully qualified module is traversed to generate a list of code elements.
    Code elements representing identifiers are distinguished by their kind
    (type constructor, data constructor, function, (type) variable).
    They include information about their usage (i.e., declaration, call etc.)
    and whether the identifier occurs fully qualified in
    the source code or not. Initially, all identifier codes are fully qualified.

    In a next step, the token stream of the given program and the code list are
    traversed sequentially (see `encodeToks`). The information in the token
    stream is used to:

      * add code elements for newlines, spaces and pragmas
      * update the qualification information of identifiers in the code list.
-}

module Html.SyntaxColoring
  ( Code (..), TypeUsage (..), ConsUsage (..)
  , IdentUsage (..), FuncUsage (..)
  , genProgram, code2string, getQualIdent
  ) where

import Data.Function (on)
import Data.List     (sortBy)

import Curry.Base.Ident
import Curry.Base.Position
import Curry.Base.SpanInfo ()
import Curry.Syntax

import Base.Messages

-- |Type of codes which are distinguished for HTML output
-- the boolean flags indicate whether the corresponding identifier
-- occurs qualified in the source module
data Code
  = Keyword     String
  | Space       Int
  | NewLine
  | Pragma      String
  | TypeCons    TypeUsage  Bool QualIdent
  | DataCons    ConsUsage  Bool QualIdent
  | Function    FuncUsage  Bool QualIdent
  | Identifier  IdentUsage Bool QualIdent
  | ModuleName  ModuleIdent
  | Commentary  String
  | NumberCode  String
  | StringCode  String
  | CharCode    String
  | Symbol      String
    deriving Int -> Code -> ShowS
[Code] -> ShowS
Code -> String
(Int -> Code -> ShowS)
-> (Code -> String) -> ([Code] -> ShowS) -> Show Code
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Code] -> ShowS
$cshowList :: [Code] -> ShowS
show :: Code -> String
$cshow :: Code -> String
showsPrec :: Int -> Code -> ShowS
$cshowsPrec :: Int -> Code -> ShowS
Show

data TypeUsage
  = TypeDeclare
  | TypeRefer
  | TypeExport
  | TypeImport
    deriving Int -> TypeUsage -> ShowS
[TypeUsage] -> ShowS
TypeUsage -> String
(Int -> TypeUsage -> ShowS)
-> (TypeUsage -> String)
-> ([TypeUsage] -> ShowS)
-> Show TypeUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeUsage] -> ShowS
$cshowList :: [TypeUsage] -> ShowS
show :: TypeUsage -> String
$cshow :: TypeUsage -> String
showsPrec :: Int -> TypeUsage -> ShowS
$cshowsPrec :: Int -> TypeUsage -> ShowS
Show

data ConsUsage
  = ConsDeclare
  | ConsPattern
  | ConsCall
  | ConsInfix
  | ConsExport
  | ConsImport
    deriving Int -> ConsUsage -> ShowS
[ConsUsage] -> ShowS
ConsUsage -> String
(Int -> ConsUsage -> ShowS)
-> (ConsUsage -> String)
-> ([ConsUsage] -> ShowS)
-> Show ConsUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConsUsage] -> ShowS
$cshowList :: [ConsUsage] -> ShowS
show :: ConsUsage -> String
$cshow :: ConsUsage -> String
showsPrec :: Int -> ConsUsage -> ShowS
$cshowsPrec :: Int -> ConsUsage -> ShowS
Show

data FuncUsage
  = FuncDeclare
  | FuncTypeSig
  | FuncCall
  | FuncInfix
  | FuncExport
  | FuncImport
    deriving Int -> FuncUsage -> ShowS
[FuncUsage] -> ShowS
FuncUsage -> String
(Int -> FuncUsage -> ShowS)
-> (FuncUsage -> String)
-> ([FuncUsage] -> ShowS)
-> Show FuncUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FuncUsage] -> ShowS
$cshowList :: [FuncUsage] -> ShowS
show :: FuncUsage -> String
$cshow :: FuncUsage -> String
showsPrec :: Int -> FuncUsage -> ShowS
$cshowsPrec :: Int -> FuncUsage -> ShowS
Show

data IdentUsage
  = IdDeclare -- declare a (type) variable
  | IdRefer   -- refer to a (type) variable
  | IdUnknown -- unknown usage
    deriving Int -> IdentUsage -> ShowS
[IdentUsage] -> ShowS
IdentUsage -> String
(Int -> IdentUsage -> ShowS)
-> (IdentUsage -> String)
-> ([IdentUsage] -> ShowS)
-> Show IdentUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdentUsage] -> ShowS
$cshowList :: [IdentUsage] -> ShowS
show :: IdentUsage -> String
$cshow :: IdentUsage -> String
showsPrec :: Int -> IdentUsage -> ShowS
$cshowsPrec :: Int -> IdentUsage -> ShowS
Show

-- @param fully qualified module
-- @param lex-Result
-- @return code list
genProgram :: Module a -> [(Position, Token)] -> [Code]
genProgram :: Module a -> [(Position, Token)] -> [Code]
genProgram m :: Module a
m pts :: [(Position, Token)]
pts = Position -> [Code] -> [(Position, Token)] -> [Code]
encodeToks (String -> Position
first "") ((Code -> Bool) -> [Code] -> [Code]
forall a. (a -> Bool) -> [a] -> [a]
filter Code -> Bool
validCode (Module a -> [Code]
forall a. Module a -> [Code]
idsModule Module a
m)) [(Position, Token)]
pts

-- predicate to remove identifier codes for primitives
-- because they do not form valid link targets
validCode :: Code -> Bool
validCode :: Code -> Bool
validCode (TypeCons   _ _ t :: QualIdent
t) = QualIdent
t QualIdent -> [QualIdent] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [QualIdent
qUnitId, QualIdent
qListId]         Bool -> Bool -> Bool
&& Bool -> Bool
not (QualIdent -> Bool
isQTupleId QualIdent
t)
validCode (DataCons   _ _ c :: QualIdent
c) = QualIdent
c QualIdent -> [QualIdent] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [QualIdent
qUnitId, QualIdent
qNilId, QualIdent
qConsId] Bool -> Bool -> Bool
&& Bool -> Bool
not (QualIdent -> Bool
isQTupleId QualIdent
c)
validCode (Identifier _ _ i :: QualIdent
i) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Ident -> Bool
isAnonId (Ident -> Bool) -> Ident -> Bool
forall a b. (a -> b) -> a -> b
$ QualIdent -> Ident
unqualify QualIdent
i
validCode _                  = Bool
True

-- @param code
-- @return qid if available
getQualIdent :: Code -> Maybe QualIdent
getQualIdent :: Code -> Maybe QualIdent
getQualIdent (DataCons   _ _ qid :: QualIdent
qid) = QualIdent -> Maybe QualIdent
forall a. a -> Maybe a
Just QualIdent
qid
getQualIdent (Function   _ _ qid :: QualIdent
qid) = QualIdent -> Maybe QualIdent
forall a. a -> Maybe a
Just QualIdent
qid
getQualIdent (Identifier _ _ qid :: QualIdent
qid) = QualIdent -> Maybe QualIdent
forall a. a -> Maybe a
Just QualIdent
qid
getQualIdent (TypeCons   _ _ qid :: QualIdent
qid) = QualIdent -> Maybe QualIdent
forall a. a -> Maybe a
Just QualIdent
qid
getQualIdent _                    = Maybe QualIdent
forall a. Maybe a
Nothing

encodeToks :: Position -> [Code] -> [(Position, Token)] -> [Code]
encodeToks :: Position -> [Code] -> [(Position, Token)] -> [Code]
encodeToks _   _   []                     = []
encodeToks cur :: Position
cur ids :: [Code]
ids toks :: [(Position, Token)]
toks@((pos :: Position
pos, tok :: Token
tok) : ts :: [(Position, Token)]
ts)
  -- advance line
  | Position -> Int
line Position
cur   Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Position -> Int
line   Position
pos = Code
NewLine Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: Position -> [Code] -> [(Position, Token)] -> [Code]
encodeToks (Position -> Position
nl Position
cur) [Code]
ids [(Position, Token)]
toks
  -- advance column
  | Position -> Int
column Position
cur Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Position -> Int
column Position
pos = let d :: Int
d = Position -> Int
column Position
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Position -> Int
column Position
cur
                              in  Int -> Code
Space Int
d Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: Position -> [Code] -> [(Position, Token)] -> [Code]
encodeToks (Position -> Int -> Position
incr Position
cur Int
d) [Code]
ids [(Position, Token)]
toks
  -- pragma token
  | Token -> Bool
isPragmaToken Token
tok       = let (ps :: [(Position, Token)]
ps, (end :: (Position, Token)
end:rest :: [(Position, Token)]
rest)) = ((Position, Token) -> Bool)
-> [(Position, Token)]
-> ([(Position, Token)], [(Position, Token)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Token -> Bool
isPragmaEnd (Token -> Bool)
-> ((Position, Token) -> Token) -> (Position, Token) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, Token) -> Token
forall a b. (a, b) -> b
snd) [(Position, Token)]
toks
                                  s :: String
s = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((Position, Token) -> String) -> [(Position, Token)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Token -> String
showToken (Token -> String)
-> ((Position, Token) -> Token) -> (Position, Token) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position, Token) -> Token
forall a b. (a, b) -> b
snd) ([(Position, Token)]
ps [(Position, Token)] -> [(Position, Token)] -> [(Position, Token)]
forall a. [a] -> [a] -> [a]
++ [(Position, Token)
end])
                              in  String -> Code
Pragma String
s Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: Position -> [Code] -> [(Position, Token)] -> [Code]
encodeToks (Position -> Int -> Position
incr Position
cur (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s)) [Code]
ids [(Position, Token)]
rest
  -- identifier token
  | Token -> Bool
isIdentTok Token
tok          = case [Code]
ids of
    []     -> Token -> Code
encodeTok Token
tok Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: Position -> [Code] -> [(Position, Token)] -> [Code]
encodeToks Position
newPos [] [(Position, Token)]
ts
    (i :: Code
i:is :: [Code]
is)
      | String
tokenStr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Code -> String
code2string Code
i' -> Code
i' Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: Position -> [Code] -> [(Position, Token)] -> [Code]
encodeToks Position
newPos [Code]
is [(Position, Token)]
ts
  -- the 'otherwise' case should never occur if the token stream and
  -- the qualified AST which was used to generate the code list correspond to
  -- the same module
      | Bool
otherwise                  -> Position -> [Code] -> [(Position, Token)] -> [Code]
encodeToks Position
cur [Code]
is [(Position, Token)]
toks
      where i' :: Code
i' = Bool -> Code -> Code
setQualified (Token -> Bool
isQualIdentTok Token
tok) Code
i
  -- other token
  | Bool
otherwise               = Token -> Code
encodeTok Token
tok Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: Position -> [Code] -> [(Position, Token)] -> [Code]
encodeToks Position
newPos [Code]
ids [(Position, Token)]
ts
  where
  tokenStr :: String
tokenStr = Token -> String
showToken Token
tok
  newPos :: Position
newPos   = Position -> Int -> Position
incr Position
cur (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tokenStr)

setQualified :: Bool -> Code -> Code
setQualified :: Bool -> Code -> Code
setQualified b :: Bool
b (DataCons   u :: ConsUsage
u _ c :: QualIdent
c) = ConsUsage -> Bool -> QualIdent -> Code
DataCons ConsUsage
u Bool
b QualIdent
c
setQualified b :: Bool
b (Function   u :: FuncUsage
u _ f :: QualIdent
f) = FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
u Bool
b QualIdent
f
setQualified b :: Bool
b (Identifier u :: IdentUsage
u _ i :: QualIdent
i) = IdentUsage -> Bool -> QualIdent -> Code
Identifier IdentUsage
u Bool
b QualIdent
i
setQualified b :: Bool
b (TypeCons   u :: TypeUsage
u _ t :: QualIdent
t) = TypeUsage -> Bool -> QualIdent -> Code
TypeCons TypeUsage
u Bool
b QualIdent
t
setQualified _ m :: Code
m@(ModuleName   _) = Code
m
setQualified _ s :: Code
s@(Symbol       _) = Code
s
setQualified _ c :: Code
c                  = String -> Code
forall a. String -> a
internalError (String -> Code) -> String -> Code
forall a b. (a -> b) -> a -> b
$ "Html.SyntaxColoring.setQualified: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Code -> String
forall a. Show a => a -> String
show Code
c

code2string :: Code -> String
code2string :: Code -> String
code2string (Keyword           s :: String
s) = String
s
code2string (Space             i :: Int
i) = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i ' '
code2string NewLine               = "\n"
code2string (Pragma            s :: String
s) = String
s
code2string (DataCons    _ b :: Bool
b qid :: QualIdent
qid) = Bool -> QualIdent -> String
ident2string Bool
b QualIdent
qid
code2string (TypeCons    _ b :: Bool
b qid :: QualIdent
qid) = Bool -> QualIdent -> String
ident2string Bool
b QualIdent
qid
code2string (Function    _ b :: Bool
b qid :: QualIdent
qid) = Bool -> QualIdent -> String
ident2string Bool
b QualIdent
qid
code2string (Identifier  _ b :: Bool
b qid :: QualIdent
qid) = Bool -> QualIdent -> String
ident2string Bool
b QualIdent
qid
code2string (ModuleName      mid :: ModuleIdent
mid) = ModuleIdent -> String
moduleName ModuleIdent
mid
code2string (Commentary        s :: String
s) = String
s
code2string (NumberCode        s :: String
s) = String
s
code2string (StringCode        s :: String
s) = String
s
code2string (CharCode          s :: String
s) = String
s
code2string (Symbol            s :: String
s) = String
s

ident2string :: Bool -> QualIdent -> String
ident2string :: Bool -> QualIdent -> String
ident2string False q :: QualIdent
q = Ident -> String
idName (Ident -> String) -> Ident -> String
forall a b. (a -> b) -> a -> b
$ QualIdent -> Ident
unqualify QualIdent
q
ident2string True  q :: QualIdent
q = QualIdent -> String
qualName QualIdent
q

encodeTok :: Token -> Code
encodeTok :: Token -> Code
encodeTok tok :: Token
tok@(Token c :: Category
c _)
  | Category
c Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category]
numCategories          = String -> Code
NumberCode (Token -> String
showToken Token
tok)
  | Category
c Category -> Category -> Bool
forall a. Eq a => a -> a -> Bool
== Category
CharTok                    = String -> Code
CharCode   (Token -> String
showToken Token
tok)
  | Category
c Category -> Category -> Bool
forall a. Eq a => a -> a -> Bool
== Category
StringTok                  = String -> Code
StringCode (Token -> String
showToken Token
tok)
  | Category
c Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category]
keywordCategories      = String -> Code
Keyword    (Token -> String
showToken Token
tok)
  | Category
c Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category]
specialIdentCategories = String -> Code
Keyword    (Token -> String
showToken Token
tok)
  | Category
c Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category]
punctuationCategories  = String -> Code
Symbol     (Token -> String
showToken Token
tok)
  | Category
c Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category]
reservedOpsCategories  = String -> Code
Symbol     (Token -> String
showToken Token
tok)
  | Category
c Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category]
commentCategories      = String -> Code
Commentary (Token -> String
showToken Token
tok)
  | Category
c Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category]
identCategories        = IdentUsage -> Bool -> QualIdent -> Code
Identifier IdentUsage
IdUnknown Bool
False (QualIdent -> Code) -> QualIdent -> Code
forall a b. (a -> b) -> a -> b
$ Ident -> QualIdent
qualify (Ident -> QualIdent) -> Ident -> QualIdent
forall a b. (a -> b) -> a -> b
$ String -> Ident
mkIdent
                                      (String -> Ident) -> String -> Ident
forall a b. (a -> b) -> a -> b
$ Token -> String
showToken Token
tok
  | Category
c Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category]
whiteSpaceCategories   = Int -> Code
Space 0
  | Category
c Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category]
pragmaCategories       = String -> Code
Pragma     (Token -> String
showToken Token
tok)
  | Bool
otherwise                       = String -> Code
forall a. String -> a
internalError (String -> Code) -> String -> Code
forall a b. (a -> b) -> a -> b
$
    "SyntaxColoring.encodeTok: Unknown token " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Token -> String
showToken Token
tok

numCategories :: [Category]
numCategories :: [Category]
numCategories = [Category
IntTok, Category
FloatTok]

keywordCategories :: [Category]
keywordCategories :: [Category]
keywordCategories =
  [ Category
KW_case, Category
KW_class, Category
KW_data, Category
KW_default, Category
KW_deriving, Category
KW_do, Category
KW_else
  , Category
KW_external, Category
KW_fcase, Category
KW_free, Category
KW_if, Category
KW_import, Category
KW_in
  , Category
KW_infix, Category
KW_infixl, Category
KW_infixr, Category
KW_instance, Category
KW_let, Category
KW_module, Category
KW_newtype
  , Category
KW_of, Category
KW_then, Category
KW_type, Category
KW_where
  ]

specialIdentCategories :: [Category]
specialIdentCategories :: [Category]
specialIdentCategories =
  [ Category
Id_as, Category
Id_ccall, Category
Id_forall, Category
Id_hiding
  , Category
Id_interface, Category
Id_primitive, Category
Id_qualified ]

punctuationCategories :: [Category]
punctuationCategories :: [Category]
punctuationCategories =
  [ Category
LeftParen, Category
RightParen, Category
Semicolon, Category
LeftBrace, Category
RightBrace
  , Category
LeftBracket, Category
RightBracket, Category
Comma, Category
Underscore, Category
Backquote ]

reservedOpsCategories :: [Category]
reservedOpsCategories :: [Category]
reservedOpsCategories =
  [ Category
At, Category
Colon, Category
DotDot, Category
DoubleArrow, Category
DoubleColon, Category
Equals, Category
Backslash, Category
Bar
  , Category
LeftArrow, Category
RightArrow, Category
Tilde ]

commentCategories :: [Category]
commentCategories :: [Category]
commentCategories = [Category
LineComment, Category
NestedComment]

identCategories :: [Category]
identCategories :: [Category]
identCategories = [Category
Id, Category
QId, Category
Sym, Category
QSym, Category
SymDot, Category
SymMinus, Category
SymStar]

isPragmaToken :: Token -> Bool
isPragmaToken :: Token -> Bool
isPragmaToken (Token c :: Category
c _) = Category
c Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category]
pragmaCategories

isPragmaEnd :: Token -> Bool
isPragmaEnd :: Token -> Bool
isPragmaEnd (Token c :: Category
c _) = Category
c Category -> Category -> Bool
forall a. Eq a => a -> a -> Bool
== Category
PragmaEnd

isIdentTok :: Token -> Bool
isIdentTok :: Token -> Bool
isIdentTok (Token c :: Category
c _) = Category
c Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category]
identCategories

isQualIdentTok :: Token -> Bool
isQualIdentTok :: Token -> Bool
isQualIdentTok (Token c :: Category
c _) = Category
c Category -> [Category] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Category
QId, Category
QSym]

whiteSpaceCategories :: [Category]
whiteSpaceCategories :: [Category]
whiteSpaceCategories = [Category
EOF, Category
VSemicolon, Category
VRightBrace]

pragmaCategories :: [Category]
pragmaCategories :: [Category]
pragmaCategories = [Category
PragmaLanguage, Category
PragmaOptions, Category
PragmaEnd]

cmpDecl :: Decl a -> Decl a -> Ordering
cmpDecl :: Decl a -> Decl a -> Ordering
cmpDecl = Position -> Position -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Position -> Position -> Ordering)
-> (Decl a -> Position) -> Decl a -> Decl a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Decl a -> Position
forall a. HasPosition a => a -> Position
getPosition

cmpImportDecl :: ImportDecl -> ImportDecl -> Ordering
cmpImportDecl :: ImportDecl -> ImportDecl -> Ordering
cmpImportDecl = Position -> Position -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Position -> Position -> Ordering)
-> (ImportDecl -> Position) -> ImportDecl -> ImportDecl -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportDecl -> Position
forall a. HasPosition a => a -> Position
getPosition

-- -----------------------------------------------------------------------------
-- Extract all identifiers mentioned in the source code as a Code entity
-- in the order of their occurrence. The extracted information is then used
-- to enrich the identifier tokens with additional information, e.g., for
-- link generation.
-- -----------------------------------------------------------------------------

idsModule :: Module a -> [Code]
idsModule :: Module a -> [Code]
idsModule (Module _ _ _ mid :: ModuleIdent
mid es :: Maybe ExportSpec
es is :: [ImportDecl]
is ds :: [Decl a]
ds) =
  let hdrCodes :: [Code]
hdrCodes = ModuleIdent -> Code
ModuleName ModuleIdent
mid Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: Maybe ExportSpec -> [Code]
idsExportSpec Maybe ExportSpec
es
      impCodes :: [Code]
impCodes = (ImportDecl -> [Code]) -> [ImportDecl] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ImportDecl -> [Code]
idsImportDecl ((ImportDecl -> ImportDecl -> Ordering)
-> [ImportDecl] -> [ImportDecl]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ImportDecl -> ImportDecl -> Ordering
cmpImportDecl [ImportDecl]
is)
      dclCodes :: [Code]
dclCodes = (Decl a -> [Code]) -> [Decl a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl a -> [Code]
forall a. Decl a -> [Code]
idsDecl       ((Decl a -> Decl a -> Ordering) -> [Decl a] -> [Decl a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Decl a -> Decl a -> Ordering
forall a. Decl a -> Decl a -> Ordering
cmpDecl [Decl a]
ds)
  in  [Code]
hdrCodes [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ [Code]
impCodes [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ [Code]
dclCodes

-- Exports

idsExportSpec ::  Maybe ExportSpec -> [Code]
idsExportSpec :: Maybe ExportSpec -> [Code]
idsExportSpec Nothing                 = []
idsExportSpec (Just (Exporting _ es :: [Export]
es)) = (Export -> [Code]) -> [Export] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Export -> [Code]
idsExport [Export]
es

idsExport :: Export -> [Code]
idsExport :: Export -> [Code]
idsExport (Export            _ qid :: QualIdent
qid) = [FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncExport Bool
False QualIdent
qid]
idsExport (ExportTypeWith _ qid :: QualIdent
qid cs :: [Ident]
cs) = TypeUsage -> Bool -> QualIdent -> Code
TypeCons TypeUsage
TypeExport Bool
False QualIdent
qid Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
:
  (Ident -> Code) -> [Ident] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map (ConsUsage -> Bool -> QualIdent -> Code
DataCons ConsUsage
ConsExport Bool
False (QualIdent -> Code) -> (Ident -> QualIdent) -> Ident -> Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent
qualify) [Ident]
cs
idsExport (ExportTypeAll     _ qid :: QualIdent
qid) = [TypeUsage -> Bool -> QualIdent -> Code
TypeCons TypeUsage
TypeExport Bool
False QualIdent
qid]
idsExport (ExportModule      _ mid :: ModuleIdent
mid) = [ModuleIdent -> Code
ModuleName ModuleIdent
mid]

-- Imports

idsImportDecl :: ImportDecl -> [Code]
idsImportDecl :: ImportDecl -> [Code]
idsImportDecl (ImportDecl _ mid :: ModuleIdent
mid _ mAlias :: Maybe ModuleIdent
mAlias spec :: Maybe ImportSpec
spec)
  = ModuleIdent -> Code
ModuleName ModuleIdent
mid Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: [Code]
aliasCode [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ [Code] -> (ImportSpec -> [Code]) -> Maybe ImportSpec -> [Code]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (ModuleIdent -> ImportSpec -> [Code]
idsImportSpec ModuleIdent
mid) Maybe ImportSpec
spec
  where aliasCode :: [Code]
aliasCode = [Code] -> (ModuleIdent -> [Code]) -> Maybe ModuleIdent -> [Code]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
:[]) (Code -> [Code]) -> (ModuleIdent -> Code) -> ModuleIdent -> [Code]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdent -> Code
ModuleName) Maybe ModuleIdent
mAlias

idsImportSpec :: ModuleIdent -> ImportSpec -> [Code]
idsImportSpec :: ModuleIdent -> ImportSpec -> [Code]
idsImportSpec mid :: ModuleIdent
mid (Importing _ is :: [Import]
is) = (Import -> [Code]) -> [Import] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModuleIdent -> Import -> [Code]
idsImport ModuleIdent
mid) [Import]
is
idsImportSpec mid :: ModuleIdent
mid (Hiding    _ is :: [Import]
is) = (Import -> [Code]) -> [Import] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModuleIdent -> Import -> [Code]
idsImport ModuleIdent
mid) [Import]
is

idsImport :: ModuleIdent -> Import -> [Code]
idsImport :: ModuleIdent -> Import -> [Code]
idsImport mid :: ModuleIdent
mid (Import            _ i :: Ident
i) =
  [FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncImport Bool
False (QualIdent -> Code) -> QualIdent -> Code
forall a b. (a -> b) -> a -> b
$ ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
mid Ident
i]
idsImport mid :: ModuleIdent
mid (ImportTypeWith _ t :: Ident
t cs :: [Ident]
cs) =
  TypeUsage -> Bool -> QualIdent -> Code
TypeCons TypeUsage
TypeImport Bool
False (ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
mid Ident
t) Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
:
    (Ident -> Code) -> [Ident] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map (ConsUsage -> Bool -> QualIdent -> Code
DataCons ConsUsage
ConsImport Bool
False (QualIdent -> Code) -> (Ident -> QualIdent) -> Ident -> Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
mid) [Ident]
cs
idsImport mid :: ModuleIdent
mid (ImportTypeAll     _ t :: Ident
t) =
  [TypeUsage -> Bool -> QualIdent -> Code
TypeCons TypeUsage
TypeImport Bool
False (QualIdent -> Code) -> QualIdent -> Code
forall a b. (a -> b) -> a -> b
$ ModuleIdent -> Ident -> QualIdent
qualifyWith ModuleIdent
mid Ident
t]

-- Declarations

idsDecl :: Decl a -> [Code]
idsDecl :: Decl a -> [Code]
idsDecl (InfixDecl         _ _ _ ops :: [Ident]
ops) =
  (Ident -> Code) -> [Ident] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map (FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncInfix Bool
False (QualIdent -> Code) -> (Ident -> QualIdent) -> Ident -> Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent
qualify) [Ident]
ops
idsDecl (DataDecl    _ d :: Ident
d vs :: [Ident]
vs cds :: [ConstrDecl]
cds clss :: [QualIdent]
clss) =
  TypeUsage -> Bool -> QualIdent -> Code
TypeCons TypeUsage
TypeDeclare Bool
False (Ident -> QualIdent
qualify Ident
d) Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
:
    (Ident -> Code) -> [Ident] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map (IdentUsage -> Bool -> QualIdent -> Code
Identifier IdentUsage
IdDeclare Bool
False (QualIdent -> Code) -> (Ident -> QualIdent) -> Ident -> Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent
qualify) [Ident]
vs [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++
      (ConstrDecl -> [Code]) -> [ConstrDecl] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ConstrDecl -> [Code]
idsConstrDecl [ConstrDecl]
cds [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ (QualIdent -> Code) -> [QualIdent] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map (TypeUsage -> Bool -> QualIdent -> Code
TypeCons TypeUsage
TypeRefer Bool
False) [QualIdent]
clss
idsDecl (ExternalDataDecl     _ d :: Ident
d vs :: [Ident]
vs) =
  TypeUsage -> Bool -> QualIdent -> Code
TypeCons TypeUsage
TypeDeclare Bool
False (Ident -> QualIdent
qualify Ident
d) Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
:
    (Ident -> Code) -> [Ident] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map (IdentUsage -> Bool -> QualIdent -> Code
Identifier IdentUsage
IdDeclare Bool
False (QualIdent -> Code) -> (Ident -> QualIdent) -> Ident -> Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent
qualify) [Ident]
vs
idsDecl (NewtypeDecl  _ t :: Ident
t vs :: [Ident]
vs nc :: NewConstrDecl
nc clss :: [QualIdent]
clss) =
  TypeUsage -> Bool -> QualIdent -> Code
TypeCons TypeUsage
TypeDeclare Bool
False (Ident -> QualIdent
qualify Ident
t) Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
:
    (Ident -> Code) -> [Ident] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map (IdentUsage -> Bool -> QualIdent -> Code
Identifier IdentUsage
IdDeclare Bool
False (QualIdent -> Code) -> (Ident -> QualIdent) -> Ident -> Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent
qualify) [Ident]
vs [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ NewConstrDecl -> [Code]
idsNewConstrDecl NewConstrDecl
nc [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++
      (QualIdent -> Code) -> [QualIdent] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map (TypeUsage -> Bool -> QualIdent -> Code
TypeCons TypeUsage
TypeRefer Bool
False) [QualIdent]
clss
idsDecl (TypeDecl          _ t :: Ident
t vs :: [Ident]
vs ty :: TypeExpr
ty) =
  TypeUsage -> Bool -> QualIdent -> Code
TypeCons TypeUsage
TypeDeclare Bool
False (Ident -> QualIdent
qualify Ident
t) Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
:
    (Ident -> Code) -> [Ident] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map (IdentUsage -> Bool -> QualIdent -> Code
Identifier IdentUsage
IdDeclare Bool
False (QualIdent -> Code) -> (Ident -> QualIdent) -> Ident -> Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent
qualify) [Ident]
vs [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ TypeExpr -> [Code]
idsTypeExpr TypeExpr
ty
idsDecl (TypeSig            _ fs :: [Ident]
fs qty :: QualTypeExpr
qty) =
  (Ident -> Code) -> [Ident] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map (FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncTypeSig Bool
False (QualIdent -> Code) -> (Ident -> QualIdent) -> Ident -> Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent
qualify) [Ident]
fs [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ QualTypeExpr -> [Code]
idsQualTypeExpr QualTypeExpr
qty
idsDecl (FunctionDecl      _ _ _ eqs :: [Equation a]
eqs) = (Equation a -> [Code]) -> [Equation a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Equation a -> [Code]
forall a. Equation a -> [Code]
idsEquation [Equation a]
eqs
idsDecl (ExternalDecl           _ fs :: [Var a]
fs) =
  (Var a -> Code) -> [Var a] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map (FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncDeclare Bool
False (QualIdent -> Code) -> (Var a -> QualIdent) -> Var a -> Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent
qualify (Ident -> QualIdent) -> (Var a -> Ident) -> Var a -> QualIdent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var a -> Ident
forall a. Var a -> Ident
varIdent) [Var a]
fs
idsDecl (PatternDecl         _ p :: Pattern a
p rhs :: Rhs a
rhs) = Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat Pattern a
p [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ Rhs a -> [Code]
forall a. Rhs a -> [Code]
idsRhs Rhs a
rhs
idsDecl (FreeDecl               _ vs :: [Var a]
vs) =
  (Var a -> Code) -> [Var a] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map (IdentUsage -> Bool -> QualIdent -> Code
Identifier IdentUsage
IdDeclare Bool
False (QualIdent -> Code) -> (Var a -> QualIdent) -> Var a -> Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent
qualify (Ident -> QualIdent) -> (Var a -> Ident) -> Var a -> QualIdent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var a -> Ident
forall a. Var a -> Ident
varIdent) [Var a]
vs
idsDecl (DefaultDecl           _ tys :: [TypeExpr]
tys) = (TypeExpr -> [Code]) -> [TypeExpr] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TypeExpr -> [Code]
idsTypeExpr [TypeExpr]
tys
idsDecl (ClassDecl     _ _ cx :: Context
cx c :: Ident
c v :: Ident
v ds :: [Decl a]
ds) =
  Context -> [Code]
idsContext Context
cx [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ TypeUsage -> Bool -> QualIdent -> Code
TypeCons TypeUsage
TypeDeclare Bool
False (Ident -> QualIdent
qualify Ident
c) Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
:
    IdentUsage -> Bool -> QualIdent -> Code
Identifier IdentUsage
IdDeclare Bool
False (Ident -> QualIdent
qualify Ident
v) Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: (Decl a -> [Code]) -> [Decl a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl a -> [Code]
forall a. Decl a -> [Code]
idsClassDecl [Decl a]
ds
idsDecl (InstanceDecl _ _ cx :: Context
cx c :: QualIdent
c ty :: TypeExpr
ty ds :: [Decl a]
ds) = Context -> [Code]
idsContext Context
cx [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++
  TypeUsage -> Bool -> QualIdent -> Code
TypeCons TypeUsage
TypeRefer Bool
False QualIdent
c Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: TypeExpr -> [Code]
idsTypeExpr TypeExpr
ty [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ (Decl a -> [Code]) -> [Decl a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl a -> [Code]
forall a. Decl a -> [Code]
idsInstanceDecl [Decl a]
ds

idsConstrDecl :: ConstrDecl -> [Code]
idsConstrDecl :: ConstrDecl -> [Code]
idsConstrDecl (ConstrDecl     _ c :: Ident
c tys :: [TypeExpr]
tys) =
  ConsUsage -> Bool -> QualIdent -> Code
DataCons ConsUsage
ConsDeclare Bool
False (Ident -> QualIdent
qualify Ident
c) Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: (TypeExpr -> [Code]) -> [TypeExpr] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TypeExpr -> [Code]
idsTypeExpr [TypeExpr]
tys
idsConstrDecl (ConOpDecl _ ty1 :: TypeExpr
ty1 op :: Ident
op ty2 :: TypeExpr
ty2) =
  TypeExpr -> [Code]
idsTypeExpr TypeExpr
ty1 [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ (ConsUsage -> Bool -> QualIdent -> Code
DataCons ConsUsage
ConsDeclare Bool
False (QualIdent -> Code) -> QualIdent -> Code
forall a b. (a -> b) -> a -> b
$ Ident -> QualIdent
qualify Ident
op) Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: TypeExpr -> [Code]
idsTypeExpr TypeExpr
ty2
idsConstrDecl (RecordDecl      _ c :: Ident
c fs :: [FieldDecl]
fs) =
  ConsUsage -> Bool -> QualIdent -> Code
DataCons ConsUsage
ConsDeclare Bool
False (Ident -> QualIdent
qualify Ident
c) Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: (FieldDecl -> [Code]) -> [FieldDecl] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FieldDecl -> [Code]
idsFieldDecl [FieldDecl]
fs

idsNewConstrDecl :: NewConstrDecl -> [Code]
idsNewConstrDecl :: NewConstrDecl -> [Code]
idsNewConstrDecl (NewConstrDecl _ c :: Ident
c     ty :: TypeExpr
ty) =
  ConsUsage -> Bool -> QualIdent -> Code
DataCons ConsUsage
ConsDeclare Bool
False (Ident -> QualIdent
qualify Ident
c) Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: TypeExpr -> [Code]
idsTypeExpr TypeExpr
ty
idsNewConstrDecl (NewRecordDecl _ c :: Ident
c (l :: Ident
l,ty :: TypeExpr
ty)) =
  ConsUsage -> Bool -> QualIdent -> Code
DataCons ConsUsage
ConsDeclare Bool
False (Ident -> QualIdent
qualify Ident
c) Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
:
    (FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncDeclare Bool
False (QualIdent -> Code) -> QualIdent -> Code
forall a b. (a -> b) -> a -> b
$ Ident -> QualIdent
qualify Ident
l) Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: TypeExpr -> [Code]
idsTypeExpr TypeExpr
ty

idsClassDecl :: Decl a -> [Code]
idsClassDecl :: Decl a -> [Code]
idsClassDecl (TypeSig       _ fs :: [Ident]
fs qty :: QualTypeExpr
qty) =
  (Ident -> Code) -> [Ident] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map (FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncDeclare Bool
False (QualIdent -> Code) -> (Ident -> QualIdent) -> Ident -> Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent
qualify) [Ident]
fs [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ QualTypeExpr -> [Code]
idsQualTypeExpr QualTypeExpr
qty
idsClassDecl (FunctionDecl _ _ _ eqs :: [Equation a]
eqs) = (Equation a -> [Code]) -> [Equation a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Equation a -> [Code]
forall a. Equation a -> [Code]
idsEquation [Equation a]
eqs
idsClassDecl _                        =
  String -> [Code]
forall a. String -> a
internalError "SyntaxColoring.idsClassDecl"

idsInstanceDecl :: Decl a -> [Code]
idsInstanceDecl :: Decl a -> [Code]
idsInstanceDecl (FunctionDecl _ _ _ eqs :: [Equation a]
eqs) = (Equation a -> [Code]) -> [Equation a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Equation a -> [Code]
forall a. Equation a -> [Code]
idsEquation [Equation a]
eqs
idsInstanceDecl _                        =
  String -> [Code]
forall a. String -> a
internalError "SyntaxColoring.idsInstanceDecl"

idsQualTypeExpr :: QualTypeExpr -> [Code]
idsQualTypeExpr :: QualTypeExpr -> [Code]
idsQualTypeExpr (QualTypeExpr _ cx :: Context
cx ty :: TypeExpr
ty) = Context -> [Code]
idsContext Context
cx [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ TypeExpr -> [Code]
idsTypeExpr TypeExpr
ty

idsContext :: Context -> [Code]
idsContext :: Context -> [Code]
idsContext = (Constraint -> [Code]) -> Context -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Constraint -> [Code]
idsConstraint

idsConstraint :: Constraint -> [Code]
idsConstraint :: Constraint -> [Code]
idsConstraint (Constraint _ qcls :: QualIdent
qcls ty :: TypeExpr
ty) =
  TypeUsage -> Bool -> QualIdent -> Code
TypeCons TypeUsage
TypeRefer Bool
False QualIdent
qcls Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: TypeExpr -> [Code]
idsTypeExpr TypeExpr
ty

idsTypeExpr :: TypeExpr -> [Code]
idsTypeExpr :: TypeExpr -> [Code]
idsTypeExpr (ConstructorType _ qid :: QualIdent
qid) = [TypeUsage -> Bool -> QualIdent -> Code
TypeCons TypeUsage
TypeRefer Bool
False QualIdent
qid]
idsTypeExpr (ApplyType   _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = (TypeExpr -> [Code]) -> [TypeExpr] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TypeExpr -> [Code]
idsTypeExpr [TypeExpr
ty1, TypeExpr
ty2]
idsTypeExpr (VariableType      _ v :: Ident
v) = [IdentUsage -> Bool -> QualIdent -> Code
Identifier IdentUsage
IdRefer Bool
False (Ident -> QualIdent
qualify Ident
v)]
idsTypeExpr (TupleType       _ tys :: [TypeExpr]
tys) = (TypeExpr -> [Code]) -> [TypeExpr] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TypeExpr -> [Code]
idsTypeExpr [TypeExpr]
tys
idsTypeExpr (ListType         _ ty :: TypeExpr
ty) = TypeExpr -> [Code]
idsTypeExpr TypeExpr
ty
idsTypeExpr (ArrowType   _ ty1 :: TypeExpr
ty1 ty2 :: TypeExpr
ty2) = (TypeExpr -> [Code]) -> [TypeExpr] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TypeExpr -> [Code]
idsTypeExpr [TypeExpr
ty1, TypeExpr
ty2]
idsTypeExpr (ParenType        _ ty :: TypeExpr
ty) = TypeExpr -> [Code]
idsTypeExpr TypeExpr
ty
idsTypeExpr (ForallType    _ vs :: [Ident]
vs ty :: TypeExpr
ty) =
  (Ident -> Code) -> [Ident] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map (IdentUsage -> Bool -> QualIdent -> Code
Identifier IdentUsage
IdDeclare Bool
False (QualIdent -> Code) -> (Ident -> QualIdent) -> Ident -> Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent
qualify) [Ident]
vs [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ String -> Code
Symbol "." Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: TypeExpr -> [Code]
idsTypeExpr TypeExpr
ty

idsFieldDecl :: FieldDecl -> [Code]
idsFieldDecl :: FieldDecl -> [Code]
idsFieldDecl (FieldDecl _ ls :: [Ident]
ls ty :: TypeExpr
ty) =
  (Ident -> Code) -> [Ident] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map (FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncDeclare Bool
False (QualIdent -> Code) -> (Ident -> QualIdent) -> Ident -> Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent
qualify (Ident -> QualIdent) -> (Ident -> Ident) -> Ident -> QualIdent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Ident
unRenameIdent) [Ident]
ls [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ TypeExpr -> [Code]
idsTypeExpr TypeExpr
ty

idsEquation :: Equation a -> [Code]
idsEquation :: Equation a -> [Code]
idsEquation (Equation _ lhs :: Lhs a
lhs rhs :: Rhs a
rhs) = Lhs a -> [Code]
forall a. Lhs a -> [Code]
idsLhs Lhs a
lhs [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ Rhs a -> [Code]
forall a. Rhs a -> [Code]
idsRhs Rhs a
rhs

idsLhs :: Lhs a -> [Code]
idsLhs :: Lhs a -> [Code]
idsLhs (FunLhs    _ f :: Ident
f ps :: [Pattern a]
ps) =
  FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncDeclare Bool
False (Ident -> QualIdent
qualify Ident
f) Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: (Pattern a -> [Code]) -> [Pattern a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat [Pattern a]
ps
idsLhs (OpLhs _ p1 :: Pattern a
p1 op :: Ident
op p2 :: Pattern a
p2) =
  Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat Pattern a
p1 [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ [FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncDeclare Bool
False (QualIdent -> Code) -> QualIdent -> Code
forall a b. (a -> b) -> a -> b
$ Ident -> QualIdent
qualify Ident
op] [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat Pattern a
p2
idsLhs (ApLhs   _ lhs :: Lhs a
lhs ps :: [Pattern a]
ps) = Lhs a -> [Code]
forall a. Lhs a -> [Code]
idsLhs Lhs a
lhs [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ (Pattern a -> [Code]) -> [Pattern a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat [Pattern a]
ps

idsRhs :: Rhs a -> [Code]
idsRhs :: Rhs a -> [Code]
idsRhs (SimpleRhs  _ _ e :: Expression a
e  ds :: [Decl a]
ds) = Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ (Decl a -> [Code]) -> [Decl a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl a -> [Code]
forall a. Decl a -> [Code]
idsDecl [Decl a]
ds
idsRhs (GuardedRhs _ _ ce :: [CondExpr a]
ce ds :: [Decl a]
ds) = (CondExpr a -> [Code]) -> [CondExpr a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CondExpr a -> [Code]
forall a. CondExpr a -> [Code]
idsCondExpr [CondExpr a]
ce [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ (Decl a -> [Code]) -> [Decl a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl a -> [Code]
forall a. Decl a -> [Code]
idsDecl [Decl a]
ds

idsCondExpr :: CondExpr a -> [Code]
idsCondExpr :: CondExpr a -> [Code]
idsCondExpr (CondExpr _ e1 :: Expression a
e1 e2 :: Expression a
e2) = Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e1 [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e2

idsPat :: Pattern a -> [Code]
idsPat :: Pattern a -> [Code]
idsPat (LiteralPattern          _ _ _) = []
idsPat (NegativePattern         _ _ _) = []
idsPat (VariablePattern         _ _ v :: Ident
v) = [IdentUsage -> Bool -> QualIdent -> Code
Identifier IdentUsage
IdDeclare Bool
False (Ident -> QualIdent
qualify Ident
v)]
idsPat (ConstructorPattern _ _ qid :: QualIdent
qid ps :: [Pattern a]
ps) =
  ConsUsage -> Bool -> QualIdent -> Code
DataCons ConsUsage
ConsPattern Bool
False QualIdent
qid Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: (Pattern a -> [Code]) -> [Pattern a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat [Pattern a]
ps
idsPat (InfixPattern    _ _ p1 :: Pattern a
p1 qid :: QualIdent
qid p2 :: Pattern a
p2) =
  Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat Pattern a
p1 [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ ConsUsage -> Bool -> QualIdent -> Code
DataCons ConsUsage
ConsPattern Bool
False QualIdent
qid Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat Pattern a
p2
idsPat (ParenPattern              _ p :: Pattern a
p) = Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat Pattern a
p
idsPat (RecordPattern      _ _ qid :: QualIdent
qid fs :: [Field (Pattern a)]
fs) =
  ConsUsage -> Bool -> QualIdent -> Code
DataCons ConsUsage
ConsPattern Bool
False QualIdent
qid Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: (Field (Pattern a) -> [Code]) -> [Field (Pattern a)] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Pattern a -> [Code]) -> Field (Pattern a) -> [Code]
forall a. (a -> [Code]) -> Field a -> [Code]
idsField Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat) [Field (Pattern a)]
fs
idsPat (TuplePattern            _ ps :: [Pattern a]
ps) = (Pattern a -> [Code]) -> [Pattern a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat [Pattern a]
ps
idsPat (ListPattern            _ _ ps :: [Pattern a]
ps) = (Pattern a -> [Code]) -> [Pattern a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat [Pattern a]
ps
idsPat (AsPattern               _ v :: Ident
v p :: Pattern a
p) =
  IdentUsage -> Bool -> QualIdent -> Code
Identifier IdentUsage
IdDeclare Bool
False (Ident -> QualIdent
qualify Ident
v) Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat Pattern a
p
idsPat (LazyPattern               _ p :: Pattern a
p) = Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat Pattern a
p
idsPat (FunctionPattern    _ _ qid :: QualIdent
qid ps :: [Pattern a]
ps) =
  FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncCall Bool
False QualIdent
qid Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: (Pattern a -> [Code]) -> [Pattern a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat [Pattern a]
ps
idsPat (InfixFuncPattern  _ _ p1 :: Pattern a
p1 f :: QualIdent
f p2 :: Pattern a
p2) =
  Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat Pattern a
p1 [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncInfix Bool
False QualIdent
f Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat Pattern a
p2

idsExpr :: Expression a -> [Code]
idsExpr :: Expression a -> [Code]
idsExpr (Literal              _ _ _) = []
idsExpr (Variable           _ _ qid :: QualIdent
qid)
  | QualIdent -> Bool
isQualified QualIdent
qid                = [FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncCall Bool
False QualIdent
qid]
  | Ident -> Bool
hasGlobalScope (QualIdent -> Ident
unqualify QualIdent
qid) = [FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncCall Bool
False QualIdent
qid]
  | Bool
otherwise                      = [IdentUsage -> Bool -> QualIdent -> Code
Identifier IdentUsage
IdRefer Bool
False QualIdent
qid]
idsExpr (Constructor        _ _ qid :: QualIdent
qid) = [ConsUsage -> Bool -> QualIdent -> Code
DataCons ConsUsage
ConsCall Bool
False QualIdent
qid]
idsExpr (Paren                  _ e :: Expression a
e) = Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e
idsExpr (Typed              _ e :: Expression a
e qty :: QualTypeExpr
qty) = Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ QualTypeExpr -> [Code]
idsQualTypeExpr QualTypeExpr
qty
idsExpr (Record          _ _ qid :: QualIdent
qid fs :: [Field (Expression a)]
fs) =
  ConsUsage -> Bool -> QualIdent -> Code
DataCons ConsUsage
ConsCall Bool
False QualIdent
qid Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: (Field (Expression a) -> [Code])
-> [Field (Expression a)] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Expression a -> [Code]) -> Field (Expression a) -> [Code]
forall a. (a -> [Code]) -> Field a -> [Code]
idsField Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr) [Field (Expression a)]
fs
idsExpr (RecordUpdate        _ e :: Expression a
e fs :: [Field (Expression a)]
fs) =
  Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ (Field (Expression a) -> [Code])
-> [Field (Expression a)] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Expression a -> [Code]) -> Field (Expression a) -> [Code]
forall a. (a -> [Code]) -> Field a -> [Code]
idsField Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr) [Field (Expression a)]
fs
idsExpr (Tuple                 _ es :: [Expression a]
es) = (Expression a -> [Code]) -> [Expression a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr [Expression a]
es
idsExpr (List                _ _ es :: [Expression a]
es) = (Expression a -> [Code]) -> [Expression a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr [Expression a]
es
idsExpr (ListCompr        _ e :: Expression a
e stmts :: [Statement a]
stmts) = Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ (Statement a -> [Code]) -> [Statement a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Statement a -> [Code]
forall a. Statement a -> [Code]
idsStmt [Statement a]
stmts
idsExpr (EnumFrom               _ e :: Expression a
e) = Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e
idsExpr (EnumFromThen       _ e1 :: Expression a
e1 e2 :: Expression a
e2) = (Expression a -> [Code]) -> [Expression a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr [Expression a
e1, Expression a
e2]
idsExpr (EnumFromTo         _ e1 :: Expression a
e1 e2 :: Expression a
e2) = (Expression a -> [Code]) -> [Expression a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr [Expression a
e1, Expression a
e2]
idsExpr (EnumFromThenTo  _ e1 :: Expression a
e1 e2 :: Expression a
e2 e3 :: Expression a
e3) = (Expression a -> [Code]) -> [Expression a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr [Expression a
e1, Expression a
e2, Expression a
e3]
idsExpr (UnaryMinus             _ e :: Expression a
e) = String -> Code
Symbol "-" Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e
idsExpr (Apply              _ e1 :: Expression a
e1 e2 :: Expression a
e2) = Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e1 [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e2
idsExpr (InfixApply      _ e1 :: Expression a
e1 op :: InfixOp a
op e2 :: Expression a
e2) = Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e1 [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ InfixOp a -> [Code]
forall a. InfixOp a -> [Code]
idsInfix InfixOp a
op [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e2
idsExpr (LeftSection         _ e :: Expression a
e op :: InfixOp a
op) = Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ InfixOp a -> [Code]
forall a. InfixOp a -> [Code]
idsInfix InfixOp a
op
idsExpr (RightSection        _ op :: InfixOp a
op e :: Expression a
e) = InfixOp a -> [Code]
forall a. InfixOp a -> [Code]
idsInfix InfixOp a
op [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e
idsExpr (Lambda              _ ps :: [Pattern a]
ps e :: Expression a
e) = (Pattern a -> [Code]) -> [Pattern a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat [Pattern a]
ps [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e
idsExpr (Let               _ _ ds :: [Decl a]
ds e :: Expression a
e) = (Decl a -> [Code]) -> [Decl a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl a -> [Code]
forall a. Decl a -> [Code]
idsDecl [Decl a]
ds [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e
idsExpr (Do             _ _ stmts :: [Statement a]
stmts e :: Expression a
e) = (Statement a -> [Code]) -> [Statement a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Statement a -> [Code]
forall a. Statement a -> [Code]
idsStmt [Statement a]
stmts [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e
idsExpr (IfThenElse      _ e1 :: Expression a
e1 e2 :: Expression a
e2 e3 :: Expression a
e3) = (Expression a -> [Code]) -> [Expression a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr [Expression a
e1, Expression a
e2, Expression a
e3]
idsExpr (Case          _ _ _ e :: Expression a
e alts :: [Alt a]
alts) = Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ (Alt a -> [Code]) -> [Alt a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Alt a -> [Code]
forall a. Alt a -> [Code]
idsAlt [Alt a]
alts

idsField :: (a -> [Code]) -> Field a -> [Code]
idsField :: (a -> [Code]) -> Field a -> [Code]
idsField f :: a -> [Code]
f (Field _ l :: QualIdent
l x :: a
x) = FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncCall Bool
False QualIdent
l Code -> [Code] -> [Code]
forall a. a -> [a] -> [a]
: a -> [Code]
f a
x

idsInfix :: InfixOp a -> [Code]
idsInfix :: InfixOp a -> [Code]
idsInfix (InfixOp     _ qid :: QualIdent
qid) = [FuncUsage -> Bool -> QualIdent -> Code
Function FuncUsage
FuncInfix Bool
False QualIdent
qid]
idsInfix (InfixConstr _ qid :: QualIdent
qid) = [ConsUsage -> Bool -> QualIdent -> Code
DataCons ConsUsage
ConsInfix Bool
False QualIdent
qid]

idsStmt :: Statement a -> [Code]
idsStmt :: Statement a -> [Code]
idsStmt (StmtExpr   _ e :: Expression a
e)  = Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e
idsStmt (StmtDecl _ _ ds :: [Decl a]
ds) = (Decl a -> [Code]) -> [Decl a] -> [Code]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl a -> [Code]
forall a. Decl a -> [Code]
idsDecl [Decl a]
ds
idsStmt (StmtBind _ p :: Pattern a
p e :: Expression a
e)  = Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat Pattern a
p [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ Expression a -> [Code]
forall a. Expression a -> [Code]
idsExpr Expression a
e

idsAlt :: Alt a -> [Code]
idsAlt :: Alt a -> [Code]
idsAlt (Alt _ p :: Pattern a
p rhs :: Rhs a
rhs) = Pattern a -> [Code]
forall a. Pattern a -> [Code]
idsPat Pattern a
p [Code] -> [Code] -> [Code]
forall a. [a] -> [a] -> [a]
++ Rhs a -> [Code]
forall a. Rhs a -> [Code]
idsRhs Rhs a
rhs

-- -----------------------------------------------------------------------------
-- Conversion from a token to a string
-- -----------------------------------------------------------------------------

showToken :: Token -> String
showToken :: Token -> String
showToken (Token Id                 a :: Attributes
a) = Attributes -> String
showAttr Attributes
a
showToken (Token QId                a :: Attributes
a) = Attributes -> String
showAttr Attributes
a
showToken (Token Sym                a :: Attributes
a) = Attributes -> String
showAttr Attributes
a
showToken (Token QSym               a :: Attributes
a) = Attributes -> String
showAttr Attributes
a
showToken (Token IntTok             a :: Attributes
a) = Attributes -> String
showAttr Attributes
a
showToken (Token FloatTok           a :: Attributes
a) = Attributes -> String
showAttr Attributes
a
showToken (Token CharTok            a :: Attributes
a) = Attributes -> String
showAttr Attributes
a
showToken (Token StringTok          a :: Attributes
a) = Attributes -> String
showAttr Attributes
a
showToken (Token LeftParen          _) = "("
showToken (Token RightParen         _) = ")"
showToken (Token Semicolon          _) = ";"
showToken (Token LeftBrace          _) = "{"
showToken (Token RightBrace         _) = "}"
showToken (Token LeftBracket        _) = "["
showToken (Token RightBracket       _) = "]"
showToken (Token Comma              _) = ","
showToken (Token Underscore         _) = "_"
showToken (Token Backquote          _) = "`"
showToken (Token VSemicolon         _) = ""
showToken (Token VRightBrace        _) = ""
showToken (Token At                 _) = "@"
showToken (Token Colon              _) = ":"
showToken (Token DotDot             _) = ".."
showToken (Token DoubleArrow        _) = "=>"
showToken (Token DoubleColon        _) = "::"
showToken (Token Equals             _) = "="
showToken (Token Backslash          _) = "\\"
showToken (Token Bar                _) = "|"
showToken (Token LeftArrow          _) = "<-"
showToken (Token RightArrow         _) = "->"
showToken (Token Tilde              _) = "~"
showToken (Token SymDot             _) = "."
showToken (Token SymMinus           _) = "-"
showToken (Token SymStar            _) = "*"
showToken (Token KW_case            _) = "case"
showToken (Token KW_class           _) = "class"
showToken (Token KW_data            _) = "data"
showToken (Token KW_default         _) = "default"
showToken (Token KW_deriving        _) = "deriving"
showToken (Token KW_do              _) = "do"
showToken (Token KW_else            _) = "else"
showToken (Token KW_external        _) = "external"
showToken (Token KW_fcase           _) = "fcase"
showToken (Token KW_free            _) = "free"
showToken (Token KW_if              _) = "if"
showToken (Token KW_import          _) = "import"
showToken (Token KW_in              _) = "in"
showToken (Token KW_infix           _) = "infix"
showToken (Token KW_infixl          _) = "infixl"
showToken (Token KW_infixr          _) = "infixr"
showToken (Token KW_instance        _) = "instance"
showToken (Token KW_let             _) = "let"
showToken (Token KW_module          _) = "module"
showToken (Token KW_newtype         _) = "newtype"
showToken (Token KW_of              _) = "of"
showToken (Token KW_then            _) = "then"
showToken (Token KW_type            _) = "type"
showToken (Token KW_where           _) = "where"
showToken (Token Id_as              _) = "as"
showToken (Token Id_ccall           _) = "ccall"
showToken (Token Id_forall          _) = "forall"
showToken (Token Id_hiding          _) = "hiding"
showToken (Token Id_interface       _) = "interface"
showToken (Token Id_primitive       _) = "primitive"
showToken (Token Id_qualified       _) = "qualified"
showToken (Token EOF                _) = ""
showToken (Token PragmaHiding       _) = "{-# HIDING"
showToken (Token PragmaLanguage     _) = "{-# LANGUAGE"
showToken (Token PragmaOptions      a :: Attributes
a) = "{-# OPTIONS" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Attributes -> String
showAttr Attributes
a
showToken (Token PragmaMethod       _) = "{-# METHOD"
showToken (Token PragmaModule       _) = "{-# MODULE"
showToken (Token PragmaEnd          _) = "#-}"
showToken (Token LineComment   (StringAttributes s :: String
s _)) = String
s
showToken (Token LineComment   a :: Attributes
a                     ) = Attributes -> String
showAttr Attributes
a
showToken (Token NestedComment (StringAttributes s :: String
s _)) = String
s
showToken (Token NestedComment                      a :: Attributes
a) = Attributes -> String
showAttr Attributes
a

showAttr :: Attributes -> [Char]
showAttr :: Attributes -> String
showAttr NoAttributes             = ""
showAttr (CharAttributes     c :: Char
c _) = Char -> String
forall a. Show a => a -> String
show Char
c
showAttr (IntAttributes      i :: Integer
i _) = Integer -> String
forall a. Show a => a -> String
show Integer
i
showAttr (FloatAttributes    f :: Double
f _) = Double -> String
forall a. Show a => a -> String
show Double
f
showAttr (StringAttributes   s :: String
s _) = ShowS
forall a. Show a => a -> String
show String
s
showAttr (IdentAttributes    m :: [String]
m i :: String
i)
  | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
m    = Ident -> String
idName   (Ident -> String) -> Ident -> String
forall a b. (a -> b) -> a -> b
$                          (String -> Ident
mkIdent String
i)
  | Bool
otherwise = QualIdent -> String
qualName (QualIdent -> String) -> QualIdent -> String
forall a b. (a -> b) -> a -> b
$ ModuleIdent -> Ident -> QualIdent
qualifyWith ([String] -> ModuleIdent
mkMIdent [String]
m) (String -> Ident
mkIdent String
i)
showAttr (OptionsAttributes mt :: Maybe String
mt s :: String
s) = Maybe String -> String
showTool Maybe String
mt String -> ShowS
forall a. [a] -> [a] -> [a]
++ ' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
s

showTool :: Maybe String -> String
showTool :: Maybe String -> String
showTool Nothing  = ""
showTool (Just t :: String
t) = '_' Char -> ShowS
forall a. a -> [a] -> [a]
: String
t