<commit_before>import Haste
import Haste.Ajax
import Haste.DOM hiding (click)
import Haste.Concurrent
import Haste.Events hiding (Click)
import qualified Haste.Events
import Haste.Foreign
import Haste.Binary(getBlobData,toUArray)

import PGF
import PGF.Internal hiding (depth)
import Muste
import Muste.Tree
import Muste.Grammar

import Data.String as S
import Data.Binary(decode)
import Data.ByteString(fromUArray)
import Data.List
import Data.Set hiding (null,map)
import Data.Maybe
import Data.IORef

import Control.Monad

sampleTree =
  TNode "lesson1SfromCl" (Fun "S" ["Cl"])
  [
    TNode "lesson1ClfromNPVP" (Fun "Cl" ["NP","VP"])
    [
      TNode "lesson1NPfromCNsg" (Fun "NP" ["CN"])
      [
        TNode "lesson1CNfromCNNP" (Fun "CN" ["CN","NP"])
        [
          TNode "lesson1CNfromN" (Fun "CN" ["N"])
          [
            TNode "Caesar_N" (Fun "N" []) []
          ],
          TNode "lesson1NPfromPN" (Fun "NP" ["PN"])
          [
            TNode "Augustus_PN" (Fun "PN" []) []
          ]
        ]
      ],
      TNode "lesson1VPfromV2NP" (Fun "VP" ["V2","NP"])
      [
        TNode "vincere_V2" (Fun "V2" []) [],
        TNode "lesson1NPfromPN" (Fun "NP" ["PN"])
        [
          TNode "Gallia_PN" (Fun "PN" []) []
        ]
      ]
    ]
  ]
sampleLang = "PrimaEng"
startTree =
  TNode "lesson1SfromCl" (Fun "S" ["Cl"])
  [
    TNode "lesson1ClfromNPVP" (Fun "Cl" ["NP","VP"])
    [
      TNode "lesson1NPfromCNsg" (Fun "NP" ["CN"])
      [
        TNode "lesson1CNfromN" (Fun "CN" ["N"])
        [
          TNode "imperator_N" (Fun "N" []) []
        ]
      ],
      TNode "lesson1VPfromV2NP" (Fun "VP" ["V2","NP"])
      [
        TNode "tenere_V2" (Fun "V2" []) [],
        TNode "lesson1NPfromCNsg" (Fun "NP" ["CN"])
        [
          TNode "lesson1CNfromN" (Fun "NP" ["PN"])
          [
            TNode "provincia_N" (Fun "N" []) []
          ]
        ]
      ]
    ]
  ]
grammarFile = "Prima.pgf"
depth = 4 -- performance?
editLang = "PrimaLat"

-- Context info necessary for lots of stuff
data Context = Ctx { grammar :: Grammar, language :: Language, tree :: TTree, click :: Maybe Muste.Click, totalClicks :: Int}

-- Loads a pgf file from an url
loadPGF :: String -> CIO PGF
loadPGF url =
  do blob <- ajax GET (S.fromString url)
     pgf <- case blob of {
       Left a -> error "AjaxError" ; 
       Right blob -> do
           writeLog (S.fromString ("Loaded pgf as Blob "++url)) :: CIO ()
           blobdata <- getBlobData blob
           writeLog $ toJSString "Got blobdata"
           let bs = fromUArray (toUArray blobdata)
           return $ decode bs
        }
     writeLog (S.fromString ("Loaded "++ show (abstractName pgf))) :: CIO ()
     return pgf

-- Main function that sets up everything
musteMain :: PGF -> IO ()
musteMain pgfGrammar =
  do
    -- Initialize Context
    writeLog (S.fromString "Convert grammar")
    let grammar = pgfToGrammar pgfGrammar
    -- let language = head $ languages pgfGrammar
    -- modify the tree, use the first language in the grammar. no previous click
    context <- newIORef (Ctx grammar (mkCId editLang) startTree Nothing 0)
    -- Global handlers
    onEvent documentBody Haste.Events.Click (globalClickHandler context)
    Just menu <- elemById "menuButton"
    onEvent menu Haste.Events.Click (menuClickHandler menu context)
    -- Print target tree
    writeLog (S.fromString "Draw sample tree")
    drawSampleTree context
    writeLog (S.fromString "Draw object tree")
    drawTree context
    return ()

-- Updates the click counter
drawScore :: IORef Context -> IO ()
drawScore context =
  do
    Just score <- elemById "score"
    ctx <- readIORef context
    clearChildren score
    te <- newTextElem (show $ totalClicks ctx)
    appendChild score te

drawSampleTree :: IORef Context -> IO ()
drawSampleTree context =
  do
    -- Get context
    ctx <- readIORef context
    -- Get element
    Just sampleTreeDiv <- elemById "sampleTree"
    -- Clear content
    clearChildren sampleTreeDiv
    -- Check for debug
    debug <- hasClass sampleTreeDiv "debug"
    -- Show tree as text
    sequence_ $ map (\t -> drawWord sampleTreeDiv context t 0 debug False False ) $ linearizeTree (grammar ctx) (mkCId sampleLang) sampleTree
    return ()

drawWord :: Elem -> IORef Context -> LinToken -> Pos -> Bool -> Bool -> Bool ->IO ()
drawWord parent context (p,s) pos debug enableGaps enableEvents =
  do<commit_msg>little more code separation and debugging<commit_after>import Haste
import Haste.Ajax
import Haste.DOM hiding (click)
import Haste.Concurrent
import Haste.Events hiding (Click)
import qualified Haste.Events
import Haste.Foreign
import Haste.Binary(getBlobData,toUArray)

import PGF
import PGF.Internal hiding (depth)
import Muste
import Muste.Tree
import Muste.Grammar

import Data.String as S
import Data.Binary(decode)
import Data.ByteString(fromUArray)
import Data.List
import Data.Set hiding (null,map)
import Data.Maybe
import Data.IORef

import Control.Monad

sampleTree =
  TNode "lesson1SfromCl" (Fun "S" ["Cl"])
  [
    TNode "lesson1ClfromNPVP" (Fun "Cl" ["NP","VP"])
    [
      TNode "lesson1NPfromCNsg" (Fun "NP" ["CN"])
      [
        TNode "lesson1CNfromCNNP" (Fun "CN" ["CN","NP"])
        [
          TNode "lesson1CNfromN" (Fun "CN" ["N"])
          [
            TNode "Caesar_N" (Fun "N" []) []
          ],
          TNode "lesson1NPfromPN" (Fun "NP" ["PN"])
          [
            TNode "Augustus_PN" (Fun "PN" []) []
          ]
        ]
      ],
      TNode "lesson1VPfromV2NP" (Fun "VP" ["V2","NP"])
      [
        TNode "vincere_V2" (Fun "V2" []) [],
        TNode "lesson1NPfromPN" (Fun "NP" ["PN"])
        [
          TNode "Gallia_PN" (Fun "PN" []) []
        ]
      ]
    ]
  ]
sampleLang = "PrimaEng"
startTree =
  TNode "lesson1SfromCl" (Fun "S" ["Cl"])
  [
    TNode "lesson1ClfromNPVP" (Fun "Cl" ["NP","VP"])
    [
      TNode "lesson1NPfromCNsg" (Fun "NP" ["CN"])
      [
        TNode "lesson1CNfromN" (Fun "CN" ["N"])
        [
          TNode "imperator_N" (Fun "N" []) []
        ]
      ],
      TNode "lesson1VPfromV2NP" (Fun "VP" ["V2","NP"])
      [
        TNode "tenere_V2" (Fun "V2" []) [],
        TNode "lesson1NPfromCNsg" (Fun "NP" ["CN"])
        [
          TNode "lesson1CNfromN" (Fun "NP" ["PN"])
          [
            TNode "provincia_N" (Fun "N" []) []
          ]
        ]
      ]
    ]
  ]
grammarFile = "Prima.pgf"
depth = 4 -- performance?
editLang = "PrimaLat"

-- Context info necessary for lots of stuff
data Context = Ctx { grammar :: Grammar, language :: Language, tree :: TTree, click :: Maybe Muste.Click, totalClicks :: Int}

-- Loads a pgf file from an url
loadPGF :: String -> CIO PGF
loadPGF url =
  do blob <- ajax GET (S.fromString url)
     pgf <- case blob of {
       Left a -> error "AjaxError" ; 
       Right blob -> do
           writeLog (S.fromString ("Loaded pgf as Blob "++url)) :: CIO ()
           blobdata <- getBlobData blob
           writeLog $ toJSString "Got blobdata"
           let bs = fromUArray (toUArray blobdata)
           return $ decode bs
        }
     writeLog (S.fromString ("Loaded "++ show (abstractName pgf))) :: CIO ()
     return pgf

-- Main function that sets up everything
musteMain :: PGF -> IO ()
musteMain pgfGrammar =
  do
    -- Initialize Context
    writeLog (S.fromString "Convert grammar")
    let grammar = pgfToGrammar pgfGrammar
    -- let language = head $ languages pgfGrammar
    -- modify the tree, use the first language in the grammar. no previous click
    context <- newIORef (Ctx grammar (mkCId editLang) startTree Nothing 0)
    -- Global handlers
    onEvent documentBody Haste.Events.Click (globalClickHandler context)
    Just menu <- elemById "menuButton"
    onEvent menu Haste.Events.Click (menuClickHandler menu context)
    -- Print target tree
    writeLog (S.fromString "Draw sample tree")
    drawSampleTree context
    writeLog (S.fromString "Draw object tree")
    drawTree context
    return ()

-- Updates the click counter
drawScore :: IORef Context -> IO ()
drawScore context =
  do
    Just score <- elemById "score"
    ctx <- readIORef context
    clearChildren score
    te <- newTextElem (show $ totalClicks ctx)
    appendChild score te

drawSampleTree :: IORef Context -> IO ()
drawSampleTree context =
  do
    -- Get context
    ctx <- readIORef context
    -- Get element
    Just sampleTreeDiv <- elemById "sampleTree"
    -- Clear content
    clearChildren sampleTreeDiv
    -- Check for debug
    debug <- hasClass sampleTreeDiv "debug"
    -- Show tree as text
    let linTree = linearizeTree (grammar ctx) (mkCId sampleLang) sampleTree
    writeLog (toJSString $ show linTree)
    sequence_ $ map (\t -> drawWord sampleTreeDiv context t 0 debug False False ) $ linTree
    return ()

drawWord :: Elem -> IORef Context -> LinToken -> Pos -> Bool -> Bool -> Bool ->IO ()
drawWord parent context (p,s) pos debug enableGaps enableEvents =
  do
{'fraction_non_alphanumeric': 0.12221600447677672, 'fraction_numerical': 0.0058198097369893675, 'mean_word_length': 2.5278326095538888, 'pattern_counts': {'":': 0, '<': 25, '<?xml version=': 0, '>': 31, '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': '52479', 'n_tokens_mistral': 2989, 'n_tokens_neox': 2924, 'n_words': 875}