<commit_before>{-# LANGUAGE FlexibleInstances, IncoherentInstances #-}

module Idris.IdeSlave(receiveMessage, sendMessage, IdeSlaveCommand(..), sexpToCommand, SExp(..)) where

import Text.Printf
import Numeric
import Data.List
-- import qualified Data.Text as T
import Text.Parsec

data SExp = List [SExp]
          | StringAtom String
          | BoolAtom Bool
          | IntegerAtom Integer
          | SymbolAtom String
          deriving ( Eq, Show )

sExpToString :: SExp -> String
sExpToString (StringAtom s)   = "\"" ++ escape s ++ "\""
sExpToString (BoolAtom True)  = ":True"
sExpToString (BoolAtom False) = ":False"
sExpToString (IntegerAtom i)  = printf "%d" i
sExpToString (SymbolAtom s)   = ":" ++ s
sExpToString (List l)         = "(" ++ intercalate " " (map sExpToString l) ++ ")"

class SExpable a where
  toSExp :: a -> SExp

instance SExpable Bool where
  toSExp True  = BoolAtom True
  toSExp False = BoolAtom False

instance SExpable String where
  toSExp s = StringAtom s

instance SExpable Integer where
  toSExp n = IntegerAtom n

instance SExpable Int where
  toSExp n = IntegerAtom (toInteger n)

instance (SExpable a) => SExpable (Maybe a) where
  toSExp Nothing  = List [SymbolAtom "Nothing"]
  toSExp (Just a) = List [SymbolAtom "Just", toSExp a]

instance (SExpable a) => SExpable [a] where
  toSExp l = List (map toSExp l)

escape :: String -> String
escape = concatMap escapeChar
  where
    escapeChar '\\' = "\\\\"
    escapeChar '"'  = "\\\""
    escapeChar c    = [c]

pSExp = do xs <- between (char '(') (char ')') (pSExp `sepBy` (char ' '))
           return (List xs)
    <|> atom

atom = do char ':'; x <- atomC; return x
   <|> do char '"'; xs <- many quotedChar; char '"'; return (StringAtom xs)
   <|> do ints <- many1 digit
          case readDec ints of
            ((num, ""):_) -> return (IntegerAtom (toInteger num))
            _ -> return (StringAtom ints)

atomC = do string "True"; return (BoolAtom True)
    <|> do string "False"; return (BoolAtom False)
    <|> do xs <- many (noneOf " \n\t\r\"()"); return (SymbolAtom xs)

quotedChar = noneOf "\""
         <|> try (string "\\\"" >> return '"')

parseSExp :: String -> Either ParseError SExp
parseSExp input = parse pSExp "(unknown)" input

data IdeSlaveCommand = Version
                     | Interpret String
  deriving Show

sexpToCommand :: SExp -> Maybe IdeSlaveCommand
sexpToCommand (List (x:[]))                                    = sexpToCommand x
sexpToCommand (List [SymbolAtom "interpret", StringAtom cmd]) = Just (Interpret cmd)
sexpToCommand (SymbolAtom "version")                           = Just Version
sexpToCommand _                                                = Nothing

receiveMessage :: IO (SExp)
receiveMessage
  = do x <- getLine
       return (receiveString x)

receiveString :: String -> SExp
receiveString x =
  case readHex (take 6 x) of
    ((num, ""):_) ->
      let msg = drop 6 x in
        if (length msg) /= (num - 1)
           then error "bad input length"
           else (case parseSExp msg of
                      Left _ -> error "parse failure"
                      Right r -> r)
    _ -> error "readHex failed"

sendMessage :: SExpable a => Integer -> Either a a -> IO ()
sendMessage id s =
  -- return value id
  case s of
       Left err -> putStrLn $ conv (List [SymbolAtom "abort", toSExp err])
       Right succ -> putStrLn $ conv (List [SymbolAtom "ok", toSExp succ])
  where conv sexp =
          let str = sExpToString (List [SymbolAtom "return", sexp, IntegerAtom id]) in (getHexLength str) ++ str
<commit_msg>output should be (output result)<commit_after>{-# LANGUAGE FlexibleInstances, IncoherentInstances #-}

module Idris.IdeSlave(receiveMessage, sendMessage, IdeSlaveCommand(..), sexpToCommand, SExp(..)) where

import Text.Printf
import Numeric
import Data.List
-- import qualified Data.Text as T
import Text.Parsec

data SExp = List [SExp]
          | StringAtom String
          | BoolAtom Bool
          | IntegerAtom Integer
          | SymbolAtom String
          deriving ( Eq, Show )

sExpToString :: SExp -> String
sExpToString (StringAtom s)   = "\"" ++ escape s ++ "\""
sExpToString (BoolAtom True)  = ":True"
sExpToString (BoolAtom False) = ":False"
sExpToString (IntegerAtom i)  = printf "%d" i
sExpToString (SymbolAtom s)   = ":" ++ s
sExpToString (List l)         = "(" ++ intercalate " " (map sExpToString l) ++ ")"

class SExpable a where
  toSExp :: a -> SExp

instance SExpable Bool where
  toSExp True  = BoolAtom True
  toSExp False = BoolAtom False

instance SExpable String where
  toSExp s = StringAtom s

instance SExpable Integer where
  toSExp n = IntegerAtom n

instance SExpable Int where
  toSExp n = IntegerAtom (toInteger n)

instance (SExpable a) => SExpable (Maybe a) where
  toSExp Nothing  = List [SymbolAtom "Nothing"]
  toSExp (Just a) = List [SymbolAtom "Just", toSExp a]

instance (SExpable a) => SExpable [a] where
  toSExp l = List (map toSExp l)

escape :: String -> String
escape = concatMap escapeChar
  where
    escapeChar '\\' = "\\\\"
    escapeChar '"'  = "\\\""
    escapeChar c    = [c]

pSExp = do xs <- between (char '(') (char ')') (pSExp `sepBy` (char ' '))
           return (List xs)
    <|> atom

atom = do char ':'; x <- atomC; return x
   <|> do char '"'; xs <- many quotedChar; char '"'; return (StringAtom xs)
   <|> do ints <- many1 digit
          case readDec ints of
            ((num, ""):_) -> return (IntegerAtom (toInteger num))
            _ -> return (StringAtom ints)

atomC = do string "True"; return (BoolAtom True)
    <|> do string "False"; return (BoolAtom False)
    <|> do xs <- many (noneOf " \n\t\r\"()"); return (SymbolAtom xs)

quotedChar = noneOf "\""
         <|> try (string "\\\"" >> return '"')

parseSExp :: String -> Either ParseError SExp
parseSExp input = parse pSExp "(unknown)" input

data IdeSlaveCommand = Version
                     | Interpret String
  deriving Show

sexpToCommand :: SExp -> Maybe IdeSlaveCommand
sexpToCommand (List (x:[]))                                    = sexpToCommand x
sexpToCommand (List [SymbolAtom "interpret", StringAtom cmd]) = Just (Interpret cmd)
sexpToCommand (SymbolAtom "version")                           = Just Version
sexpToCommand _                                                = Nothing

receiveMessage :: IO (SExp)
receiveMessage
  = do x <- getLine
       return (receiveString x)

receiveString :: String -> SExp
receiveString x =
  case readHex (take 6 x) of
    ((num, ""):_) ->
      let msg = drop 6 x in
        if (length msg) /= (num - 1)
           then error "bad input length"
           else (case parseSExp msg of
                      Left _ -> error "parse failure"
                      Right r -> r)
    _ -> error "readHex failed"

sendMessage :: SExpable a => Integer -> Either a a -> IO ()
sendMessage id s =
  -- TODO: get real output here!!!
  case s of
       Left err -> putStrLn $ conv (List [SymbolAtom "abort", toSExp err])
       Right succ -> putStrLn $ conv (List [SymbolAtom "ok", List [toSExp succ, StringAtom "no output"]])
  where conv sexp =
          let str = sExpToString (List [SymbolAtom "return", sexp, IntegerAtom id]) in (getHexLength str) ++ str

{'fraction_non_alphanumeric': 0.1214940294362677, 'fraction_numerical': 0.0011108025548458762, 'mean_word_length': 2.525697503671072, 'pattern_counts': {'":': 6, '<': 27, '<?xml version=': 0, '>': 57, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7422522', 'n_tokens_mistral': 2343, 'n_tokens_neox': 2257, 'n_words': 766}