with Ada.Strings.Unbounded, Ada.Strings.Maps; package body Preferences is package S renames Ada.Strings; package SU renames Ada.Strings.Unbounded; package SM renames Ada.Strings.Maps; generic type Range_Type is range <>; type Array_Type is array (Range_Type) of Natural; procedure Index_And_Count (Input : in Array_Type; Value : in Natural; Index : out Range_Type; Count : out Natural); procedure Index_And_Count (Input : in Array_Type; Value : in Natural; Index : out Range_Type; Count : out Natural) is begin Count := 0; for I in Range_Type loop if Input (I) = Value then Index := I; Count := Count + 1; end if; end loop; end Index_And_Count; -- Looks at the raw ranking list above the line and the Above_Ballot and -- turns it into a list of CandidateIDs in the order they were ranked. function Extract_Formal (Above_Input : in Above_Pref_Array; Formal_Prefs : out Preference_Array) return Boolean is procedure Above_IC is new Index_And_Count (Above_Range, Above_Pref_Array); Extracted : Natural := 0; Working_Index : Above_Range; Working_Count : Natural; Formal_Index : Preference_Range := Preference_Range'First; begin Formal_Prefs := (others => Candidates.No_Candidate); Pref_Loop : for I in Above_Range loop Above_IC (Above_Input, Integer (I), Working_Index, Working_Count); exit Pref_Loop when Working_Count /= 1; Extracted := Extracted + 1; for C of Above_Ballot.Element (Integer (Working_Index)) loop exit Pref_Loop when Formal_Index > Preference_Range'Last; Formal_Prefs (Formal_Index) := C; Formal_Index := Formal_Index + 1; end loop; end loop Pref_Loop; return Extracted >= Min_Above_Line; end Extract_Formal; -- Looks at the raw ranking list below the line and the Below_Ballot and -- turns it into a list of CandidateIDs in the order they were ranked. function Extract_Formal (Below_Input : in Below_Pref_Array; Formal_Prefs : out Preference_Array) return Boolean is procedure Below_IC is new Index_And_Count (Below_Range, Below_Pref_Array); Extracted : Natural := 0; Working_Index : Below_Range; Working_Count : Natural; Formal_Index : Preference_Range := Preference_Range'First; begin Formal_Prefs := (others => Candidates.No_Candidate); if Formal_Index > Preference_Range'Last then return Extracted >= Min_Below_Line; end if; for I in Below_Range loop Below_IC (Below_Input, Integer (I), Working_Index, Working_Count); exit when Working_Count /= 1; Formal_Prefs (Formal_Index) := Below_Ballot.Element (Integer (Working_Index)); Extracted := Extracted + 1; exit when Formal_Index = Preference_Range'Last; Formal_Index := Formal_Index + 1; end loop; return Extracted >= Min_Below_Line; end Extract_Formal; function Mark (Input : in SU.Unbounded_String; Output : out Natural; Remaining : out SU.Unbounded_String) return Boolean is begin if SU.Length (Input) > 0 and then (SU.Element (Input, 1) = '/' or else SU.Element (Input, 1) = '*') then Output := 1; Remaining := SU.Tail (Input, SU.Length (Input) - 1); return True; else return False; end if; end Mark; function Number (Input : in SU.Unbounded_String; Output : out Natural; Remaining : out SU.Unbounded_String) return Boolean is First, Last : Natural; begin SU.Find_Token (Input, SM.To_Set ("1234567890"), S.Inside, First, Last); if First = 1 and Last > 0 then Output := Integer'Value (SU.Slice (Input, First, Last)); Remaining := SU.Unbounded_Slice (Input, Last + 1, SU.Length (Input)); return True; else return False; end if; end Number; function Comma (Input : in SU.Unbounded_String; Remaining : out SU.Unbounded_String) return Boolean is begin if SU.Length (Input) > 0 and then SU.Element (Input, 1) = ',' then Remaining := SU.Tail (Input, SU.Length (Input) - 1); return True; else return False; end if; end Comma; generic type Range_Type is range <>; type Array_Type is array (Range_Type) of Natural; function Raw_Prefs (Input : in SU.Unbounded_String; Output : out Array_Type; Remaining : out SU.Unbounded_String) return Boolean; function Raw_Prefs (Input : in SU.Unbounded_String; Output : out Array_Type; Remaining : out SU.Unbounded_String) return Boolean is Working_Num : Natural; Index : Range_Type := Range_Type'First; This_In, This_Remaining : SU.Unbounded_String; begin Output := (others => 0); if Index > Range_Type'Last then Remaining := Input; return True; end if; This_In := Input; loop if Number (This_In, Working_Num, This_Remaining) or else Mark (This_In, Working_Num, This_Remaining) then Output (Index) := Working_Num; else This_Remaining := This_In; end if; exit when Index = Range_Type'Last; Index := Index + 1; if not Comma (This_Remaining, This_In) then return False; end if; end loop; Remaining := This_Remaining; return True; end Raw_Prefs; procedure Optional_Line_Ending (Input : in SU.Unbounded_String; Remaining : out SU.Unbounded_String) is begin if SU.Length (Input) > 1 and then SU.Slice (Input, 1, 2) = Character'Val (13) & Character'Val (10) then Remaining := SU.Tail (Input, SU.Length (Input) - 2); elsif SU.Length (Input) > 0 and then (SU.Element (Input, 1) = Character'Val (13) or else SU.Element (Input, 1) = Character'Val (10)) then Remaining := SU.Tail (Input, SU.Length (Input) - 1); else Remaining := Input; end if; end Optional_Line_Ending; function Parse_Preferences (Input : in String) return Preference_Array is use type SU.Unbounded_String; Above_Line : Above_Pref_Array; Below_Line : Below_Pref_Array; function Parse_Above_Line is new Raw_Prefs (Above_Range, Above_Pref_Array); function Parse_Below_Line is new Raw_Prefs (Below_Range, Below_Pref_Array); Result : Preference_Array; This_In, This_Remaining : SU.Unbounded_String; begin This_In := SU.To_Unbounded_String (Input); if not Parse_Above_Line (This_In, Above_Line, This_Remaining) or else not Comma (This_Remaining, This_In) or else not Parse_Below_Line (This_In, Below_Line, This_Remaining) then return Empty_Array; end if; Optional_Line_Ending (This_Remaining, This_In); if SU.Length (This_In) > 0 or else (not Extract_Formal (Below_Line, Result) and then not Extract_Formal (Above_Line, Result)) then return Empty_Array; end if; return Result; end Parse_Preferences; end Preferences;