{-# OPTIONS_GHC -Wno-missing-signatures #-}
module Haskell.Parser.Def where

import Control.Monad.Identity
import Data.Char
import Text.Parsec
-- import qualified Text.Parsec.Language as L
import qualified Text.Parsec.Token as T
import qualified Text.Parsec.IndentParsec.Token as IT
import qualified Text.Parsec.IndentParsec.Prim as IP


-- LanguageDef things shamelessly stolen from Text.Parsec.Language.
-- Reason for stealing is that these have more generic types.
haskellStyle = T.LanguageDef
                { T.commentStart   = "{-"
                , T.commentEnd     = "-}"
                , T.commentLine    = "--"
                , T.nestedComments = True
                , T.identStart     = letter
                , T.identLetter    = alphaNum <|> oneOf "_'"
                , T.opStart        = T.opLetter haskellStyle
                , T.opLetter       = oneOf ":!#$%&*+./<=>?@\\^|-~"
                , T.reservedOpNames= []
                , T.reservedNames  = []
                , T.caseSensitive  = True
                }

haskell :: T.GenTokenParser String () (IP.IndentT IP.HaskellLike Identity)
haskell      = T.makeTokenParser haskellDef

haskellDef   = haskell98Def
                { T.identLetter    = T.identLetter haskell98Def <|> char '#'
                , T.reservedNames  = T.reservedNames haskell98Def ++
                                   ["foreign","import","export","primitive"
                                   ,"_ccall_","_casm_"
                                   ,"forall"
                                   ]
                }

haskell98Def = haskellStyle
                { T.reservedOpNames= ["::","..","=","\\","|","<-","->","@","~","=>"]
                , T.reservedNames  = ["let","in","case","of","if","then","else",
                                    "data","type",
                                    "class","default","deriving","do","import",
                                    "infix","infixl","infixr","instance","module",
                                    "newtype","where",
                                    "primitive"
                                    -- "as","qualified","hiding"
                                   ]
                }

-- Bring the right combinators in scope.
mySemiSep = IT.semiSepOrFoldedLines haskell
myBraces = IT.bracesBlock haskell
identifier = IT.identifier haskell
operator = IT.operator haskell
reserved = IT.reserved haskell
reservedOp = IT.reservedOp haskell
charLiteral = IT.charLiteral haskell
stringLiteral = IT.stringLiteral haskell
natural = IT.natural haskell
integer = IT.integer haskell
float = IT.float haskell
naturalOrFloat = IT.naturalOrFloat haskell
decimal = IT.decimal haskell
hexadecimal = IT.hexadecimal haskell
octal = IT.octal haskell
symbol = IT.symbol haskell
lexeme = IT.lexeme haskell
whiteSpace = IT.whiteSpace haskell
semi = IT.semi haskell
comma = IT.comma haskell
colon = IT.colon haskell
dot = IT.dot haskell
parens = IT.parens haskell
parensBlock = IT.parensBlock haskell
braces = IT.braces haskell
bracesBlock = IT.bracesBlock haskell
angles = IT.angles haskell
anglesBlock = IT.anglesBlock haskell
brackets = IT.brackets haskell
bracketsBlock = IT.bracketsBlock haskell
semiSep = IT.semiSep haskell
semiSepOrFoldedLines = IT.semiSepOrFoldedLines haskell
semiSep1 = IT.semiSep1 haskell
semiSepOrFoldedLines1 = IT.semiSepOrFoldedLines1 haskell
commaSep = IT.commaSep haskell
commaSepOrFoldedLines = IT.commaSepOrFoldedLines haskell
commaSep1 = IT.commaSep1 haskell
commaSepOrFoldedLines1 = IT.commaSepOrFoldedLines1 haskell

-- Some more specific combinators.
identifierGuard pr = try $ do
    s <- identifier
    guard (not (null s) && pr s)
    return s

typeident = identifierGuard (isUpper . head)
varident = identifierGuard (isLower . head)