הקוד

import System.Environment (getArgs)
import Control.Monad (when)
import Data.Char (isAlpha, isAsciiLower, isAsciiUpper, isSpace, isPrint)
import Data.Maybe (fromMaybe)

-- הגדרות לסיווג תו לפי שפה
isHebrew :: Char -> Bool
isHebrew c = c >= 'א' && c <= 'ת'

isEnglish :: Char -> Bool
isEnglish c = isAsciiLower c || isAsciiUpper c

-- מחזירה Just "Hebrew" או Just "English" עבור אות, או Nothing עבור סימן פיסוק/רווח
charLang :: Char -> Maybe String
charLang c
  | isHebrew c  = Just "Hebrew"
  | isEnglish c = Just "English"
  | otherwise   = Nothing

------------------------------------------------------------
-- טיפוסי טוקנים: טוקן אות – כולל מחרוזת ותווית שפה;
-- טוקן פיסוק/רווח
data Token = Letter { content :: String, lang :: String }
           | Punct  { content :: String }
           deriving (Show)

-- פונקציה שמפצלת מחרוזת לרשימת טוקנים:
-- קבוצות רציפות של אותיות (אותן מסווגים לפי charLang) או קבוצות של סימני פיסוק/רווח
tokenize :: String -> [Token]
tokenize "" = []
tokenize s@(c:_)
  | isAlpha c =
      let (letters, rest) = span (\ch -> isAlpha ch && charLang ch == charLang c) s
      in Letter letters (fromMaybe "" (charLang c)) : tokenize rest
  | otherwise =
      let (punct, rest) = break isAlpha s
      in Punct punct : tokenize rest

------------------------------------------------------------
-- מצב סגמנטציה: בשיטה זו נבצע הקצאה מחדש של סימני פיסוק בגבולות בלוקים.
-- במצב SegHebrew – target היא "Hebrew"
-- במצב SegEnglish – target היא "English"
data SegMode = SegHebrew | SegEnglish deriving (Eq, Show)

-- עוזרת: האם שפה נתונה היא target בהתאם למצב הסגמנטציה
isTarget :: SegMode -> String -> Bool
isTarget SegHebrew l = l == "Hebrew"
isTarget SegEnglish l = l == "English"

-- נרצה לאסוף טוקנים לכדי בלוקים (מחרוזות) כך שהטוקנים המקוריים לא ישתנו,
-- אך סימני הפיסוק שבגבולות יועברו בהתאם לכלל הבא:
--
-- נניח שיש לנו גבול בין טוקן אות (T_prev) לטוקן אות (T_next) עם טוקני פיסוק ביניהם (PunctSeq).
-- אז:
-- • אם T_prev ו–T_next שונות בשייכות target, נחלק את PunctSeq לשניים:
--   - במצב SegHebrew (target = Hebrew): אם T_prev הוא target (Hebrew) ו–T_next אינו, נרצה שהתוצאה תהיה:
--         בלוק target: T_prev בלבד,
--         בלוק non-target: (PunctSeq עם הסימן האחרון מופיע בסופו) <> T_next...
--   - במצב SegEnglish (target = English): אם T_prev אינו target וה–T_next הוא target, אזי
--         בלוק non-target: T_prev <> (PunctSeq עם הסימן הראשון בסופו),
--         בלוק target: T_next...
-- • במקרים בהם שני הטוקנים הם מאותה קטגוריה – פשוט מצרפים את הפיסוק לטוקן הקודם.
--
-- בפועל, נממש פונקציה שמסכמת את רשימת הטוקנים ומעבירה את סימני הפיסוק בהתאם.
reassemble :: SegMode -> [Token] -> [String]
reassemble mode toks = mergeBlocks (assignPunct mode toks)
  where
    -- assignPunct מעבירה סימני פיסוק בגבולות לפי הכלל הפשוט הבא:
    assignPunct :: SegMode -> [Token] -> [Token]
    assignPunct _ [] = []
    assignPunct _ [t] = [t]
    assignPunct m (t1 : Punct punc : t2 : rest) =
      case (t1, t2) of
        (Letter _ l1, Letter _ l2) 
          | isTarget m l1 || isTarget m l2 ->
              -- במקרה של גבול target–non-target
              if isTarget m l1 && not (isTarget m l2)
                 then -- במצב SegHebrew: אם הטוקן השמאלי הוא target, העבר את כל הפיסוק לבלוק הימני
                      t1 : assignPunct m (Letter punc l2 : t2 : rest)
                 else if not (isTarget m l1) && isTarget m l2
                      then -- במצב SegEnglish: אם הטוקן הימני הוא target, העבר את כל הפיסוק לבלוק השמאלי
                           let newT1 = Letter (content t1 ++ punc) l1
                           in newT1 : assignPunct m (t2 : rest)
                      else
                           -- אם שני הצדדים target או שניהם non-target – צרף לפסיק ל-T_prev
                           let newT1 = Letter (content t1 ++ punc) (lang t1)
                           in newT1 : assignPunct m (t2 : rest)
        _ -> t1 : assignPunct m (Punct punc : t2 : rest)
    assignPunct m (t:rest) = t : assignPunct m rest

    -- mergeBlocks פשוט ממזג טוקנים עוקבים לשרשרת אחת (מבוסס על content)
    mergeBlocks :: [Token] -> [String]
    mergeBlocks [] = []
    mergeBlocks (t:ts) = let (grp, rest) = span (sameType t) ts
                             block = concatMap content (t:grp)
                         in block : mergeBlocks rest
      where
        sameType :: Token -> Token -> Bool
        sameType (Letter _ l1) (Letter _ l2) = l1 == l2
        sameType (Punct _) (Punct _) = True
        -- לא ממזג בין אות לפיסוק
        sameType _ _ = False

------------------------------------------------------------
-- פונקציות עיבוד טקסט:
--
-- במצב all:
-- 1. הופכים את כל הטקסט (reverse)
-- 2. מפצלים לבלוקים בעזרת reassemble במצב SegEnglish
-- 3. בתוך הרשימה, בלוקים ששייכים לאנגלית (target במצב SegEnglish) חוזרים הפיכה כדי לשחזר את הסדר המקורי.
processAll :: String -> String
processAll s =
  let revText = reverse s
      toks = tokenize revText
      blocks = reassemble SegEnglish toks
      fixed = map (\blk -> if any isEnglish blk then reverse blk else blk) blocks
  in concat fixed

-- במצב blocks:
-- מפצלים לבלוקים בעזרת reassemble במצב SegHebrew
-- ואז הופכים רק את הבלוקים בהם מופיעות אותיות בעברית.
processBlocks :: String -> String
processBlocks s =
  let toks = tokenize s
      blocks = reassemble SegHebrew toks
      fixed = map (\blk -> if any isHebrew blk then reverse blk else blk) blocks
  in concat fixed

-- Add helper function to remove invisible characters.
removeInvisible :: String -> String
removeInvisible = filter (\c -> isPrint c || isSpace c)

-- Add helper function to trim whitespace.
trim :: String -> String
trim = f . f
  where f = reverse . dropWhile isSpace

main :: IO ()
main = do
  args <- getArgs
  input <- if length args < 2
              then getContents  -- use piped input if no text argument is provided
              else return $ unwords $ tail args
  let txt = trim $ removeInvisible input  -- remove invisible characters then trim whitespace
      flag = if null args then "" else head args
  case flag of
    "-a" -> putStr $ unlines $ map processAll $ lines txt
    "-b" -> putStr $ unlines $ map processBlocks $ lines txt
    _ -> return ()