<commit_before>{-# LANGUAGE RecordWildCards, NoMonomorphismRestriction #-}

module Type where

import HSE.All
import Data.Char
import Language.Haskell.HsColour.TTY
import Language.Haskell.HsColour.Colourise
import Util


---------------------------------------------------------------------
-- GENERAL DATA TYPES

data Rank = Ignore | Warning | Error
            deriving (Eq,Ord,Show)

-- (modulename,functionname)
-- either being blank implies universal matching
type FuncName = (String,String)


---------------------------------------------------------------------
-- IDEAS/SETTINGS

-- Classify and MatchExp are read from the Settings file
-- Idea are generated by the program
data Setting
    = Classify {rankS :: Rank, hintS :: String, funcS :: FuncName}
    | MatchExp {rankS :: Rank, hintS :: String, lhs :: Exp_, rhs :: Exp_, side :: Maybe Exp_}
    | Builtin String -- use a builtin hint set
    | Infix Fixity
      deriving Show

data Idea
    = Idea {func :: FuncName, rank :: Rank, hint :: String, loc :: SrcLoc, from :: String, to :: String}
    | ParseError {rank :: Rank, hint :: String, loc :: SrcLoc, msg :: String, from :: String}
      deriving Eq


isClassify Classify{} = True; isClassify _ = False
isMatchExp MatchExp{} = True; isMatchExp _ = False
isParseError ParseError{} = True; isParseError _ = False


instance Show Idea where
    show = showEx id


showANSI :: IO (Idea -> String)
showANSI = do
    prefs <- readColourPrefs
    return $ showEx (hscolour prefs)

showEx :: (String -> String) -> Idea -> String
showEx tt Idea{..} = unlines $
    [showSrcLoc loc ++ " " ++ show rank ++ ": " ++ hint] ++ f "Found" from ++ f "Why not" to
    where f msg x = (msg ++ ":") : map ("  "++) (lines $ tt x)

showEx tt ParseError{..} = unlines $
    [showSrcLoc loc ++ " Parse error","Error message:","  " ++ msg,"Code:"] ++ map ("  "++) (lines $ tt from)


rawIdea = Idea ("","")
idea rank hint from to = rawIdea rank hint (toSrcLoc $ ann from) (f from) (f to)
    where f = ltrim . prettyPrint
warn = idea Warning
err = idea Error


-- Any 1-letter variable names are assumed to be unification variables
isUnifyVar :: String -> Bool
isUnifyVar [x] = x == '?' || isAlpha x
isUnifyVar _ = False<commit_msg>Refactor Type, can now split Setting/Idea completely<commit_after>{-# LANGUAGE RecordWildCards, NoMonomorphismRestriction #-}

module Type where

import HSE.All
import Data.Char
import Language.Haskell.HsColour.TTY
import Language.Haskell.HsColour.Colourise
import Util


---------------------------------------------------------------------
-- GENERAL DATA TYPES

data Rank = Ignore | Warning | Error
            deriving (Eq,Ord,Show)

-- (modulename,functionname)
-- either being blank implies universal matching
type FuncName = (String,String)


-- Any 1-letter variable names are assumed to be unification variables
isUnifyVar :: String -> Bool
isUnifyVar [x] = x == '?' || isAlpha x
isUnifyVar _ = False


---------------------------------------------------------------------
-- SETTINGS - things read from settings files/command line

data Setting
    = Classify {rankS :: Rank, hintS :: String, funcS :: FuncName}
    | MatchExp {rankS :: Rank, hintS :: String, lhs :: Exp_, rhs :: Exp_, side :: Maybe Exp_}
    | Builtin String -- use a builtin hint set
    | Infix Fixity
      deriving Show

isClassify Classify{} = True; isClassify _ = False
isMatchExp MatchExp{} = True; isMatchExp _ = False


---------------------------------------------------------------------
-- IDEAS - generated hints

data Idea
    = Idea {func :: FuncName, rank :: Rank, hint :: String, loc :: SrcLoc, from :: String, to :: String}
    | ParseError {rank :: Rank, hint :: String, loc :: SrcLoc, msg :: String, from :: String}
      deriving Eq


isParseError ParseError{} = True; isParseError _ = False


instance Show Idea where
    show = showEx id


showANSI :: IO (Idea -> String)
showANSI = do
    prefs <- readColourPrefs
    return $ showEx (hscolour prefs)

showEx :: (String -> String) -> Idea -> String
showEx tt Idea{..} = unlines $
    [showSrcLoc loc ++ " " ++ show rank ++ ": " ++ hint] ++ f "Found" from ++ f "Why not" to
    where f msg x = (msg ++ ":") : map ("  "++) (lines $ tt x)

showEx tt ParseError{..} = unlines $
    [showSrcLoc loc ++ " Parse error","Error message:","  " ++ msg,"Code:"] ++ map ("  "++) (lines $ tt from)


rawIdea = Idea ("","")
idea rank hint from to = rawIdea rank hint (toSrcLoc $ ann from) (f from) (f to)
    where f = ltrim . prettyPrint
warn = idea Warning
err = idea Error
{'fraction_non_alphanumeric': 0.19678272366681357, 'fraction_numerical': 0.00044072278536800354, 'mean_word_length': 2.454337899543379, 'pattern_counts': {'":': 4, '<': 5, '<?xml version=': 0, '>': 13, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6145094', 'n_tokens_mistral': 1405, 'n_tokens_neox': 1354, 'n_words': 475}