add support for brackets in group composer

assets/elm/Helpers.elm

@@ -2,116 +2,29 @@ module Helpers exposing (..)
 
 import ApostelloModels exposing (..)
 import Dict
-import List.Extra exposing (uncons)
-import Models exposing (..)
-import Regex exposing (..)
 import Set exposing (Set)
+import Array
+import Parser exposing (..)
 
 
 -- Run the query to produce new group
 
 
-runQuery : Model -> ( People, List Int )
-runQuery model =
+runQuery : Groups -> People -> String -> ( People, List GroupPk )
+runQuery groups people queryString =
     let
-        query =
-            model.query
-                |> Maybe.withDefault ""
-                |> buildQuery
+        selectedGroups =
+            selectGroups queryString
 
         peoplePks =
-            getPeoplePks model.groups query Set.empty
+            parseQueryString groups queryString
+                |> applyQuery Set.empty
 
-        people =
-            model.people
-                |> List.filter (\p -> Set.member p.pk peoplePks)
-    in
-        ( people, query.groupPks )
-
-
-buildQuery : String -> Query
-buildQuery query =
-    let
-        queryString =
-            query
-                |> String.append "|"
-    in
-        { groupPks =
-            queryString
-                |> find All (regex "\\d+")
-                |> List.map .match
-                |> List.map String.toInt
-                |> List.map (Result.withDefault 0)
-        , ops =
-            queryString
-                |> find All (regex "-|\\+|\\|")
-                |> List.map .match
-                |> List.map string2Op
-        }
-
-
-getPeoplePks : Groups -> Query -> Set Int -> Set Int
-getPeoplePks groups query people =
-    if List.isEmpty query.groupPks then
-        -- we are done, spit out final set
-        people
-    else
-        let
-            ( op, ops ) =
-                uncons query.ops
-                    |> Maybe.withDefault ( NoOp, [] )
-
-            ( pk, pks ) =
-                uncons query.groupPks
-                    |> Maybe.withDefault ( 0, [] )
-        in
+        result =
             people
-                |> applyOperator groups pk op
-                |> getPeoplePks groups { groupPks = pks, ops = ops }
-
-
-applyOperator : Groups -> Int -> SetOp -> Set Int -> Set Int
-applyOperator groups pk op people =
-    let
-        group =
-            groups
-                |> List.filter (\x -> x.pk == pk)
-                |> List.head
-                |> Maybe.withDefault nullGroup
-
-        members =
-            group.members
-                |> List.map .pk
-                |> Set.fromList
+                |> List.filter (\p -> Set.member p.pk peoplePks)
     in
-        case op of
-            Union ->
-                Set.union people members
-
-            Intersect ->
-                Set.intersect people members
-
-            Diff ->
-                Set.diff people members
-
-            NoOp ->
-                people
-
-
-string2Op : String -> SetOp
-string2Op string =
-    case string of
-        "+" ->
-            Intersect
-
-        "-" ->
-            Diff
-
-        "|" ->
-            Union
-
-        _ ->
-            NoOp
+        ( result, selectedGroups )
 
 
 

assets/elm/Models.elm

@@ -2,6 +2,7 @@ module Models exposing (..)
 
 import ApostelloModels exposing (..)
 import Json.Decode as Decode
+import Set exposing (Set)
 
 
 type alias Model =
@@ -27,14 +28,21 @@ type LoadingStatus
     | LoadingFailed
 
 
-type SetOp
+type QueryOp
     = Union
     | Intersect
     | Diff
+    | OpenBracket
+    | CloseBracket
+    | G (Set Int)
     | NoOp
 
 
 type alias Query =
-    { groupPks : List GroupPk
-    , ops : List SetOp
+    List QueryOp
+
+
+type alias ParenLoc =
+    { open : Maybe Int
+    , close : Maybe Int
     }

assets/elm/Parser.elm

@@ -0,0 +1,238 @@
+module Parser exposing (..)
+
+import ApostelloModels exposing (..)
+import Array
+import Dict
+import List.Extra exposing (uncons, findIndices)
+import Models exposing (..)
+import Regex exposing (..)
+import Set exposing (Set)
+
+
+applyQuery : Set Int -> Query -> Set Int
+applyQuery pks q =
+    case handleBrackets q of
+        first :: second :: rest ->
+            applyOperator first second pks
+                |> ((flip applyQuery) rest)
+
+        _ :: [] ->
+            pks
+
+        [] ->
+            pks
+
+
+applyOperator : QueryOp -> QueryOp -> Set Int -> Set Int
+applyOperator opL opR existingPeople =
+    let
+        newPeople =
+            case opR of
+                G members ->
+                    members
+
+                _ ->
+                    Set.empty
+    in
+        case opL of
+            Union ->
+                Set.union existingPeople newPeople
+
+            Intersect ->
+                Set.intersect existingPeople newPeople
+
+            Diff ->
+                Set.diff existingPeople newPeople
+
+            _ ->
+                existingPeople
+
+
+handleBrackets : Query -> Query
+handleBrackets query =
+    let
+        maxLength =
+            (List.length query)
+
+        pairs =
+            parenPairs maxLength query 0 0 []
+    in
+        if evenPairs pairs then
+            case pairs of
+                p1 :: pRest ->
+                    replaceExpr query p1
+                        |> handleBrackets
+
+                [] ->
+                    query
+        else
+            query
+
+
+evenPairs : List ParenLoc -> Bool
+evenPairs locs =
+    List.all (\x -> (not (isNothing x.close))) locs
+
+
+replaceExpr : Query -> ParenLoc -> Query
+replaceExpr query pLoc =
+    let
+        left =
+            Maybe.withDefault 0 pLoc.open
+
+        right =
+            Maybe.withDefault 0 pLoc.close
+
+        newExpr =
+            query
+                |> Array.fromList
+                |> Array.slice (left + 1) right
+                |> Array.toList
+                |> (++) [ Union ]
+                |> applyQuery Set.empty
+                |> G
+    in
+        replaceOp left right newExpr query
+
+
+replaceOp : Int -> Int -> QueryOp -> Query -> Query
+replaceOp left right op query =
+    let
+        ar =
+            Array.fromList query
+
+        lhs =
+            Array.slice 0 left ar
+                |> Array.toList
+
+        rhs =
+            Array.slice (right + 1) (Array.length ar) ar
+                |> Array.toList
+    in
+        lhs ++ [ op ] ++ rhs
+
+
+parenPairs : Int -> Query -> Int -> Int -> List ParenLoc -> List ParenLoc
+parenPairs maxL query i depth res =
+    let
+        nextI =
+            i + 1
+    in
+        if i > maxL then
+            res
+        else
+            case query of
+                OpenBracket :: rest ->
+                    parenPairs maxL rest nextI (depth + 1) (List.append res [ ParenLoc (Just i) Nothing ])
+
+                CloseBracket :: rest ->
+                    parenPairs maxL rest nextI (depth - 1) (replaceLastNothing res i)
+
+                _ :: rest ->
+                    parenPairs maxL rest nextI depth res
+
+                [] ->
+                    res
+
+
+replaceLastNothing : List ParenLoc -> Int -> List ParenLoc
+replaceLastNothing res bracketIndex =
+    let
+        resIndex =
+            res
+                |> findIndices (\x -> isNothing x.close)
+                |> List.maximum
+    in
+        res
+            |> List.indexedMap (updateMatchedLoc bracketIndex resIndex)
+
+
+updateMatchedLoc : Int -> Maybe Int -> Int -> ParenLoc -> ParenLoc
+updateMatchedLoc bracketIndex nothingIndex mapIndex t =
+    case nothingIndex of
+        Just i ->
+            if (i == mapIndex) then
+                { t | close = Just bracketIndex }
+            else
+                t
+
+        Nothing ->
+            t
+
+
+parseQueryString : Groups -> String -> Query
+parseQueryString groups queryString =
+    "|"
+        ++ queryString
+        |> find All (regex "\\d+|\\(|\\)|-|\\+|\\|")
+        |> List.map .match
+        |> List.map (parseOp groups)
+
+
+selectGroups : String -> List Int
+selectGroups queryString =
+    queryString
+        |> find All (regex "\\d+")
+        |> List.map .match
+        |> List.map String.toInt
+        |> List.map (Result.withDefault 0)
+
+
+parseOp : Groups -> String -> QueryOp
+parseOp groups string =
+    case string of
+        "+" ->
+            Intersect
+
+        "-" ->
+            Diff
+
+        "|" ->
+            Union
+
+        "(" ->
+            OpenBracket
+
+        ")" ->
+            CloseBracket
+
+        _ ->
+            decodeGroup groups string
+
+
+decodeGroup : Groups -> String -> QueryOp
+decodeGroup groups s =
+    let
+        res =
+            String.toInt s
+    in
+        case res of
+            Ok num ->
+                G (getMembers groups num)
+
+            Err _ ->
+                NoOp
+
+
+getMembers : Groups -> GroupPk -> Set Int
+getMembers groups gPk =
+    let
+        group =
+            groups
+                |> List.filter (\x -> x.pk == gPk)
+                |> List.head
+                |> Maybe.withDefault nullGroup
+    in
+        group.members
+            |> List.map .pk
+            |> Set.fromList
+
+
+isNothing : Maybe a -> Bool
+isNothing x =
+    case x of
+        Just _ ->
+            False
+
+        Nothing ->
+            True