<commit_before>module Main where

import Control.Applicative
import Data.Function
import Data.Maybe
import Data.Tree
import Network.FastCGI
import System.Process
import Text.JSON
import Text.JSON.Helpers
import Text.Printf

main = do
  runFastCGIConcurrent 20 . handleErrors $ do
    method <- fromMaybe "commands" <$> getInput "method"
    setHeader "Content-Type" "text/plain"
    case lookup method commands of
      Just runCmd -> runCmd
      Nothing     -> failure "Unknown page."

failure = outObj "failure"
success = outObj "success"
outObj x v = output . encode $ makeObj [(x,showJSON v)]

commands = [listCommands,jbofiheGrammar]
cmd = (,)

listCommands = cmd "commands" $ do
  success $ map fst commands

jbofiheGrammar = cmd "jbofihe-grammar" $ do
  q <- json "q"
  t <- fromMaybe Grammar <$> maybeJson "type"
  os <- fromMaybe [] <$> maybeJson "options"
  out <- jbofihe t os q
  case out of
   Left e -> failure e
   Right val -> success val

data JbofiheType = Grammar
                 | ParseTree
                 | ParseTreeFull
                 | ParseTreeJson
                 | ParseTreeFullJson
                 | Translate
                 | TranslateHtml
                 | TranslateLatex
  deriving (Show,Enum,Eq)

instance JSON JbofiheType where
  readJSON = readJSONEnum "Jbofihe Type"; showJSON = showJSONEnum

data JbofiheOpt = ElidableTerminators
                | RequireTerminatorsAndSeparators
                | OmittableTerminators
                | OmittableTerminatorsVerbose
                | AllowCulturalRafsi
  deriving (Show,Enum,Eq)

instance JSON JbofiheOpt where
  readJSON = readJSONEnum "Jbofihe Opt"; showJSON = showJSONEnum

jbofihe t os q = do
  out <- io $ catch (Right <$> readProcess "jbofihe" (typ t ++ map opt os) q)
                    (\e -> return $ Left $ "Bad parse.")
  case out of
    Left e -> return $ Left e
    Right reply -> return $ Right $ 
      if any (==t) [ParseTreeJson,ParseTreeFullJson]
         then treeToJson $ jbofiheToTree reply
         else showJSON reply
  where typ ParseTree         = ["-t"]
        typ ParseTreeFull     = ["-tf"]
        typ Translate         = ["-x"]
        typ TranslateHtml     = ["-H"]
        typ TranslateLatex    = ["-l"]
        typ ParseTreeJson     = ["-t"]
        typ ParseTreeFullJson = ["-tf"]
        typ Grammar           = []

        opt ElidableTerminators             = "-ie"
        opt RequireTerminatorsAndSeparators = "-re"
        opt OmittableTerminators            = "-se"
        opt OmittableTerminatorsVerbose     = "-sev"
        opt AllowCulturalRafsi              = "-cr"


cleanName = takeWhile (/=' ')
nodeRest  = avoid ' ' . avoid ':' . avoid ' ' . dropWhile (/= ' ')
avoid = dropWhile . (==)
    
treeToJson [Node n []] = makeObj [(cleanName n,showJSON $ nodeRest n)] where
treeToJson nodes = makeObj $ zip names objs where
  names = map (\(Node n _) -> cleanName n) nodes
  objs = map jsonize nodes
   where jsonize (Node n []) = showJSON $ nodeRest n
         jsonize (Node n xs) = treeToJson xs

jbofiheToTree = tree (on (==) (length . takeWhile (/='+'))) clean
              . filter (/="CHUNKS")
              . reverse
              . lines<commit_msg>Very rudimentary camxes support server-side.<commit_after>module Main where

import Control.Applicative
import Data.Function
import Data.Maybe
import Data.Tree
import Network.FastCGI
import System.Process
import Text.JSON
import Text.JSON.Helpers
import Text.Printf
import System.IO

type Camxes = (Handle,Handle,Handle,ProcessHandle)
data State = State { stateCamxes :: Camxes }

main = do
  camxes <- getCamxes ["-f"]
  runFastCGIConcurrent 20 . handleErrors $ do
    method <- fromMaybe "commands" <$> getInput "method"
    setHeader "Content-Type" "text/plain"
    case lookup method commands of
      Just runCmd -> runCmd $ State camxes
      Nothing     -> failure "Unknown page."

getCamxes opts = do
  camxes@(inp,out,err,_) <- runInteractiveCommand $ "camxes " ++ unwords opts
  mapM_ (`hSetBinaryMode` False) [inp,out,err]
  mapM_ (const $ hGetLine out) opts
  return camxes

failure = outObj "failure"
success = outObj "success"
outObj x v = output . encode $ makeObj [(x,showJSON v)]

commands = [listCommands,camxesGrammar,jbofiheGrammar]
cmd = (,)

listCommands = cmd "commands" $ \state -> do
  success $ map fst commands

camxesGrammar = cmd "camxes-grammar" $ \state -> do
  q <- json "q"
  reply <- camxesQuery state q
  success reply
  
camxesQuery state q = do
  let (inp,out,_err,_pid) = stateCamxes state
  io $ do hPutStrLn inp q
          hFlush inp
          hGetLine out

jbofiheGrammar = cmd "jbofihe-grammar" $ \state -> do
  q <- json "q"
  t <- fromMaybe Grammar <$> maybeJson "type"
  os <- fromMaybe [] <$> maybeJson "options"
  out <- jbofihe t os q
  case out of
   Left e -> failure e
   Right val -> success val

data JbofiheType = Grammar
                 | ParseTree
                 | ParseTreeFull
                 | ParseTreeJson
                 | ParseTreeFullJson
                 | Translate
                 | TranslateHtml
                 | TranslateLatex
  deriving (Show,Enum,Eq)

instance JSON JbofiheType where
  readJSON = readJSONEnum "Jbofihe Type"; showJSON = showJSONEnum

data JbofiheOpt = ElidableTerminators
                | RequireTerminatorsAndSeparators
                | OmittableTerminators
                | OmittableTerminatorsVerbose
                | AllowCulturalRafsi
  deriving (Show,Enum,Eq)

instance JSON JbofiheOpt where
  readJSON = readJSONEnum "Jbofihe Opt"; showJSON = showJSONEnum

jbofihe t os q = do
  out <- io $ catch (Right <$> readProcess "jbofihe" (typ t ++ map opt os) q)
                    (\e -> return $ Left $ "Bad parse.")
  case out of
    Left e -> return $ Left e
    Right reply -> return $ Right $ 
      if any (==t) [ParseTreeJson,ParseTreeFullJson]
         then treeToJson $ jbofiheToTree reply
         else showJSON reply
  where typ ParseTree         = ["-t"]
        typ ParseTreeFull     = ["-tf"]
        typ Translate         = ["-x"]
        typ TranslateHtml     = ["-H"]
        typ TranslateLatex    = ["-l"]
        typ ParseTreeJson     = ["-t"]
        typ ParseTreeFullJson = ["-tf"]
        typ Grammar           = []

        opt ElidableTerminators             = "-ie"
        opt RequireTerminatorsAndSeparators = "-re"
        opt OmittableTerminators            = "-se"
        opt OmittableTerminatorsVerbose     = "-sev"
        opt AllowCulturalRafsi              = "-cr"

cleanName = takeWhile (/=' ')
nodeRest  = avoid ' ' . avoid ':' . avoid ' ' . dropWhile (/= ' ')
avoid = dropWhile . (==)
    
treeToJson [Node n []] = makeObj [(cleanName n,showJSON $ nodeRest n)] where
treeToJson nodes = makeObj $ zip names objs where
  names = map (\(Node n _) -> cleanName n) nodes
  objs = map jsonize nodes
   where jsonize (Node n []) = showJSON $ nodeRest n
         jsonize (Node n xs) = treeToJson xs

jbofiheToTree = tree (on (==) (length . takeWhile (/='+'))) clean
              . filter (/="CHUNKS")
              . reverse
              . lines
{'fraction_non_alphanumeric': 0.10087595365922578, 'fraction_numerical': 0.0005651313930488839, 'mean_word_length': 2.254712643678161, 'pattern_counts': {'":': 0, '<': 27, '<?xml version=': 0, '>': 30, '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': '45766', 'n_tokens_mistral': 2280, 'n_tokens_neox': 2202, 'n_words': 646}