packages feed

hydra-0.15.0: src/main/haskell/Hydra/Sources/Test/Lib/Strings.hs

module Hydra.Sources.Test.Lib.Strings where

-- Standard imports for shallow DSL tests
import Hydra.Kernel
import Hydra.Dsl.Meta.Testing                 as Testing
import Hydra.Dsl.Meta.Terms                   as Terms
import Hydra.Sources.Kernel.Types.All
import qualified Hydra.Dsl.Meta.Core          as Core
import qualified Hydra.Dsl.Meta.Phantoms      as Phantoms
import qualified Hydra.Dsl.Meta.Types         as T
import qualified Hydra.Sources.Test.TestGraph as TestGraph
import qualified Hydra.Sources.Test.TestTerms as TestTerms
import qualified Hydra.Sources.Test.TestTypes as TestTypes
import qualified Data.List                    as L
import qualified Data.Map                     as M

-- Additional imports specific to this file
import Hydra.Testing
import Hydra.Sources.Libraries
import qualified Hydra.Dsl.Meta.Lib.Lists as Lists
import qualified Hydra.Dsl.Meta.Lib.Literals as Literals
import qualified Hydra.Dsl.Meta.Lib.Strings as Strings


ns :: Namespace
ns = Namespace "hydra.test.lib.strings"

module_ :: Module
module_ = Module {
            moduleNamespace = ns,
            moduleDefinitions = definitions,
            moduleTermDependencies = [TestGraph.ns, Namespace "hydra.reduction", Namespace "hydra.show.core"],
            moduleTypeDependencies = kernelTypesNamespaces,
            moduleDescription = (Just "Test cases for hydra.lib.strings primitives")}
  where
    definitions = [
        Phantoms.toDefinition allTests]

define :: String -> TTerm a -> TTermDefinition a
define = definitionInModule module_

allTests :: TTermDefinition TestGroup
allTests = define "allTests" $
    Phantoms.doc "Test cases for hydra.lib.strings primitives" $
    supergroup "hydra.lib.strings primitives" [
      stringsCat,
      stringsCat2,
      stringsFromList,
      stringsIntercalate,
      stringsLength,
      stringsLines,
      stringsMaybeCharAt,
      stringsNull,
      stringsSplitOn,
      stringsToList,
      stringsToLower,
      stringsToUpper,
      stringsUnlines]
    where
      -- Show functions for evalPair
      showInt32 :: TTerm (Int -> String)
      showInt32 = Phantoms.lambda "n" $ Literals.showInt32 (Phantoms.var "n")
      showBool :: TTerm (Bool -> String)
      showBool = Phantoms.lambda "b" $ Literals.showBoolean (Phantoms.var "b")
      showStringList :: TTerm ([String] -> String)
      showStringList = Phantoms.lambda "xs" $ Literals.showString (Strings.intercalate (Phantoms.string ", ") (Phantoms.var "xs"))
      showIntList :: TTerm ([Int] -> String)
      showIntList = Phantoms.lambda "xs" $ Strings.intercalate (Phantoms.string ", ") (Lists.map (Phantoms.lambda "n" $ Literals.showInt32 (Phantoms.var "n")) (Phantoms.var "xs"))

      stringsCat = subgroup "cat" [
        -- Basic functionality
        test "basic concatenation" ["one", "two", "three"] "onetwothree",
        test "single string" ["hello"] "hello",
        test "empty list" [] "",

        -- Empty string handling
        test "with empty strings" ["", "one", "", ""] "one",
        test "all empty strings" ["", "", "", ""] "",

        -- Unicode correctness
        test "unicode strings" ["\241", "\19990", "\127757"] "\241\19990\127757",  -- ñ, 世, 🌍
        test "combining characters" ["e", "\769"] "e\769",  -- e + combining acute accent

        -- Special characters (control characters may be handled specially)
        test "control characters" ["\n", "\t", "\r"] "\n\t\r",
        test "null character" ["hello", "\0", "world"] "hello\0world"]
        where
          test name ls result = stringEvalPair name
            (Strings.cat (Phantoms.list (Phantoms.string <$> ls)))
            (Phantoms.string result)
  
      stringsCat2 = subgroup "cat2" [
        test "basic concatenation" "hello" "world" "helloworld",
        test "empty first string" "" "world" "world",
        test "empty second string" "hello" "" "hello",
        test "both empty strings" "" "" "",
        test "unicode characters" "\241" "\19990" "\241\19990",  -- ñ, 世
        test "special characters" "\n" "\t" "\n\t",
        test "null characters" "hello\0" "world" "hello\0world"]
        where
          test name s1 s2 result = stringEvalPair name
            (Strings.cat2 (Phantoms.string s1) (Phantoms.string s2))
            (Phantoms.string result)
  
      stringsFromList = subgroup "fromList" [
        test "basic ascii string" [104, 101, 108, 108, 111] "hello",
        test "empty code point list" [] "",
        test "single character" [97] "a",
        test "unicode characters" [241, 19990, 127757] "\241\19990\127757",  -- ñ, 世, 🌍
        test "combining character sequence" [101, 769] "e\769",  -- e + combining acute
        test "special characters" [10, 9, 13] "\n\t\r",
        test "null character" [104, 0, 105] "h\0i"]  -- h, null, i
        where
          test name codePoints result = stringEvalPair name
            (Strings.fromList (Phantoms.list (Phantoms.int32 <$> codePoints)))
            (Phantoms.string result)
  
      stringsIntercalate = subgroup "intercalate" [
        -- Basic functionality
        test "comma separator" "," ["one", "two", "three"] "one,two,three",
        test "empty separator" "" ["a", "b", "c"] "abc",
        test "multi-character separator" " | " ["A", "B", "C"] "A | B | C",

        -- Edge cases
        test "empty string list" "," [] "",
        test "single item list" "," ["only"] "only",
        test "empty strings in list" "," ["", "a", ""] ",a,",

        -- Unicode and special characters
        test "unicode separator" "\127757" ["link1", "link2"] "link1\127757link2",  -- 🌍
        test "newline separator" "\n" ["line1", "line2"] "line1\nline2"]
        where
          test name sep strs result = stringEvalPair name
            (Strings.intercalate (Phantoms.string sep) (Phantoms.list (Phantoms.string <$> strs)))
            (Phantoms.string result)
  
      stringsLength = subgroup "length" [
        test "empty string" "" 0,
        test "single character" "a" 1,
        test "basic word" "hello" 5,
        test "unicode characters" "\241\19990\127757" 3,  -- ñ, 世, 🌍 (verifies code point count)
        test "combining character sequence" "e\769" 2,  -- e + combining acute (separate code points)
        test "special characters" "\n\t\r" 3]
        where
          test name s result = evalPair name showInt32
            (Strings.length (Phantoms.string s))
            (Phantoms.int32 result)
  
      stringsLines = subgroup "lines" [
        -- Basic functionality
        test "single line" "hello world" ["hello world"],
        test "two lines" "hello\nworld" ["hello", "world"],
        test "three lines" "one\ntwo\nthree" ["one", "two", "three"],

        -- Edge cases with newlines
        test "empty string" "" [],
        test "just newline" "\n" [""],
        test "trailing newline" "hello\n" ["hello"],
        test "leading newline" "\nhello" ["", "hello"],

        -- Consecutive newlines
        test "multiple consecutive newlines" "a\n\nb" ["a", "", "b"],

        -- Unicode and other whitespace
        test "unicode content" "\241\n\19990" ["\241", "\19990"],  -- ñ, 世
        test "tabs not split" "a\tb\nc" ["a\tb", "c"]]  -- only \n splits, not \t
        where
          test name s result = evalPair name showStringList
            (Strings.lines (Phantoms.string s))
            (Phantoms.list (Phantoms.string <$> result))
  
      stringsMaybeCharAt = subgroup "maybeCharAt" [
        test "first character" 0 "hello" (Just 104),
        test "middle character" 2 "hello" (Just 108),
        test "last character" 4 "hello" (Just 111),
        test "single character string" 0 "a" (Just 97),
        test "unicode character" 0 "\241" (Just 241),           -- ñ
        test "multi-byte unicode" 0 "\19990" (Just 19990),      -- 世
        test "second of combining pair" 1 "e\769" (Just 769),   -- combining acute accent
        test "out of bounds" 5 "hello" Nothing,
        test "negative index" (-1) "hello" Nothing,
        test "empty string" 0 "" Nothing]
        where
          test name idx s result = primCase name _strings_maybeCharAt [int32 idx, string s] (optionalInt32 result)
          optionalInt32 Nothing = Core.termMaybe nothing
          optionalInt32 (Just x) = Core.termMaybe $ just (int32 x)

      stringsNull = subgroup "null" [
        test "empty string" "" True,
        test "single character" "a" False,
        test "space" " " False,
        test "unicode space" "\160" False,  -- non-breaking space
        test "newline" "\n" False,
        test "null character" "\0" False,
        test "multi-character" "hello" False]
        where
          test name s result = evalPair name showBool
            (Strings.null (Phantoms.string s))
            (Phantoms.boolean result)
  
      stringsSplitOn = subgroup "splitOn" [
        -- Basic functionality
        test "basic separator" "ss" "Mississippi" ["Mi", "i", "ippi"],
        test "single char separator" " " "one two three" ["one", "two", "three"],
        test "multi-char separator" "  " "a  b  c" ["a", "b", "c"],
        test "separator not found" "x" "hello" ["hello"],

        -- Edge cases with separator positions
        test "separator at start" "h" "hello" ["", "ello"],
        test "separator at end" "o" "hello" ["hell", ""],
        test "leading and trailing separator" " " " one two " ["", "one", "two", ""],
        test "whole string as separator" "Mississippi" "Mississippi" ["", ""],

        -- Consecutive and overlapping separators
        test "consecutive separators" " " "a  b" ["a", "", "b"],
        test "multiple occurrences" "l" "hello" ["he", "", "o"],
        test "overlapping pattern" "aa" "aaa" ["", "a"],

        -- Empty string cases
        test "empty separator" "" "abc" ["", "a", "b", "c"],
        test "separator on empty string" "x" "" [""],
        test "both empty" "" "" [""],

        -- Single character cases
        test "single char both" "a" "a" ["", ""],

        -- Unicode
        test "unicode separator" "\19990" "hello\19990world" ["hello", "world"],  -- 世
        test "unicode content" "," "\241,\19990,\127757" ["\241", "\19990", "\127757"],  -- ñ,世,🌍

        -- Special characters
        test "newline separator" "\n" "line1\nline2\nline3" ["line1", "line2", "line3"]]
        where
          test name s0 s1 result = evalPair name showStringList
            (Strings.splitOn (Phantoms.string s0) (Phantoms.string s1))
            (Phantoms.list (Phantoms.string <$> result))
  
      stringsToList = subgroup "toList" [
        -- Basic functionality
        test "empty string" "" [],
        test "single character" "a" [97],
        test "basic word" "hello" [104, 101, 108, 108, 111],

        -- Unicode
        test "unicode characters" "\241\19990\127757" [241, 19990, 127757],  -- ñ, 世, 🌍
        test "combining character sequence" "e\769" [101, 769],  -- e + combining acute

        -- Special characters
        test "control characters" "\n\t\r" [10, 9, 13],
        test "null character" "h\0i" [104, 0, 105]]
        where
          test name s result = evalPair name showIntList
            (Strings.toList (Phantoms.string s))
            (Phantoms.list (Phantoms.int32 <$> result))
  
      stringsToLower = subgroup "toLower" [
        -- Basic functionality
        test "mixed case" "Hello World" "hello world",
        test "all uppercase" "HELLO" "hello",
        test "all lowercase" "hello" "hello",
        test "empty string" "" "",

        -- Non-letter characters unchanged
        test "with numbers and punctuation" "Abc123, XYZ!" "abc123, xyz!",
        test "control characters" "\n\t\r" "\n\t\r",

        -- Unicode
        test "unicode accented chars" "\209\193\201\205\211\218" "\241\225\233\237\243\250"]  -- ÑÁÉÍÓÚ -> ñáéíóú
        where
          test name s result = stringEvalPair name
            (Strings.toLower (Phantoms.string s))
            (Phantoms.string result)
  
      stringsToUpper = subgroup "toUpper" [
        -- Basic functionality
        test "mixed case" "hello World" "HELLO WORLD",
        test "all lowercase" "hello" "HELLO",
        test "all uppercase" "HELLO" "HELLO",
        test "empty string" "" "",

        -- Non-letter characters unchanged
        test "with numbers and punctuation" "abc123, xyz!" "ABC123, XYZ!",
        test "control characters" "\n\t\r" "\n\t\r",

        -- Unicode
        test "unicode accented chars" "\241\225\233\237\243\250" "\209\193\201\205\211\218"]  -- ñáéíóú -> ÑÁÉÍÓÚ
        where
          test name s result = stringEvalPair name
            (Strings.toUpper (Phantoms.string s))
            (Phantoms.string result)
  
      stringsUnlines = subgroup "unlines" [
        -- Basic functionality
        test "multiple lines" ["one", "two", "three"] "one\ntwo\nthree\n",
        test "single line" ["hello"] "hello\n",
        test "empty list" [] "",

        -- Empty strings in list
        test "with empty lines" ["hello", "", "world"] "hello\n\nworld\n",
        test "all empty lines" ["", "", ""] "\n\n\n",

        -- Unicode
        test "unicode content" ["\241o\241o", "\19990\30028"] "\241o\241o\n\19990\30028\n"]  -- ñoño, 世界
        where
          test name strs result = stringEvalPair name
            (Strings.unlines (Phantoms.list (Phantoms.string <$> strs)))
            (Phantoms.string result)