{-# LANGUAGE FlexibleContexts, TypeFamilies, TypeSynonymInstances, TemplateHaskell, QuasiQuotes, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, DeriveDataTypeable, ScopedTypeVariables #-} module First where import Language.Pads.Padsc import Language.Pads.Testing import FirstPads import Language.Haskell.TH import System.IO.Unsafe (unsafePerformIO) import Data.Char as Char import qualified Data.ByteString as B import Data.Word --import qualified Text.Regex.ByteString as BRE ws = REd "[\t ]+|$" " " ---- PADS EXAMPLES [pads| |] [pads| type MyChar = Char |] myChar_result = myChar_parseS "ab" myChar_expects = ('a', 0,"b") myChar_test = mkTestCase "myChar" myChar_expects myChar_result [pads| type IntPair = (Int, '|', Int) |] intPair_result = intPair_parseS "12|23" intPair_expects = ((12,23), 0,"") intPair_test = mkTestCase "intPair" intPair_expects intPair_result [pads| type Bar = (Int, ',', IntPair, ';', Int) |] -- reference to another named type bar_result = bar_parseS "256,12|23;456:" bar_expects = ((256, (12, 23), 456), 0, ":") bar_test = mkTestCase "bar" bar_expects bar_result [pads| type Bar2 = (Int, ',', (Int,':',Int), ';', Int) |] -- nested tuple type. bar2_result = bar2_parseS "56,23:46;29" bar2_expects = ((56,(23,46),29), 0 ,"") bar2_test = mkTestCase "bar2" bar2_expects bar2_result [pads| type BazR = Line (Int, ',', Int) |] -- type that consumes a line boundary. bazr_result = bazR_parseS "33,33\n" bazr_expects = ((33,33),0,"") bazr_test = mkTestCase "bazr" bazr_expects bazr_result [pads| type MyInt = Int |] -- Integer base type myInt_result = myInt_parseS "23" myInt_expects = (23,0,"") myInt_test = mkTestCase "myInt" myInt_expects myInt_result {- String base types -} testStrLen = 2 computeLen x = x - 1 [pads| type StrTy = StringFW <| testStrLen + (computeLen 4) |> |] inputStrTy = "catdog" strTy_results = strTy_parseS inputStrTy strTy_expects = ("catdo", 0,"g") strTy_test = mkTestCase "strTy" strTy_expects strTy_results [pads| type StrTy1 = StringC 'o' |] strTy1_results = strTy1_parseS inputStrTy strTy1_expects = ("catd",0,"og") strTy1_test = mkTestCase "strTy1" strTy1_expects strTy1_results [pads| type Baz = (StringFW 3,',',Int) |] input_baz = "cat,123" baz_results = baz_parseS input_baz baz_expects = (("cat",123),0,"") baz_test = mkTestCase "baz" baz_expects baz_results {- Regular expression types -} [pads| type StrME = StringME 'a+' |] input_strME = "aaaab" strME_results = strME_parseS input_strME [pads| type StrSE = StringSE <|RE "b|c"|> |] input_strSE_1 = "aaaab" input_strSE_2 = "aaaac" strSE_results_1 = strSE_parseS input_strSE_1 strSE_results_2 = strSE_parseS input_strSE_2 [pads| type StrP1 (x::Int) = StringFW <|x - 1|> |] input_strP1 = "abcd" strP1_result = strP1_parseS 3 input_strP1 [pads| type StrHex = StringME '[0-9A-Fa-f]+' |] input_strHex = "12abcds" strHex_result = strHex_parseS input_strHex {- Testing for Phex32FW, which is in Pads.Language.BaseTypes -} input_hex32FW = "12bc34" phex32FW_results = phex32FW_parseS 4 input_hex32FW phex32FW_expects = (4796, 0, "34") phex32FW_test = mkTestCase "phex32FW" phex32FW_expects phex32FW_results input2_hex32FW = "00bc34" strhex32FW_result2 = phex32FW_parseS 4 input2_hex32FW -- ((Phex32FW (188),Errors: 0),"34") input3_hex32FW = "gbc34" strhex32FW_result3 = phex32FW_parseS 4 input3_hex32FW -- Prints error message [pads| type HexPair = (Phex32FW 2, ',', Phex32FW 3) |] input_hexpair = "aa,bbb" hexpair_result = hexPair_parseS input_hexpair {- Constrained types -} [pads| type IntRange = constrain x :: Int where <| 0 <= x && x <= 256 |> |] intRange24_input = "24" intRange0_input = "0" intRange256_input = "256" intRangeLow_input = "-23" intRangeHigh_input = "512" intRangeBad_input = "aaa" result_intRange24 = intRange_parseS intRange24_input expect_intRange24 = (24,0,"") test_intRange24 = mkTestCase "IntRange24" expect_intRange24 result_intRange24 result_intRange0 = intRange_parseS intRange0_input expect_intRange0 = (0,0,"") test_intRange0 = mkTestCase "IntRange0" expect_intRange0 result_intRange0 result_intRange256 = intRange_parseS intRange256_input expect_intRange256 = (256,0,"") test_intRange256 = mkTestCase "IntRange256" expect_intRange256 result_intRange256 result_intRangeLow = intRange_parseS intRangeLow_input expect_intRangeLow = ((-23),1,"") test_intRangeLow = mkTestCase "IntRangeLow" expect_intRangeLow result_intRangeLow result_intRangeHigh = intRange_parseS intRangeHigh_input expect_intRangeHigh = (512,1,"") test_intRangeHigh = mkTestCase "IntRangeHigh" expect_intRangeHigh result_intRangeHigh result_intRangeBad = intRange_parseS intRangeBad_input expect_intRangeBad = (0,1,"aaa") test_intRangeBad = mkTestCase "IntRangeBad" expect_intRangeBad result_intRangeBad {- Note that the special variable "md" is in scope in the body of the predicate. -} {- md is the meta-data descriptor for the underyling type. -} [pads| type IntRangeP (low::Int, high::Int) = constrain x :: Int where <| low <= x && x <= high && (numErrors md == 0) |> |] result_intRangeP24 = intRangeP_parseS (0, 256) intRange24_input expect_intRangeP24 = (24,0,"") test_intRangeP24 = mkTestCase "IntRangeP24" expect_intRangeP24 result_intRangeP24 result_intRangeP0 = intRangeP_parseS (0, 256) intRange0_input expect_intRangeP0 = (0,0,"") test_intRangeP0 = mkTestCase "IntRangeP0" expect_intRangeP0 result_intRangeP0 result_intRangeP256 = intRangeP_parseS (0, 256) intRange256_input expect_intRangeP256 = (256,0,"") test_intRangeP256 = mkTestCase "IntRangeP256" expect_intRangeP256 result_intRangeP256 result_intRangePLow = intRangeP_parseS (0, 256) intRangeLow_input expect_intRangePLow = ((-23), 1, "") test_intRangePLow = mkTestCase "IntRangePLow" expect_intRangePLow result_intRangePLow result_intRangePHigh = intRangeP_parseS (0, 256) intRangeHigh_input expect_intRangePHigh = (512, 1,"") test_intRangePHigh = mkTestCase "IntRangePHigh" expect_intRangePHigh result_intRangePHigh result_intRangePBad = intRangeP_parseS (0, 256) intRangeBad_input expect_intRangePBad = (0, 2,"aaa") test_intRangePBad = mkTestCase "IntRangePBad" expect_intRangePBad result_intRangePBad [pads| data Record (bound::Int) = Record { i1 :: Int, ',', i2 :: Int where <| i1 + i2 <= bound |> } |] input_Record = "24,45" result_Record = record_parseS 100 input_Record expect_Record = (Record {i1 = 24, i2 = 45},0,"") test_Record = mkTestCase "Record" expect_Record result_Record [pads| data Id = Numeric Int | Alpha (StringC ',') |] input_IdInt = "23" result_IdInt = id_parseS input_IdInt expect_IdInt = (Numeric 23,0,"") test_IdInt = mkTestCase "IdInt" expect_IdInt result_IdInt input_IdStr = "hello" result_IdStr = id_parseS input_IdStr expect_IdStr = (Alpha ("hello"),0,"") test_IdStr = mkTestCase "IdAlpha" expect_IdStr result_IdStr [pads| data Id2 (bound::Int) = Numeric2 (constrain n::Int where <| n <= bound |>) | Alpha2 (StringC ',') |] input_IdInt2 = "23" result_IdInt2 = id2_parseS 10 input_IdInt2 expect_IdInt2 = (Alpha2 ("23"),0,"") test_IdInt2 = mkTestCase "IdInt2" expect_IdInt2 result_IdInt2 input_IdStr2 = "hello" result_IdStr2 = id2_parseS 10 input_IdStr2 expect_IdStr2 = (Alpha2 ("hello"),0,"") test_IdStr2 = mkTestCase "IdAlpha2" expect_IdStr2 result_IdStr2 [pads| data Id3 = Numeric3 (IntRangeP <|(1,10)|>) | Numeric3a Int | Lit3 ',' |] input_IdInt3 = "24" result_IdInt3 = id3_parseS input_IdInt3 expect_IdInt3 = (Numeric3a (24),0,"") test_IdInt3 = mkTestCase "IdInt3" expect_IdInt2 result_IdInt2 input_IdLit3 = "," result_IdLit3 = id3_parseS input_IdLit3 expect_IdLit3 = (Lit3,0,"") test_IdLit3 = mkTestCase "IdLit3" expect_IdLit3 result_IdLit3 [pads| data Ab_or_a = AB "ab" | A "a" |] input_AB = "ab" result_Ab_or_a = ab_or_a_parseS input_AB expect_Ab_or_a = (AB,0,"") test_Ab_or_a = mkTestCase "Ab_or_a" expect_Ab_or_a result_Ab_or_a [pads| data AB_test = AB_test { field_AB :: Ab_or_a , 'b'} |] input_AB_test1 = "abb" result_AB_test1 = aB_test_parseS input_AB_test1 expect_AB_test1 = (AB_test {field_AB = AB},0,"") test_AB_test1 = mkTestCase "AB_test1" expect_AB_test1 result_AB_test1 input_AB_test2 = "ab" result_AB_test2 = aB_test_parseS input_AB_test2 --expect_AB_test2 = (AB_test {field_AB = A},0,"") -- if backtracking expect_AB_test2 = (AB_test {field_AB = AB},1,"") test_AB_test2 = mkTestCase "AB_test2" expect_AB_test2 result_AB_test2 [pads| data Method = GET | PUT | LINK | UNLINK | POST data Version = Version {"HTTP/" , major :: Int, '.' , minor :: Int} |] checkVersion :: Method -> Version -> Bool checkVersion method version = case method of LINK -> major version == 1 && minor version == 0 UNLINK -> major version == 1 && minor version == 0 _ -> True [pads| data Request = Request { '"', method :: Method , ' ', url :: StringC ' ' , ' ', version :: Version where <| checkVersion method version |> , '"' } |] input_method_get = "GET" result_method_get = method_parseS input_method_get expect_method_get = (GET,0,"") test_method_get = mkTestCase "Method_get" expect_method_get result_method_get input_method_put = "PUT" result_method_put = method_parseS input_method_put expect_method_put = (PUT,0,"") test_method_put = mkTestCase "Method_put" expect_method_put result_method_put input_method_link = "LINK" result_method_link = method_parseS input_method_link expect_method_link = (LINK,0,"") test_method_link = mkTestCase "Method_link" expect_method_link result_method_link input_method_post = "POST" result_method_post = method_parseS input_method_post expect_method_post = (POST,0,"") test_method_post = mkTestCase "Method_post" expect_method_post result_method_post input_version = "HTTP/1.2" result_version = version_parseS input_version expect_version = (Version {major = 1, minor = 2},0,"") test_version = mkTestCase "Version" expect_version result_version input_request_G = "\"PUT /www.google.com HTTP/1.0\"" result_request_G = request_parseS input_request_G expect_request_G = (Request {method = PUT, url = "/www.google.com", version = Version {major = 1, minor = 0}}, 0, "") test_request_G = mkTestCase "Request_G" expect_request_G result_request_G input_request_B = "\"LINK /www.google.com HTTP/1.3\"" result_request_B = request_parseS input_request_B expect_request_B = (Request {method = LINK, url = "/www.google.com", version = Version {major = 1, minor = 3}},1, "") test_request_B = mkTestCase "Request_B" expect_request_B result_request_B [pads| type Eor_Test = (Int, EOR, Int) |] input_eor_test = "23\n56" result_eor_test = eor_Test_parseS input_eor_test expect_eor_test = ((23,56),0,"") test_eor_test = mkTestCase "Eor_Test" expect_eor_test result_eor_test [pads| type Eof_Test = (Int, EOR, Int, EOF) |] input_eof_test_G = "23\n56" result_eof_test_G = eof_Test_parseS input_eof_test_G expect_eof_test_G = ((23,56),0,"") test_eof_test_G = mkTestCase "Eof_TestG" expect_eof_test_G result_eof_test_G input_eof_test_B = "23\n56ab" result_eof_test_B = eof_Test_parseS input_eof_test_B expect_eof_test_B = ((23,56), 1,"ab") test_eof_test_B = mkTestCase "Eof_TestB" expect_eof_test_B result_eof_test_B {- Restate after Maybe is implemented -} [pads| type Opt_test = (Int, '|', Maybe Int, '|', Int) |] input_opt_test_j = "34|35|56" result_opt_test_j = opt_test_parseS input_opt_test_j expect_opt_test_j = ((34,Just 35,56),0,"") test_opt_test_j = mkTestCase "Opt_test_j" expect_opt_test_j result_opt_test_j input_opt_test_n = "34||56" result_opt_test_n = opt_test_parseS input_opt_test_n expect_opt_test_n = ((34,Nothing,56),0,"") test_opt_test_n = mkTestCase "Opt_test_n" expect_opt_test_n result_opt_test_n {- LIST EXAMPLES -} [pads| type Entries_nosep_noterm = [StringFW 3] |] input_entries_nosep_noterm = "123456789" result_entries_nosep_noterm = entries_nosep_noterm_parseS input_entries_nosep_noterm expect_entries_nosep_noterm = (["123","456","789"],0,"") test_entries_nosep_noterm = mkTestCase "NoSep_NoTerm" expect_entries_nosep_noterm result_entries_nosep_noterm input_entries_nosep_noterm' = "1234567890" result_entries_nosep_noterm' = entries_nosep_noterm_parseS input_entries_nosep_noterm' expect_entries_nosep_noterm' = (["123","456","789"],0,"0") test_entries_nosep_noterm' = mkTestCase "NoSep_NoTerm'" expect_entries_nosep_noterm' result_entries_nosep_noterm' [pads| type Entries_nosep_noterm2 = [Char] |] input_entries_nosep_noterm2 = "" result_entries_nosep_noterm2 = entries_nosep_noterm2_parseS input_entries_nosep_noterm2 expect_entries_nosep_noterm2 = ([],0,"") test_entries_nosep_noterm2 = mkTestCase "NoSep_NoTerm2" expect_entries_nosep_noterm2 result_entries_nosep_noterm2 [pads| type EvenInt = constrain x :: Digit where <| x `mod` 2 == 0 |> type EvenInts = [EvenInt] |] input_evenInts = "2465" result_evenInt = evenInt_parseS input_evenInts expect_evenInt = ( 2,0,"465") test_evenInt = mkTestCase "EvenInt" expect_evenInt result_evenInt result_evenInts = evenInts_parseS input_evenInts expect_evenInts = ([2,4,6],0,"5") test_evenInts = mkTestCase "EvenInts" expect_evenInts result_evenInts [pads| type DigitList = [Digit | ','] |] input_digitListG = "1,2,3" input_digitList2G = "1,2,3|fed" input_digitListB = "1,b,3" result_digitListG = digitList_parseS input_digitListG expect_digitListG = ([1,2,3],0,"") test_digitListG = mkTestCase "DigitListG" expect_digitListG result_digitListG result_digitList2G = digitList_parseS input_digitList2G expect_digitList2G = ([1,2,3],0,"|fed") test_digitList2G = mkTestCase "DigitList2G" expect_digitList2G result_digitList2G result_digitListB = digitList_parseS input_digitListB expect_digitListB = ([1],0,",b,3") test_digitListB = mkTestCase "DigitListB" expect_digitListB result_digitListB [pads| type DigitListLen (x::Int) = [Digit] length <|x + 1 |> |] input_digitListLenG = "123456" input_digitListLenB = "12a456" result_digitListLenG = digitListLen_parseS 4 input_digitListLenG expect_digitListLenG = ([1,2,3,4,5],0,"6") test_digitListLenG = mkTestCase "DigitListLenG" expect_digitListLenG result_digitListLenG result_digitListLenB = digitListLen_parseS 4 input_digitListLenB expect_digitListLenB = ([1,2,0,4,5],1 ,"6") test_digitListLenB = mkTestCase "DigitListLenB" expect_digitListLenB result_digitListLenB [pads| type DigitListLenSep (x::Int) = [Digit | "ab" ] length <|x + 1|> |] input_digitListLenSepG = "1ab2ab3ab4ab5ab6ab7ab" input_digitListLenSepB = "1ab2ab3abDab5ab6ab7ab" result_digitListLenSepG = digitListLenSep_parseS 4 input_digitListLenSepG expect_digitListLenSepG = ([1,2,3,4,5],0,"ab6ab7ab") test_digitListLenSepG = mkTestCase "DigitListLenSepG" expect_digitListLenSepG result_digitListLenSepG result_digitListLenSepB = digitListLenSep_parseS 4 input_digitListLenSepB expect_digitListLenSepB = ([1,2,3,0,5],1,"ab6ab7ab") test_digitListLenSepB = mkTestCase "DigitListLenSepB" expect_digitListLenSepB result_digitListLenSepB [pads| type DigitListTerm = [Digit] terminator EOR|] input_digitListTermG = "12345\nhello" result_digitListTermG = digitListTerm_parseS input_digitListTermG expect_digitListTermG = ([1,2,3,4,5],0,"hello") test_digitListTermG = mkTestCase "DigitListTermG" expect_digitListTermG result_digitListTermG input_digitListTermB = "12345,h" result_digitListTermB = digitListTerm_parseS input_digitListTermB expect_digitListTermB = ([1,2,3,4,5,0,0],2,"") test_digitListTermB = mkTestCase "DigitListTermB" expect_digitListTermB result_digitListTermB [pads| type DigitListTermSep = [Digit | '|' ] terminator ';' |] input_digitListTermSepG = "1|2|3|4|5|6;hello" result_digitListTermSepG = digitListTermSep_parseS input_digitListTermSepG expect_digitListTermSepG = ([1,2,3,4,5,6], 0,"hello") test_digitListTermSepG = mkTestCase "digitListTermSepG" expect_digitListTermSepG result_digitListTermSepG input_digitListTermSepB = "1|2|3|4|56;hello" result_digitListTermSepB = digitListTermSep_parseS input_digitListTermSepB expect_digitListTermSepB = ([1,2,3,4,5],1,"hello") test_digitListTermSepB = mkTestCase "digitListTermSepB" expect_digitListTermSepB result_digitListTermSepB [pads| type TryTest = (Try Char, StringFW 3) |] input_tryTest = "abc123" result_tryTest = tryTest_parseS input_tryTest expect_tryTest = (('a',"abc"),0,"123") test_tryTest = mkTestCase "tryTest" expect_tryTest result_tryTest [pads| type TryTestD = (Try Digit, StringFW 3) |] input_tryTestDG = "123abc" result_tryTestDG = tryTestD_parseS input_tryTestDG expect_tryTestDG = ((1,"123"),0,"abc") test_tryTestDG = mkTestCase "tryTestDG" expect_tryTestDG result_tryTestDG -- Note that 'try_parseM' does not return an error when it fails to parse a -- digit (and therefore uses the default value of "0") because a "try" parser -- should fail silently, similar to how the 'try' combinator works in parsec. input_tryTestDB = "abc123" result_tryTestDB = tryTestD_parseS input_tryTestDB expect_tryTestDB = ((0,"abc"),0,"123") test_tryTestDB = mkTestCase "tryTestDB" expect_tryTestDB result_tryTestDB {- ((TryTestD (0,"abc"), (Errors: 1 Encountered a when expecting Digit. at: Line: 0, Offset: 0,(Errors: 1 Encountered a when expecting Digit. at: Line: 0, Offset: 0,Errors: 0))),"123") XXX: we are getting a repeat error message because of change to how errors are propagated. Need to work on cleaning up error reporting. -} [pads| type ListWithTry = ([Char] terminator (Try Digit), Digit) |] input_ListWithTry = "cat123" result_ListWithTry = listWithTry_parseS input_ListWithTry expect_ListWithTry = ((['c', 'a', 't'],1),0,"23") test_ListWithTry = mkTestCase "ListWithTry" expect_ListWithTry result_ListWithTry [pads| type WithVoid = (Char, ',', Void, '|') |] input_WithVoid = "a,|rest" result_WithVoid = withVoid_parseS input_WithVoid expect_WithVoid = ('a',0,"rest") test_WithVoid = mkTestCase "WithVoid" expect_WithVoid result_WithVoid [pads| data VoidOpt = PDigit Digit | Pcolor "red" | Pnothing Void type VoidEntry = (VoidOpt, StringFW 3) |] input_voidEntry1 = "9abcdef" result_voidEntry1 = voidEntry_parseS input_voidEntry1 expect_voidEntry1 = ((PDigit 9,"abc"),0,"def") test_voidEntry1 = mkTestCase "VoidEntry1" expect_voidEntry1 result_voidEntry1 input_voidEntry2 = "redabcdef" result_voidEntry2 = voidEntry_parseS input_voidEntry2 expect_voidEntry2 = ((Pcolor,"abc"),0,"def") test_voidEntry2 = mkTestCase "VoidEntry2" expect_voidEntry2 result_voidEntry2 input_voidEntry3 = "abcdef" result_voidEntry3 = voidEntry_parseS input_voidEntry3 expect_voidEntry3 = ((Pnothing,"abc"),0,"def") test_voidEntry3 = mkTestCase "VoidEntry3" expect_voidEntry3 result_voidEntry3 [pads| data Switch (which :: Int) = case <| which |> of 0 -> Even Int where <| even `mod` 2 == 0 |> | 1 -> Comma ',' | otherwise -> Missing Void |] input_switch0 = "2hello" input_switch1 = ",hello" input_switchOther = "hello" result_switch0 = switch_parseS 0 input_switch0 expect_switch0 = (Even (2),0,"hello") test_switch0 = mkTestCase "switch0" expect_switch0 result_switch0 result_switch1 = switch_parseS 1 input_switch1 expect_switch1 = (Comma,0,"hello") test_switch1 = mkTestCase "switch1" expect_switch1 result_switch1 result_switchOther = switch_parseS 2 input_switchOther expect_switchOther = (Missing,0,"hello") test_switchOther = mkTestCase "switchOther" expect_switchOther result_switchOther result_stringln = stringLn_parseS "hello\ngoodbye" expect_stringln = ("hello",0,"\ngoodbye") test_stringln = mkTestCase "stringln" expect_stringln result_stringln [pads| data MyBody (which::Int) = case <| which |> of 0 -> First Int | 1 -> Second (StringC ',') | otherwise -> Other Void data MyEntry = MyEntry { header :: Int, ',' , body :: MyBody header, ',' , trailer :: Char} type MyData = [Line MyEntry] terminator EOF |] input_myData = "0,23,a\n1,hello,b\n2,,c\n" result_myData = myData_parseS input_myData expect_myData = ([MyEntry {header = 0, body = First (23), trailer = 'a'}, MyEntry {header = 1, body = Second ("hello"), trailer = 'b'}, MyEntry {header = 2, body = Other, trailer = 'c'}],0, "") test_myData = mkTestCase "MyData" expect_myData result_myData [pads| data HP = HP { student_num :: Int, ',', student_name :: StringFW student_num } type HP_data = [Line HP] terminator EOF |] input_hp_data = "8,Hermione\n3,Ron\n5,Harry\n" result_hp_data = hP_data_parseS input_hp_data expect_hp_data = ([HP {student_num = 8, student_name = "Hermione"}, HP {student_num = 3, student_name = "Ron"}, HP {student_num = 5, student_name = "Harry"}], 0, "") test_hp_data = mkTestCase "HP Data" expect_hp_data result_hp_data test_file = "examples/data/test_file" result_hp_data_file_parse :: (HP_data, HP_data_md) = unsafePerformIO $ parseFileWith hP_data_parseM test_file expect_hp_data_file_parse = ( [HP {student_num = 8, student_name = "Hermione"}, HP {student_num = 3, student_name = "Ron"}, HP {student_num = 5, student_name = "Harry"}], 0) test_hp_data_file_parse = mkFileTestCase "HP file" expect_hp_data_file_parse result_hp_data_file_parse strToBS = B.pack . (map chrToWord8) [pads| newtype MyDoc = MyDoc Text |] myDoc_input_file = "examples/data/test_file" myDoc_result :: (MyDoc, MyDoc_md) = unsafePerformIO $ parseFile myDoc_input_file myDoc_expects = (MyDoc (Text (strToBS "8,Hermione\n3,Ron\n5,Harry\n")),0) myDoc_test = mkFileTestCase "myDoc" myDoc_expects myDoc_result acomma = "," [pads| data LitRec = LitRec { fstField :: Int, acomma, sndField :: Int} |] litRec_input = "12,34" litRec_result = litRec_parseS litRec_input litRec_expects = (LitRec {fstField = 12, sndField = 34},0,"") litRec_test = mkTestCase "Haskell identifier literal" litRec_expects litRec_result [pads| type WhiteSpace = (Int, '[ \t]+', Int) |] whiteSpace_input = "12 34" whiteSpace_result = whiteSpace_parseS whiteSpace_input whiteSpace_expects = ((12,34),0,"") whiteSpace_test = mkTestCase "regular expression literal" whiteSpace_expects whiteSpace_result [pads| type WhiteSpace2 = (Int, ws, Int) |] whiteSpace2_input = "12 34" whiteSpace2_result = whiteSpace2_parseS whiteSpace2_input whiteSpace2_expects = ((12,34),0,"") whiteSpace2_test = mkTestCase "Haskell expression regular expression literal" whiteSpace2_expects whiteSpace2_result [pads| type RE_ty = (StringME '[tod]', ws, StringME 'a+') |] rE_ty_input = "t aaaa" rE_ty_result = rE_ty_parseS rE_ty_input rE_ty_expects = (("t","aaaa"),0,"") rE_ty_test = mkTestCase "regular expression abbreviation for StringME" rE_ty_expects rE_ty_result [pads| type Disc = (Int, EOR, Int, EOR, (partition (Int, EOR, Int, EOR) using windows), Int, EOR) |] disc_input = "1\n2\n3\r\n4\r\n5\n" disc_result = disc_parseS disc_input disc_expects = ((1,2,(3,4),5),0,"") disc_test = mkTestCase "multiple record disciplines" disc_expects disc_result [pads| data Exxy a = Exxy {exxy :: Int, aa :: a} type ExxyInt = Exxy Char |] exxy_input = "32635def" exxy_result = exxyInt_parseS exxy_input exxy_expects = (Exxy {exxy = 32635, aa = 'd'},0,"ef") exxy_test = mkTestCase "label overlap" exxy_expects exxy_result [pads| type OneLine = [Char] terminator EOR type Lines = [OneLine] terminator EOF type LinesFW = partition Lines using <| bytes 3 |> |] linesFW_input = "123456789" linesFW_result = linesFW_parseS linesFW_input linesFW_expects = (["123","456","789"],0,"") linesFW_test = mkTestCase "fixed-width record discpline" linesFW_expects linesFW_result [pads| type Strs = [StringSE ws | ws] terminator EOR |] strs_input = "0.700264\n" strs_result = strs_parseS strs_input [pads| data Vals = Vals { vv :: Int, uu = value <| even vv |> :: Bool, ww::Char} |] vals_input = "123x" vals_result = vals_parseS vals_input vals_expects = (Vals {vv=123,uu=False,ww='x'},0,"") vals_test = mkTestCase "values" vals_expects vals_result [pads| data Vals2 = Vals2 { vv2 :: (Int,",",Int), uu2 = value <| fst vv2 `mod` snd vv2 == 0 |> :: Bool, ww2 :: Char} |] vals2_input = "12,3x" vals2_result = vals2_parseS vals2_input vals2_expects = (Vals2 {vv2=(12,3),uu2=True,ww2='x'},0,"") vals2_test = mkTestCase "values" vals2_expects vals2_result {- [pads| data Vals3 a = Vals3 { vv3 :: (Int,",",Int), uu3 = value <| [] |> :: [a], ww3 :: Char} |] vals3_input = "12,3x" vals3_result = vals3_parseS vals3_input vals3_expects = (Vals3 {vv3=(12,3),uu3=[],ww3='x'},0,"") vals3_test = mkTestCase "values" vals3_expects vals3_result -} [pads| type Doubles = [Double | EOR] terminator EOF |] doubles_input = "12.34\n1\n-12.0\n1.3e4\n1.2e-2" doubles_result = doubles_parseS doubles_input doubles_expects = ([12.34,1.0,-12.0,13000.0,1.2e-2],0,"") doubles_test = mkTestCase "doubles" doubles_expects doubles_result [pads| type StringSEs = [StringSE <|RE "$"|> | EOR] terminator EOF |] stringSEs_input = "12.34\n1\n-12.0\n1.3e4\n1.2e-2" stringSEs_result = stringSEs_parseS stringSEs_input stringSEs_expects = (["12.34","1","-12.0","1.3e4","1.2e-2"],0,"") stringSEs_test = mkTestCase "stringSEs" stringSEs_expects stringSEs_result [pads| type StringFWs = [StringFW 3| EOR] terminator EOF |] stringFWs_input = "abc\nabcd\nab\nabc" stringFWs_result = stringFWs_parseS stringFWs_input stringFWs_expects = (["abc","abc","XXX","abc"],2,"") stringFWs_test = mkTestCase "stringFWs" stringFWs_expects stringFWs_result [pads| type StringESCs = [(StringESC <| ('!', ";,") |>, '[;,]') | EOR] terminator EOF |] stringESCs_input = "abc\na;\nb,\na!;bc,\na!,cd\nhe!" stringESCs_result = stringESCs_parseS stringESCs_input stringESCs_expects = (["abc","a","b","a;bc","a,cd","he!"],4, "") stringESCs_test = mkTestCase "stringESCs" stringESCs_expects stringESCs_result [pads| type StringPs = [StringP Char.isDigit | EOR] terminator EOF |] stringPs_input = "123\na\n123a" stringPs_result = stringPs_parseS stringPs_input stringPs_expects = (["123","","123"],2, "") stringPs_test = mkTestCase "stringPs" stringPs_expects stringPs_result {- Bit-level functionality tests -} [pads| type BitBools = (partition [BitBool] using none) |] bitBools_input = "a" -- binary 01100001 bitBools_result = bitBools_parseS bitBools_input bitBools_expects = ([False,True,True,False,False,False,False,True], 0, "") bitBools_test = mkTestCase "bitBools" bitBools_expects bitBools_result bitBools_input2 = "a\n" -- binary 01100001 00001010 bitBools_result2 = bitBools_parseS bitBools_input2 bitBools_expects2 = ([False,True,True,False,False,False,False,True, False,False,False,False,True,False,True,False], 0, "") bitBools_test2 = mkTestCase "bitBools" bitBools_expects2 bitBools_result2 [pads| type IncompleteBitBools = (partition (BitBool, BitBool, BitBool) using none) |] incompleteBitBools_input = "4" incompleteBitBools_result = incompleteBitBools_parseS incompleteBitBools_input incompleteBitBools_expects = ((False,False,True), 0, "4") incompleteBitBools_test = mkTestCase "incompleteBitBools" incompleteBitBools_expects incompleteBitBools_result [pads| type ArithPixel = (partition (Bits16 9, Bits8 5, Bits8 5, Bits8 5, Bits8 4, Bits8 4) using none) |] arithPixel_input = map word8ToChr [136,114,32,0] arithPixel_result = arithPixel_parseS arithPixel_input arithPixel_expects = ((272,28,17,0,0,0), 0, "") arithPixel_test = mkTestCase "arithPixel" arithPixel_expects arithPixel_result [pads| type Mixed = (partition (StringC ' ', ' ', Bits8 4, BitBool, Bits8 3, Char) using none) |] mixed_input = "Hello " ++ (map word8ToChr [74]) ++ "c" mixed_result = mixed_parseS mixed_input mixed_expects = (("Hello",4,True,2,'c'), 0, "") mixed_test = mkTestCase "mixed" mixed_expects mixed_result [pads| type OddWidths = (partition (Bits32 19, Bits64 39, Bits8 1, Bits8 5) using none) |] oddWidths_input = map word8ToChr [104,46,174,3,185,8,6,158] oddWidths_result = oddWidths_parseS oddWidths_input oddWidths_expects = ((213365,240768000026,0,30), 0, "") oddWidths_test = mkTestCase "oddWidths" oddWidths_expects oddWidths_result [pads| type LargeWidths = (partition (Bits8 7, BitField 89, BitField 65) using none) |] largeWidths_input = map word8ToChr [1,0,0,0,0,0,0,0,0,0,0,1,128,0,0,0,0,0,0,0,128] largeWidths_result = largeWidths_parseS largeWidths_input largeWidths_expects = ((0,309485009821345068724781057,18446744073709551617), 0, map word8ToChr [128]) largeWidths_test = mkTestCase "largeWidths" largeWidths_expects largeWidths_result [pads| data EnumType (x :: Bits8) = case x of 0 -> ZERO {} | 1 -> ONE {} | 2 -> TWO {} | _ -> OTHER {} data Enumerate = Enumerate {x :: Bits8 3, Bits8 5, y :: EnumType x} type Enumerated = (partition Enumerate using none) |] enumerated_input = map word8ToChr [64] enumerated_result = enumerated_parseS enumerated_input enumerated_expects = (Enumerate {x = 2, y = TWO}, 0, "") enumerated_test = mkTestCase "Enumerated" enumerated_expects enumerated_result enumerated_input_wc = map word8ToChr [255] enumerated_result_wc = enumerated_parseS enumerated_input_wc enumerated_expects_wc = (Enumerate {x = 7, y = OTHER}, 0, "") enumerated_test_wc = mkTestCase "EnumeratedWC" enumerated_expects_wc enumerated_result_wc [pads| data EnumTypeBool (x' :: BitBool) = case x' of True -> ON {} | False -> OFF {} data EnumerateBool = EnumerateBool {Bits8 7, x' :: BitBool, y' :: EnumTypeBool x'} type EnumeratedBool = (partition EnumerateBool using none) |] enumeratedBool_input = map word8ToChr [1] enumeratedBool_result = enumeratedBool_parseS enumeratedBool_input enumeratedBool_expects = (EnumerateBool {x' = True, y' = ON}, 0, "") enumeratedBool_test = mkTestCase "EnumeratedBool" enumeratedBool_expects enumeratedBool_result [pads| type NBA_char = (partition (Bits8 3, CharNB, Bits8 5) using none) |] nBA_char_input = map word8ToChr [70,181] -- 01000110 10110101 nBA_char_result = nBA_char_parseS nBA_char_input nBA_char_expects = ((2,'5',21), 0, "") -- 010 00110101 10101 nBA_char_test = mkTestCase "NBA_char" nBA_char_expects nBA_char_result [pads| type NBA_char_aligned = (partition (CharNB, CharNB) using none)|] nBA_char_aligned_input = map word8ToChr [70,181] nBA_char_aligned_result = nBA_char_aligned_parseS nBA_char_aligned_input nBA_char_aligned_expects = ((word8ToChr 70, word8ToChr 181), 0, "") nBA_char_aligned_test = mkTestCase "NBA_char_aligned" nBA_char_aligned_expects nBA_char_aligned_result [pads| type NBA_BS = (partition (Bits8 6, BytesNB 2, Bits8 2) using none) |] nBA_BS_input = map word8ToChr [99,234,3] -- 01100011 11101010 0000011 nBA_BS_result = nBA_BS_parseS nBA_BS_input nBA_BS_expects = ((24, B.pack [250,128], 3), 0, "") nBA_BS_test = mkTestCase "NBA_BS" nBA_BS_expects nBA_BS_result [pads| type NBA_BS_aligned = (partition (BytesNB 4) using none) |] nBA_BS_aligned_input = map word8ToChr [9,8,7,255] nBA_BS_aligned_result = nBA_BS_aligned_parseS nBA_BS_aligned_input nBA_BS_aligned_expects = ((B.pack [9,8,7,255]), 0, "") nBA_BS_aligned_test = mkTestCase "NBA_BS_aligned" nBA_BS_aligned_expects nBA_BS_aligned_result [pads| type NBA_BS_empty = (partition (BytesNB 1) using none) |] nBA_BS_empty_input = "" nBA_BS_empty_result = nBA_BS_empty_parseS nBA_BS_empty_input nBA_BS_empty_expects = ((B.singleton 0), 1, "") nBA_BS_empty_test = mkTestCase "NBA_BS_empty" nBA_BS_empty_expects nBA_BS_empty_result [pads| type NBA_StringFW = (partition (Bits8 4, StringFWNB 3, Bits8 4) using none) |] nBA_StringFW_input = map word8ToChr [134,22,38,63] --1000 0110 0001 0110 0010 0110 0011 1111 nBA_StringFW_result = nBA_StringFW_parseS nBA_StringFW_input nBA_StringFW_expects = ((8,"abc",15),0,"") nBA_StringFW_test = mkTestCase "NBA_StringFW" nBA_StringFW_expects nBA_StringFW_result [pads| type NBA_StringFW_aligned = (partition (StringFWNB 15) using none) |] nBA_StringFW_aligned_input = map word8ToChr (replicate 15 97) nBA_StringFW_aligned_result = nBA_StringFW_aligned_parseS nBA_StringFW_aligned_input nBA_StringFW_aligned_expects = (("aaaaaaaaaaaaaaa"),0,"") nBA_StringFW_aligned_test = mkTestCase "NBA_StringFW_aligned" nBA_StringFW_aligned_expects nBA_StringFW_aligned_result [pads| type NBA_StringFW_err = (partition (StringFWNB 3) using none) |] nBA_StringFW_err_input = map word8ToChr [99,99] nBA_StringFW_err_result = nBA_StringFW_err_parseS nBA_StringFW_err_input nBA_StringFW_err_expects = (("XXX"),1,"") nBA_StringFW_err_test = mkTestCase "NBA_StringFW_err" nBA_StringFW_err_expects nBA_StringFW_err_result [pads| type NBA_StringC = (partition (Bits8 2, StringCNB 'z', CharNB, Bits8 6) using none) |] nBA_StringC_input = map word8ToChr [158,30,94,149] -- 10 011110 00 011110 01 011110 10 010101 nBA_StringC_result = nBA_StringC_parseS nBA_StringC_input nBA_StringC_expects = ((2,"xy",'z',21),0,"") nBA_StringC_test = mkTestCase "NBA_StringC" nBA_StringC_expects nBA_StringC_result [pads| type NBA_StringC_aligned = (partition (StringCNB 'z') using none) |] nBA_StringC_aligned_input = "xyz" nBA_StringC_aligned_result = nBA_StringC_aligned_parseS nBA_StringC_aligned_input nBA_StringC_aligned_expects = (("xy"),0,"z") nBA_StringC_aligned_test = mkTestCase "NBA_StringC_aligned" nBA_StringC_aligned_expects nBA_StringC_aligned_result $(make_pads_declarations $ map snd padsExp) padsExp_ast = [ ("Halloween", PadsDeclType "Halloween" [] Nothing ( PList (PApp [PTycon ["StringFW"]] (Just (LitE (IntegerL 4)))) (Just (PTycon ["EOR"])) (Just (LTerm (PTycon ["EOF"])))) Nothing)] padsExp_input = "karl\njred\nmatt\nsam_" padsExp_result = halloween_parseS padsExp_input padsExp_expects = (["karl", "jred", "matt", "sam_"], 0, "") padsExp_test = TestCase (assertEqual "padsExp" padsExp padsExp_ast) -- mkTestCase "padsExp" padsExp padsExp_ast padsExp_test2 = mkTestCase "padsExp" padsExp_expects padsExp_result -- | Regression tests need to be run from the root directory of the pads-haskell -- package because the data file paths in these test cases use paths relative to -- the root. test = runTestTT (TestList tests) tests = [ TestLabel "MyChar" myChar_test , TestLabel "IntPair" intPair_test , TestLabel "Bar" bar_test , TestLabel "Bar2" bar2_test , TestLabel "Bazr" bazr_test , TestLabel "MyInt" myInt_test , TestLabel "StrTy" strTy_test , TestLabel "StrTy1" strTy1_test , TestLabel "Baz" baz_test , TestLabel "Phex32FW" phex32FW_test , TestLabel "IntRange" test_intRange24 , TestLabel "IntRange" test_intRange0 , TestLabel "IntRange" test_intRange256 , TestLabel "IntRange" test_intRangeLow , TestLabel "IntRange" test_intRangeHigh , TestLabel "IntRange" test_intRangeBad , TestLabel "IntRangeP" test_intRangeP24 , TestLabel "IntRangeP" test_intRangeP0 , TestLabel "IntRangeP" test_intRangeP256 , TestLabel "IntRangeP" test_intRangePLow , TestLabel "IntRangeP" test_intRangePHigh , TestLabel "IntRangeP" test_intRangePBad , TestLabel "Record" test_Record , TestLabel "Id" test_IdInt , TestLabel "Id" test_IdStr , TestLabel "Id" test_IdInt2 , TestLabel "Id" test_IdStr2 , TestLabel "Id3" test_IdInt3 , TestLabel "Id3" test_IdLit3 , TestLabel "Ab_or_a" test_Ab_or_a , TestLabel "AB_test" test_AB_test1 , TestLabel "AB_test" test_AB_test2 , TestLabel "Method" test_method_get , TestLabel "Method" test_method_put , TestLabel "Method" test_method_link , TestLabel "Method" test_method_post , TestLabel "Version" test_version , TestLabel "Request" test_request_G , TestLabel "Request" test_request_B , TestLabel "Eor" test_eor_test , TestLabel "Eof" test_eof_test_G , TestLabel "Eof" test_eof_test_B , TestLabel "Opt" test_opt_test_j , TestLabel "Opt" test_opt_test_n , TestLabel "List" test_entries_nosep_noterm , TestLabel "List" test_entries_nosep_noterm' , TestLabel "List" test_entries_nosep_noterm2 , TestLabel "List" test_evenInt , TestLabel "List" test_evenInts , TestLabel "List" test_digitListG , TestLabel "List" test_digitList2G , TestLabel "List" test_digitListB , TestLabel "List" test_digitListLenG , TestLabel "List" test_digitListLenB , TestLabel "List" test_digitListLenSepG , TestLabel "List" test_digitListLenSepB , TestLabel "List" test_digitListTermG , TestLabel "List" test_digitListTermB , TestLabel "List" test_digitListTermSepG , TestLabel "List" test_digitListTermSepB , TestLabel "Try" test_tryTest , TestLabel "Try" test_tryTestDG , TestLabel "Try" test_tryTestDB , TestLabel "Try" test_ListWithTry , TestLabel "Void" test_WithVoid , TestLabel "Void" test_voidEntry1 , TestLabel "Void" test_voidEntry2 , TestLabel "Void" test_voidEntry3 , TestLabel "Switch" test_switch0 , TestLabel "Switch" test_switch1 , TestLabel "Switch" test_switchOther , TestLabel "Stringln" test_stringln , TestLabel "Compound" test_myData , TestLabel "Compound" test_hp_data , TestLabel "Doc" test_hp_data_file_parse , TestLabel "Doc" myDoc_test , TestLabel "Literal" litRec_test , TestLabel "Literal" whiteSpace_test , TestLabel "Literal" whiteSpace2_test , TestLabel "Regular Expression" rE_ty_test , TestLabel "Discipline" disc_test , TestLabel "Overlap" exxy_test , TestLabel "Discipline" linesFW_test , TestLabel "Values" vals_test , TestLabel "Values" vals2_test , TestLabel "Double" doubles_test , TestLabel "StringSE" stringSEs_test , TestLabel "StringFWs" stringFWs_test , TestLabel "StringESCs" stringESCs_test , TestLabel "StringPs" stringPs_test , TestLabel "PadsExp" padsExp_test , TestLabel "PadsExp2" padsExp_test2 , TestLabel "BitBools" bitBools_test , TestLabel "BitBools" bitBools_test2 , TestLabel "ArithPixel" arithPixel_test , TestLabel "IncompleteBitBools" incompleteBitBools_test , TestLabel "Mixed" mixed_test , TestLabel "OddWidths" oddWidths_test , TestLabel "LargeWidths" largeWidths_test , TestLabel "Enumerated" enumerated_test , TestLabel "EnumeratedWC" enumerated_test_wc , TestLabel "EnumeratedBool" enumeratedBool_test , TestLabel "NBA_char" nBA_char_test , TestLabel "NBA_char_aligned" nBA_char_aligned_test , TestLabel "NBA_BS" nBA_BS_test , TestLabel "NBA_BS_aligned" nBA_BS_aligned_test , TestLabel "NBA_BS_empty" nBA_BS_empty_test , TestLabel "NBA_StringFW" nBA_StringFW_test , TestLabel "NBA_StringFW_aligned" nBA_StringFW_aligned_test , TestLabel "NBA_StringFW_err" nBA_StringFW_err_test , TestLabel "NBA_StringC" nBA_StringC_test , TestLabel "NBA_StringC_aligned" nBA_StringC_aligned_test ]