<commit_before>{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Exception (assert)
import Control.Monad
import Data.Aeson (ToJSON(..), FromJSON(..), eitherDecode)
import qualified Data.Aeson as Aeson
import qualified Data.Algorithm.Diff as Diff
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy.Char8 as LBSC
import Data.Csv
import Data.Either
import Data.Function
import Data.List
import qualified Data.Map.Strict as Map
import Data.Maybe
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashSet as HashSet
import Data.HashSet (HashSet)
import qualified Data.Set as Set
import qualified Data.Vector as Vector
import GHC.Generics
import System.Directory
import System.Environment
import System.FilePath
import System.IO
import Text.Printf

import NanoML.Classify
import NanoML.Lexer
import NanoML.Monad
import NanoML.Parser
import NanoML.Pretty
import NanoML.Types hiding (Kind)


import Debug.Trace

main :: IO ()
main = do
  [src, cls] <- getArgs
  jsons <- lines <$> (readFile $ "data" </> src </> "raw.json")
  case cls of
    "ops"
      -> mkBadFeatures src cls preds_thas jsons
    "ops+context"
      -> mkBadFeatures src cls preds_thas_ctx jsons
    "op+context"
      -> mkBadFeatures src cls preds_tis_ctx jsons
    "op+context-count"
      -> mkBadFeatures src cls (preds_tis ++ map only_ctx preds_tcount_ctx) jsons
    "op+context-count+size"
      -> mkBadFeatures src cls (preds_tsize ++ preds_tis ++ map only_ctx preds_tcount_ctx) jsons
    "op+context-count+type+size"
      -> mkBadFeatures src cls (preds_tsize ++ preds_tis ++ map only_ctx preds_tcount_ctx ++ preds_tcon_ctx) jsons
    "type-inference"
      -> mkFixFeatures cls (preds_tis_novar ++ preds_tcon_novar_children) jsons
    "type-inference+vars"
      -> mkFixFeatures cls (preds_tis ++ preds_tcon_children) jsons


mkBadFeatures :: String -> String -> [Feature] -> [String] -> IO ()
mkBadFeatures yr nm fs jsons = do
  let uniqs = concatMap mkDiffs jsons
  let feats = [ ((h, f'), (ss, bad, fix, c))
              | (ss, p, bad, fix) <- uniqs
              , let (h, f, c) = runTFeaturesDiff fs (ss,p)
              , let f' = filter (\r -> r HashMap.! "F-InSlice" == "1.0") f
                -- a one-constraint core is bogus, this should be impossible
              , length f' > 1
              -- , any (\r -> r HashMap.! "L-DidChange" == "1.0") f'
              ]
  -- let feats = map (runTFeaturesDiff fs) uniqs
  forM_ (zip [0..] feats) $ \ (i, ((header, features), (ss, bad, fix, cs))) -> do
    when (length cs == 1) $ do
      putStrLn "SINGLE CONSTRAINT CORE"
      putStrLn bad
      print (head cs)
    if (null (intersect ss cs)) then do
      putStrLn "NO OVERLAP CORE/DIFF"
      putStrLn bad
      print cs
      putStrLn fix
    else do
      let fn = printf "%04d" (i :: Int)
      let path = "data" </> yr </> nm </> fn <.> "csv"
      createDirectoryIfMissing True (takeDirectory path)
      LBSC.writeFile path $ encodeByName header features
      let path = "data" </> yr </> nm </> fn <.> "ml"
      writeFile path $ unlines $ [ bad, "", "(* fix", fix, "*)", ""
                                 , "(* changed spans" ] ++ map show ss ++ [ "*)" ]
                              ++ [ "", "(* type error slice" ] ++ map show cs ++ [ "*)" ]

    -- let (header, features) = unzip $ map (runTFeaturesDiff fs) uniqs
    -- let path = "data/" ++ nm ++ ".csv"
    -- LBSC.writeFile path $ encodeByName (head header) (concat features)

mkFixFeatures :: String -> [Feature] -> [String] -> IO ()
mkFixFeatures nm fs jsons = do
  let fixes = concatMap mkFixes jsons
  let (header, features) = unzip $ map (runTFeaturesTypes fs) fixes
  let path = "data/" ++ nm ++ ".csv"<commit_msg>note all spans for ease of comparing other tools<commit_after>{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Exception (assert)
import Control.Monad
import Data.Aeson (ToJSON(..), FromJSON(..), eitherDecode)
import qualified Data.Aeson as Aeson
import qualified Data.Algorithm.Diff as Diff
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy.Char8 as LBSC
import Data.Csv
import Data.Either
import Data.Function
import Data.List
import qualified Data.Map.Strict as Map
import Data.Maybe
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashSet as HashSet
import Data.HashSet (HashSet)
import qualified Data.Set as Set
import qualified Data.Vector as Vector
import GHC.Generics
import System.Directory
import System.Environment
import System.FilePath
import System.IO
import Text.Printf

import NanoML.Classify
import NanoML.Lexer
import NanoML.Monad
import NanoML.Parser
import NanoML.Pretty
import NanoML.Types hiding (Kind)


import Debug.Trace

main :: IO ()
main = do
  [src, cls] <- getArgs
  jsons <- lines <$> (readFile $ "data" </> src </> "raw.json")
  case cls of
    "ops"
      -> mkBadFeatures src cls preds_thas jsons
    "ops+context"
      -> mkBadFeatures src cls preds_thas_ctx jsons
    "op+context"
      -> mkBadFeatures src cls preds_tis_ctx jsons
    "op+context-count"
      -> mkBadFeatures src cls (preds_tis ++ map only_ctx preds_tcount_ctx) jsons
    "op+context-count+size"
      -> mkBadFeatures src cls (preds_tsize ++ preds_tis ++ map only_ctx preds_tcount_ctx) jsons
    "op+context-count+type+size"
      -> mkBadFeatures src cls (preds_tsize ++ preds_tis ++ map only_ctx preds_tcount_ctx ++ preds_tcon_ctx) jsons
    "type-inference"
      -> mkFixFeatures cls (preds_tis_novar ++ preds_tcon_novar_children) jsons
    "type-inference+vars"
      -> mkFixFeatures cls (preds_tis ++ preds_tcon_children) jsons


mkBadFeatures :: String -> String -> [Feature] -> [String] -> IO ()
mkBadFeatures yr nm fs jsons = do
  let uniqs = concatMap mkDiffs jsons
  let feats = [ ((h, f'), (ss, bad, fix, c, all))
              | (ss, p, bad, fix) <- uniqs
              , let (h, f, c) = runTFeaturesDiff fs (ss,p)
              , let f' = filter (\r -> r HashMap.! "F-InSlice" == "1.0") f
                -- a one-constraint core is bogus, this should be impossible
              , length f' > 1
              , let all = map (fromJust.getSrcSpanExprMaybe)
                           (concatMap allSubExprs $ progExprs p)
              -- , any (\r -> r HashMap.! "L-DidChange" == "1.0") f'
              ]
  -- let feats = map (runTFeaturesDiff fs) uniqs
  forM_ (zip [0..] feats) $ \ (i, ((header, features), (ss, bad, fix, cs, allspans))) -> do
    when (length cs == 1) $ do
      putStrLn "SINGLE CONSTRAINT CORE"
      putStrLn bad
      print (head cs)
    if (null (intersect ss cs)) then do
      putStrLn "NO OVERLAP CORE/DIFF"
      putStrLn bad
      print cs
      putStrLn fix
    else do
      let fn = printf "%04d" (i :: Int)
      let path = "data" </> yr </> nm </> fn <.> "csv"
      createDirectoryIfMissing True (takeDirectory path)
      LBSC.writeFile path $ encodeByName header features
      let path = "data" </> yr </> nm </> fn <.> "ml"
      writeFile path $ unlines $ [ bad, "", "(* fix", fix, "*)", ""
                                 , "(* changed spans" ] ++ map show ss ++ [ "*)" ]
                              ++ [ "", "(* type error slice" ] ++ map show cs ++ [ "*)" ]
                              ++ [ "", "(* all spans" ] ++ map show allspans ++ [ "*)" ]

    -- let (header, features) = unzip $ map (runTFeaturesDiff fs) uniqs
    -- let path = "data/" ++ nm ++ ".csv"
    -- LBSC.writeFile path $ encodeByName (head header) (concat features)

mkFixFeatures :: String -> [Feature] -> [String] -> IO ()
mkFixFeatures nm fs jsons = do
  let fixes = concatMap mkFixes jsons
  let (header, features) = unzip $ map (runTFeaturesTypes fs) fixes
  let path = "data/" ++ nm ++ ".csv"
{'fraction_non_alphanumeric': 0.1263785017112435, 'fraction_numerical': 0.002788693116998352, 'mean_word_length': 2.7340274491244676, 'pattern_counts': {'":': 0, '<': 31, '<?xml version=': 0, '>': 63, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 5, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5685420', 'n_tokens_mistral': 2651, 'n_tokens_neox': 2587, 'n_words': 806}