<commit_before><commit_msg>Module for exporting a strategy to XML<commit_after>-----------------------------------------------------------------------------
-- Copyright 2009, Open Universiteit Nederland. This file is distributed 
-- under the terms of the GNU General Public License. For more information, 
-- see the file "LICENSE.txt", which is included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  <EMAIL>
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-- Generating XML for a strategy
--
-----------------------------------------------------------------------------
module Common.Strategy.ToXML (strategyToXML) where

import Control.Monad
import Common.Strategy.Core
import Common.Strategy.Abstract
import Text.XML
--import Domain.Math.Polynomial.Strategies

-- for testing
{-
main :: IO ()
main = do
   let txt = showXML (strategyToXML quadraticStrategy)
   putStrLn txt
   writeFile "quadreq.xml" txt -}

strategyToXML :: IsStrategy f => f a -> XML
strategyToXML = coreToXML . toCore . toStrategy

infoToXML :: LabelInfo -> XMLBuilder
infoToXML info = do
   "name" .=. labelName info
   when (hidden  info) ("hidden"  .=. "true")
   when (skipped info) ("skipped" .=. "true")
   when (folded  info) ("folded"  .=. "true")

coreToXML :: Core LabelInfo a -> XML
coreToXML core = makeXML "strategy" $ 
   case core of
      Label l a -> infoToXML l >> coreBuilder infoToXML a
      _         -> coreBuilder infoToXML core

coreBuilder :: (l -> XMLBuilder) -> Core l a -> XMLBuilder
coreBuilder f = rec
 where
   rec core = 
      case core of
         _ :*:  _  -> asList  "sequence" isSequence
         _ :|:  _  -> asList  "choice"   isChoice
         _ :|>: _  -> asList  "orelse"   isOrElse
         Many a    -> element "many"     (rec a)
         Repeat a  -> element "repeat"   (rec a)
         Label l a -> element "label"    (f l >> rec a)
         Rec n a   -> element "rec"      (("var" .=. show n) >> rec a)
         Not a     -> element "not"      (recNot a)
         Rule l r  -> element "rule"     (maybe ("name" .=. show r) f l)
         Var n     -> element "var"      ("var" .=. show n)
         Succeed   -> tag     "succeed"
         Fail      -> tag     "fail"
    where
      asList s g = element s (mapM_ rec (collect g core))
      recNot = coreBuilder (const (return ()))

collect :: (a -> Maybe (a, a)) -> a -> [a]
collect f = ($ []) . rec
 where rec a = maybe (a:) (\(x, y) -> rec x . rec y) (f a)
      
isSequence :: Core l a -> Maybe (Core l a, Core l a)
isSequence (a :*: b) = Just (a, b)
isSequence _ = Nothing

isChoice :: Core l a -> Maybe (Core l a, Core l a)
isChoice (a :|: b) = Just (a, b)
isChoice _ = Nothing

isOrElse :: Core l a -> Maybe (Core l a, Core l a)
isOrElse (a :|>: b) = Just (a, b)
isOrElse _ = Nothing
{'fraction_non_alphanumeric': 0.20237264480111655, 'fraction_numerical': 0.0013956734124214933, 'mean_word_length': 1.7943469785575048, 'pattern_counts': {'":': 0, '<': 4, '<?xml version=': 0, '>': 40, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 1}, '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': '2461865', 'n_tokens_mistral': 886, 'n_tokens_neox': 872, 'n_words': 320}