A binding for ElmTextSearch and Pylon.DB.Group.
A document filter.
FilterFeedback for a filter containing results. These will be matched to the current state by sequence number, so old search results will not overwrite a newer query.
Represents the getters for a document type used by a filter.
Create a new filter from a document description.
Set a new query string.
Set a new query conditionally.
Get the latest filter query.
Get the current filter results.
Get the latest filter results.
Synchronize the document store with the contents of a DB group.
Synchronize the document store with the contents of a DB group.
Handle a filter result. This may update the latest field to reflect the latest results continuously, even if the sequence numbers do not match. If they do, the existing filter will be entirely replaced by the result one since the index cannot have changed since then.
Filter synchronously. The results are immediately available in the resulting Filter.
Filter asynchronously with a forwarding address.
Filter asynchronously. When executed, the resulting task will send update(s) to the provided filter feedback address.
{--
Copyright (c) 2016, William Whitacre
All rights reserved.
Redistribution and use in source and binary forms, with or without modification, are permitted
provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice, this list of conditions
and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions
and the following disclaimer in the documentation and/or other materials provided with the
distribution.
3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse
or promote products derived from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF
THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--}
module Pylon.DB.Filter
( Filter
, FilterFeedback
, Document
, filter
, filterQuery
, filterQueryIf
, getFilterQuery
, getFilterResults
, getLastFilterResults
, filterMirror
, filterMirror'
, filterInputOne
, filterSync
, filterAsyncAs
, filterAsync
) where
{-| A binding for ElmTextSearch and Pylon.DB.Group.
# Types
@docs Filter, FilterFeedback, Document
# Construction
@docs filter
# Query
@docs filterQuery, filterQueryIf
# Getters
@docs getFilterQuery, getFilterResults, getLastFilterResults
# Group Mirroring
@docs filterMirror, filterMirror'
# Update
@docs filterInputOne
# Dispatch
@docs filterSync, filterAsyncAs, filterAsync
-}
import Pylon.App as App
import Pylon.DB as DB
import Pylon.DB.Group as DB
import Pylon.DB.Mirror as Mirror exposing (Mirror)
import Pylon.Resource as Resource exposing (Resource)
import Dict exposing (Dict)
import Task exposing (Task, andThen, onError)
import ElmTextSearch
type alias FilterState_ doctype =
{ resultRefs : Dict String doctype
, resultRefs_ : Dict String doctype
, index : ElmTextSearch.Index doctype
, index_ : ElmTextSearch.Index doctype
, query : (String, String)
, results : Resource String (List (doctype, Float))
, latest : (Int, List (doctype, Float))
, indexChanged : Bool
, sequenceNo : Int
}
{-| A document filter. -}
type Filter doctype =
FilterState
(Document doctype)
(FilterState_ doctype)
{-| FilterFeedback for a filter containing results. These will be matched to the current state by
sequence number, so old search results will not overwrite a newer query. -}
type FilterFeedback doctype =
SearchComplete (Filter doctype)
{-| Represents the getters for a document type used by a filter. -}
type alias Document doctype =
{ ref : doctype -> String
, fields : List (doctype -> String, Float)
}
innerConfig__ : Document doctype -> ElmTextSearch.SimpleConfig doctype
innerConfig__ config =
{ ref = config.ref
, fields = config.fields
}
newState__ : Document doctype -> FilterState_ doctype
newState__ config =
let
index = ElmTextSearch.new (innerConfig__ config)
in
{ resultRefs = Dict.empty
, resultRefs_ = Dict.empty
, index = index
, index_ = index
, query = ("", "")
, results = Resource.void
, latest = (-1, [])
, indexChanged = False
, sequenceNo = 0
}
{-| Create a new filter from a document description. -}
filter : Document doctype -> Filter doctype
filter config =
FilterState config (newState__ config)
{-| Set a new query string. -}
filterQuery : String -> Filter doctype -> Filter doctype
filterQuery query (FilterState filterConfig priorState as priorShell) =
if query /= snd priorState.query then
FilterState filterConfig { priorState | query = (fst priorState.query, query) }
else
priorShell
{-| Set a new query conditionally. -}
filterQueryIf : (String -> Bool) -> String -> Filter doctype -> Filter doctype
filterQueryIf validator query =
if validator query then filterQuery query else identity
{-| Get the latest filter query. -}
getFilterQuery : Filter doctype -> String
getFilterQuery (FilterState filterConfig priorState) =
snd priorState.query
{-| Get the current filter results. -}
getFilterResults : Filter doctype -> Resource String (List (doctype, Float))
getFilterResults (FilterState filterConfig priorState) =
priorState.results
{-| Get the latest filter results. -}
getLastFilterResults : Filter doctype -> Maybe (List (doctype, Float))
getLastFilterResults (FilterState filterConfig priorState) =
let
(seqNo, list) = priorState.latest
in
if seqNo > -1 then Just list else Nothing
{-| Synchronize the document store with the contents of a mirror. -}
filterMirror' : (String -> rectype -> doctype) -> Mirror rectype -> Filter doctype -> Filter doctype
filterMirror' mirror source (FilterState filterConfig priorState as priorShell) =
let
toDoc key dat whc = Resource.therefore (mirror key) (whc dat)
docPair key dat = toDoc key dat |> \f -> (f fst, f snd)
in
Dict.foldr
(\key -> flip (List.foldr (docPair key >> filterDelta__ key)))
priorShell
(Mirror.deltas source)
{-| Synchronize the document store with the contents of a DB group. -}
filterMirror : (String -> rectype -> doctype) -> DB.Group (DB.Data rectype) -> Filter doctype -> Filter doctype
filterMirror mirror group (FilterState filterConfig priorState as priorShell) =
let
toDoc key dat whc = Resource.therefore (mirror key) (whc dat)
docPair key dat = toDoc key dat |> \f -> (f fst, f snd)
in
DB.groupDataResDeltaFoldR
(\key -> docPair key >> filterDelta__ key)
priorShell
group
{-| Handle a filter result. This may update the latest field to reflect the latest results
continuously, even if the sequence numbers do not match. If they do, the existing filter will be
entirely replaced by the result one since the index cannot have changed since then. -}
filterInputOne : FilterFeedback doctype -> Filter doctype -> Filter doctype
filterInputOne (SearchComplete (FilterState _ s' as gs')) (FilterState config s as gs) =
if s'.sequenceNo == s.sequenceNo then
gs'
else if s'.sequenceNo < s.sequenceNo && fst s'.latest > fst s.latest then
FilterState config { s | latest = s'.latest }
else
gs
filterRunStage__ : Filter doctype -> (Filter doctype, Maybe (() -> Filter doctype))
filterRunStage__ (FilterState config priorState as priorShell) =
let
currentQuery =
snd priorState.query
changedQuery =
fst priorState.query /= currentQuery
changedWorkingSet =
priorState.indexChanged
changedIfWork bw s' =
if bw then
{ s'
| index = priorState.index_
, resultRefs = priorState.resultRefs_
, indexChanged = False
} else s'
changedIfQuery bq s' =
if bq then { s' | query = (currentQuery, currentQuery) } else s'
updateSequence bu s' =
if bu then { s' | sequenceNo = 1 + s'.sequenceNo, results = Resource.pending } else s'
intermediate chwork chquery =
changedIfWork chwork
>> changedIfQuery chquery
>> updateSequence (chquery || chwork)
requiresAction =
changedQuery || changedWorkingSet
in
if requiresAction then
let
filterResultOf (key, rank) =
Dict.get key im.resultRefs
|> Maybe.map (\doc -> (doc, rank))
im = intermediate changedWorkingSet changedQuery priorState
computeResult _ =
ElmTextSearch.search currentQuery priorState.index_
|> Result.map
(\(optimalIndex, results) ->
List.filterMap filterResultOf results
|> \processed ->
{ im
| results = Resource.def processed
, latest = (im.sequenceNo, processed)
, index = optimalIndex
})
|> Result.formatError
(\error -> { im | results = Resource.undecided error })
|> (\result -> case result of
Result.Err badstate -> badstate
Result.Ok okstate -> okstate)
|> FilterState config
in
(FilterState config im, Just computeResult)
else
(priorShell, Nothing)
{-| Filter synchronously. The results are immediately available in the resulting Filter. -}
filterSync : Filter doctype -> Filter doctype
filterSync priorShell =
filterRunStage__ priorShell
|> \results -> case results of
(_, Just computeResult) -> computeResult ()
(shell, Nothing) -> shell
{-| Filter asynchronously with a forwarding address. -}
filterAsyncAs : (List (FilterFeedback doctype) -> List action) -> Signal.Address (List action) -> Filter doctype -> (Filter doctype, List (App.FinalTask never))
filterAsyncAs faction address =
filterAsync (Signal.forwardTo address faction)
{-| Filter asynchronously. When executed, the resulting task will send update(s) to the provided filter feedback address. -}
filterAsync : Signal.Address (List (FilterFeedback doctype)) -> Filter doctype -> (Filter doctype, List (App.FinalTask never))
filterAsync address priorShell =
let
(shell, maybeDeferred) =
filterRunStage__ priorShell
in
Maybe.map
(\computeResult -> Task.succeed ()
`andThen` (computeResult >> SearchComplete >> flip (::) [] >> Signal.send address)
`andThen` (\_ -> Task.succeed ())
`onError` (\_ -> Task.succeed ()))
maybeDeferred
|> Maybe.map (\task -> (shell, [ task ]))
|> Maybe.withDefault (shell, [ ])
debugLogIf : Bool -> String -> a -> a
debugLogIf b s =
if b then Debug.log s else identity
filterDelta__ : String -> (Resource DB.DBError doctype, Resource DB.DBError doctype) -> Filter doctype -> Filter doctype
filterDelta__ key (priorDocRes, currDocRes) (FilterState config priorState as priorShell) =
let
resultRefs = priorState.resultRefs_
index = priorState.index_
debugMode = False
maybeIndex' =
case (priorDocRes, currDocRes) of
(Resource.Known doc0, Resource.Known doc1) ->
debugLogIf debugMode "Updating Document" (doc0, doc1)
|> \_ -> ElmTextSearch.remove doc0 index
|> Result.withDefault index
|> ElmTextSearch.add doc1
|> Result.map (\index_ -> debugLogIf debugMode "Updated Document" (doc0, doc1) |> \_ -> index_)
|> Result.formatError ((,) (doc0, doc1) >> debugLogIf debugMode "Failed Updating Document")
|> Result.toMaybe
(_, Resource.Known doc) ->
ElmTextSearch.add (debugLogIf debugMode "Adding Document" doc) index
|> Result.map (\index_ -> debugLogIf debugMode "Added Document" doc |> \_ -> index_)
|> Result.formatError ((,) doc >> debugLogIf debugMode "Failed Adding Document")
|> Result.toMaybe
(Resource.Known doc, _) ->
ElmTextSearch.remove (debugLogIf debugMode "Removing Document" doc) index
|> Result.map (\index_ -> debugLogIf debugMode "Removed Document" doc |> \_ -> index_)
|> Result.formatError ((,) doc >> debugLogIf debugMode "Failed Removing Document")
|> Result.toMaybe
_ -> Nothing
in
maybeIndex'
|> Maybe.map
(\index' ->
{ priorState | index_ = index', indexChanged = True, sequenceNo = 1 + priorState.sequenceNo }
|> \im -> case (priorDocRes, currDocRes) of
(Resource.Known doc0, Resource.Known doc1) ->
FilterState config
{ im
| resultRefs_ = resultRefs
|> Dict.remove (config.ref doc0)
|> Dict.insert (config.ref doc1) doc1
}
(_, Resource.Known doc) ->
FilterState config { im | resultRefs_ = Dict.insert (config.ref doc) doc resultRefs }
(Resource.Known doc, _) ->
FilterState config { im | resultRefs_ = Dict.remove (config.ref doc) resultRefs }
_ ->
priorShell)
|> Maybe.withDefault priorShell