module Lemmatchers.Matchers where

import Lemmatchers.TagRecords
import Data.Bool
import Data.List
import Data.Bifunctor
import qualified Data.ByteString.Lazy as BS
import qualified Data.Text as T
import Data.Text.Encoding
import qualified Data.Vector as V
import qualified Text.Read as R
import Text.ParserCombinators.ReadP
import Control.Applicative (Alternative, liftA2, empty)
import Control.Monad
import Data.Csv

lb, rn, line, sep :: String
lb :: String
lb    = String
"\n" -- "\r\n" would work, too
rn :: String
rn    = String
"\r\n"
line :: String
line  = String
"---"
sep :: String
sep   = String
lb String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
line String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lb String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lb

plb, pline, psep :: ReadP ()
plb :: ReadP ()
plb   = ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP Char -> ReadP ()) -> ReadP Char -> ReadP ()
forall a b. (a -> b) -> a -> b
$ ReadP Char -> ReadP ()
forall a. ReadP a -> ReadP ()
optional (Char -> ReadP Char
char Char
'\r') ReadP () -> ReadP Char -> ReadP Char
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ReadP Char
char Char
'\n'
pline :: ReadP ()
pline = ReadP String -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP String -> ReadP ()) -> ReadP String -> ReadP ()
forall a b. (a -> b) -> a -> b
$ String -> ReadP String
string String
line
psep :: ReadP ()
psep  = ReadP [()] -> ReadP [()] -> ReadP () -> ReadP ()
forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between (ReadP ()
plb ReadP () -> ReadP [()] -> ReadP [()]
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP () -> ReadP [()]
forall a. ReadP a -> ReadP [a]
many1 ReadP ()
plb) (ReadP ()
plb ReadP () -> ReadP [()] -> ReadP [()]
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP () -> ReadP [()]
forall a. ReadP a -> ReadP [a]
many1 ReadP ()
plb) ReadP ()
pline

guarded :: Alternative f => (a -> Bool) -> a -> f a
guarded :: forall (f :: * -> *) a. Alternative f => (a -> Bool) -> a -> f a
guarded = (f a -> Bool -> f a) -> (a -> f a) -> (a -> Bool) -> a -> f a
forall a b c. (a -> b -> c) -> (a -> a) -> (a -> b) -> a -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (f a -> f a -> Bool -> f a
forall a. a -> a -> Bool -> a
bool f a
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty) a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-------------------------------

newtype Matchers = Matchers
  { Matchers -> [Matcher]
matchers :: [Matcher]
  } deriving Matchers -> Matchers -> Bool
(Matchers -> Matchers -> Bool)
-> (Matchers -> Matchers -> Bool) -> Eq Matchers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Matchers -> Matchers -> Bool
== :: Matchers -> Matchers -> Bool
$c/= :: Matchers -> Matchers -> Bool
/= :: Matchers -> Matchers -> Bool
Eq

instance Show Matchers where
  show :: Matchers -> String
show = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
sep ([String] -> String)
-> (Matchers -> [String]) -> Matchers -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Matcher -> String) -> [Matcher] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Matcher -> String
forall a. Show a => a -> String
show ([Matcher] -> [String])
-> (Matchers -> [Matcher]) -> Matchers -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matchers -> [Matcher]
matchers

instance Read Matchers where
  readsPrec :: Int -> ReadS Matchers
readsPrec Int
_ = ReadP Matchers -> ReadS Matchers
forall a. ReadP a -> ReadS a
readP_to_S ReadP Matchers
parseMatchers

parseMatchers :: ReadP Matchers
parseMatchers :: ReadP Matchers
parseMatchers = [Matcher] -> Matchers
Matchers ([Matcher] -> Matchers) -> ReadP [Matcher] -> ReadP Matchers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Matcher
parseMatcher ReadP Matcher -> ReadP () -> ReadP [Matcher]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
`sepBy1` ReadP ()
psep

-------------------------------

data Matcher = Matcher
  { Matcher -> String
name      :: String
  , Matcher -> [Pattern]
patterns  :: [Pattern]
  } deriving Matcher -> Matcher -> Bool
(Matcher -> Matcher -> Bool)
-> (Matcher -> Matcher -> Bool) -> Eq Matcher
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Matcher -> Matcher -> Bool
== :: Matcher -> Matcher -> Bool
$c/= :: Matcher -> Matcher -> Bool
/= :: Matcher -> Matcher -> Bool
Eq

instance Show Matcher where
  show :: Matcher -> String
show (Matcher String
n [Pattern]
ps) = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String
"matcher " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Pattern -> String) -> [Pattern] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Pattern -> String
forall a. Show a => a -> String
show [Pattern]
ps

instance Read Matcher where
  readsPrec :: Int -> ReadS Matcher
readsPrec Int
_ = ReadP Matcher -> ReadS Matcher
forall a. ReadP a -> ReadS a
readP_to_S ReadP Matcher
parseMatcher

parseMatcher :: ReadP Matcher
parseMatcher :: ReadP Matcher
parseMatcher = do
  String
n   <- String -> ReadP String
string String
"matcher " ReadP String -> ReadP String -> ReadP String
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> ReadP String
munch1 (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
rn)
  [Pattern]
ps  <- ReadP ()
plb ReadP () -> ReadP [Pattern] -> ReadP [Pattern]
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP Pattern
parsePattern ReadP Pattern -> ReadP () -> ReadP [Pattern]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
`sepBy1` ReadP ()
plb
  Matcher -> ReadP Matcher
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Matcher -> ReadP Matcher) -> Matcher -> ReadP Matcher
forall a b. (a -> b) -> a -> b
$ String -> [Pattern] -> Matcher
Matcher String
n [Pattern]
ps

-------------------------------

newtype Pattern = Pattern
  { Pattern -> [MatchItem]
items :: [MatchItem]
  } deriving Pattern -> Pattern -> Bool
(Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool) -> Eq Pattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pattern -> Pattern -> Bool
== :: Pattern -> Pattern -> Bool
$c/= :: Pattern -> Pattern -> Bool
/= :: Pattern -> Pattern -> Bool
Eq

instance Show Pattern where
  show :: Pattern -> String
show = [String] -> String
unwords ([String] -> String) -> (Pattern -> [String]) -> Pattern -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MatchItem -> String) -> [MatchItem] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map MatchItem -> String
forall a. Show a => a -> String
show ([MatchItem] -> [String])
-> (Pattern -> [MatchItem]) -> Pattern -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> [MatchItem]
items

instance Read Pattern where
  readsPrec :: Int -> ReadS Pattern
readsPrec Int
_ = ReadP Pattern -> ReadS Pattern
forall a. ReadP a -> ReadS a
readP_to_S ReadP Pattern
parsePattern

parsePattern :: ReadP Pattern
parsePattern :: ReadP Pattern
parsePattern = [MatchItem] -> Pattern
Pattern ([MatchItem] -> Pattern) -> ReadP [MatchItem] -> ReadP Pattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP MatchItem
matchItemParser ReadP MatchItem -> ReadP Char -> ReadP [MatchItem]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
`sepBy1` Char -> ReadP Char
char Char
' '

-------------------------------

data MatchItem
  = Exact   Tag
  | Not     Tag
  | OneOf   [Tag]
  | NoneOf  [Tag]
  | Any
  deriving MatchItem -> MatchItem -> Bool
(MatchItem -> MatchItem -> Bool)
-> (MatchItem -> MatchItem -> Bool) -> Eq MatchItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MatchItem -> MatchItem -> Bool
== :: MatchItem -> MatchItem -> Bool
$c/= :: MatchItem -> MatchItem -> Bool
/= :: MatchItem -> MatchItem -> Bool
Eq

instance Show MatchItem where
  show :: MatchItem -> String
show  (Exact  Tag
e)  = Tag -> String
forall a. Show a => a -> String
show Tag
e
  show  (Not    Tag
n)  = String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tag -> String
forall a. Show a => a -> String
show Tag
n
  show  (OneOf  [Tag]
ts) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (Tag -> String
forall a. Show a => a -> String
show (Tag -> String) -> [Tag] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tag]
ts) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  show  (NoneOf [Tag]
ts) = String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ MatchItem -> String
forall a. Show a => a -> String
show ([Tag] -> MatchItem
OneOf [Tag]
ts)
  show  MatchItem
Any         = String
"*"

instance Read MatchItem where
  readsPrec :: Int -> ReadS MatchItem
readsPrec Int
_ = ReadP MatchItem -> ReadS MatchItem
forall a. ReadP a -> ReadS a
readP_to_S ReadP MatchItem
matchItemParser

matchItemParser :: ReadP MatchItem
matchItemParser :: ReadP MatchItem
matchItemParser = [ReadP MatchItem] -> ReadP MatchItem
forall a. [ReadP a] -> ReadP a
choice [ReadP MatchItem
exact, ReadP MatchItem
notmi, ReadP MatchItem
oneof, ReadP MatchItem
noneof, ReadP MatchItem
anymi]
  where exact :: ReadP MatchItem
exact     =             Tag -> MatchItem
Exact   (Tag -> MatchItem) -> ReadP Tag -> ReadP MatchItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Tag
tag
        notmi :: ReadP MatchItem
notmi     = Char -> ReadP Char
char Char
'-' ReadP Char -> ReadP MatchItem -> ReadP MatchItem
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tag -> MatchItem
Not     (Tag -> MatchItem) -> ReadP Tag -> ReadP MatchItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Tag
tag
        oneof :: ReadP MatchItem
oneof     =             [Tag] -> MatchItem
OneOf   ([Tag] -> MatchItem) -> ReadP [Tag] -> ReadP MatchItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP [Tag]
tags
        noneof :: ReadP MatchItem
noneof    = Char -> ReadP Char
char Char
'-' ReadP Char -> ReadP MatchItem -> ReadP MatchItem
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Tag] -> MatchItem
NoneOf  ([Tag] -> MatchItem) -> ReadP [Tag] -> ReadP MatchItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP [Tag]
tags
        anymi :: ReadP MatchItem
anymi     = Char -> ReadP Char
char Char
'*' ReadP Char -> ReadP MatchItem -> ReadP MatchItem
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MatchItem -> ReadP MatchItem
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return MatchItem
Any
        tags :: ReadP [Tag]
tags      = ReadP Char -> ReadP Char -> ReadP [Tag] -> ReadP [Tag]
forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
between (Char -> ReadP Char
char Char
'(') (Char -> ReadP Char
char Char
')') (ReadP [Tag] -> ReadP [Tag]) -> ReadP [Tag] -> ReadP [Tag]
forall a b. (a -> b) -> a -> b
$ ReadP Tag
tag ReadP Tag -> ReadP Char -> ReadP [Tag]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
`sepBy1` Char -> ReadP Char
char Char
' '
        tag :: ReadP Tag
tag       = ReadP Tag -> (Tag -> ReadP Tag) -> Maybe Tag -> ReadP Tag
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadP Tag
forall a. ReadP a
pfail Tag -> ReadP Tag
forall a. a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Tag -> ReadP Tag)
-> (String -> Maybe Tag) -> String -> ReadP Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Tag
forall a. Read a => String -> Maybe a
R.readMaybe (String -> ReadP Tag) -> ReadP String -> ReadP Tag
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReadP String
ucToken
        ucToken :: ReadP String
ucToken   = (Char -> Bool) -> ReadP String
munch1 (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'A'..Char
'Z'])

-------------------------------

data Match = Match
  { Match -> Matcher
matcher           :: Matcher
  , Match -> Pattern
pattern           :: Pattern
  , Match -> String
foundIdText       :: String
  , Match -> String
foundDesignation  :: String
  , Match -> [Lemma]
foundLemmata      :: [Lemma]
  } deriving Match -> Match -> Bool
(Match -> Match -> Bool) -> (Match -> Match -> Bool) -> Eq Match
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Match -> Match -> Bool
== :: Match -> Match -> Bool
$c/= :: Match -> Match -> Bool
/= :: Match -> Match -> Bool
Eq

instance Show Match where
  show :: Match -> String
show (Match Matcher
m Pattern
p String
fid String
fd [Lemma]
fl) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" ; "
    [Matcher -> String
name Matcher
m, Pattern -> String
forall a. Show a => a -> String
show Pattern
p, String
fid, String
fd, Lemmas -> String
forall a. ShortShow a => a -> String
shortShow ([Lemma] -> Lemmas
Lemmas [Lemma]
fl)]

instance ToNamedRecord Match where
  toNamedRecord :: Match -> NamedRecord
toNamedRecord (Match Matcher
m Pattern
p String
fid String
fd [Lemma]
fl) = [(ByteString, ByteString)] -> NamedRecord
namedRecord ([(ByteString, ByteString)] -> NamedRecord)
-> [(ByteString, ByteString)] -> NamedRecord
forall a b. (a -> b) -> a -> b
$
    ((ByteString, String) -> (ByteString, ByteString))
-> [(ByteString, String)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> ByteString)
-> (ByteString, String) -> (ByteString, ByteString)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack))
      [ (ByteString
"matcher",     Matcher -> String
name Matcher
m)
      , (ByteString
"pattern",     Pattern -> String
forall a. Show a => a -> String
show Pattern
p)
      , (ByteString
"id_text",     String
fid)
      , (ByteString
"Designation", String
fd)
      , (ByteString
"lemma",       Lemmas -> String
forall a. ShortShow a => a -> String
shortShow ([Lemma] -> Lemmas
Lemmas [Lemma]
fl))
      ]

instance DefaultOrdered Match where
  headerOrder :: Match -> Header
headerOrder Match
_ = [ByteString] -> Header
forall a. [a] -> Vector a
V.fromList ([ByteString] -> Header) -> [ByteString] -> Header
forall a b. (a -> b) -> a -> b
$ (String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) ([String] -> [ByteString]) -> [String] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words
    String
"matcher pattern id_text Designation lemma"

matchesToCsv :: [Match] -> BS.ByteString
matchesToCsv :: [Match] -> ByteString
matchesToCsv = [Match] -> ByteString
forall a. (DefaultOrdered a, ToNamedRecord a) => [a] -> ByteString
encodeDefaultOrderedByName

-------------------------------

matchRecord :: Matcher -> LemmaRecord -> [Match]
matchRecord :: Matcher -> LemmaRecord -> [Match]
matchRecord Matcher
m LemmaRecord
lr  = (Pattern -> [Match]) -> [Pattern] -> [Match]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pattern -> [Match]
collect (Matcher -> [Pattern]
patterns Matcher
m)
  where ls :: [Lemma]
ls        = Lemmas -> [Lemma]
lemmas (LemmaRecord -> Lemmas
lemmata LemmaRecord
lr)
        collect :: Pattern -> [Match]
collect Pattern
p = ([Lemma] -> Match) -> [[Lemma]] -> [Match]
forall a b. (a -> b) -> [a] -> [b]
map (Pattern -> [Lemma] -> Match
build Pattern
p) ([[Lemma]] -> [Match]) -> [[Lemma]] -> [Match]
forall a b. (a -> b) -> a -> b
$ [MatchItem] -> [Lemma] -> [[Lemma]]
matchLemmas (Pattern -> [MatchItem]
items Pattern
p) [Lemma]
ls
        build :: Pattern -> [Lemma] -> Match
build   Pattern
p = Matcher -> Pattern -> String -> String -> [Lemma] -> Match
Match Matcher
m Pattern
p (LemmaRecord -> String
idText LemmaRecord
lr) (LemmaRecord -> String
designation LemmaRecord
lr)

matchLemmas :: [MatchItem] -> [Lemma] -> [[Lemma]]
matchLemmas :: [MatchItem] -> [Lemma] -> [[Lemma]]
matchLemmas [MatchItem]
_ []           = []
matchLemmas [MatchItem]
mis lss :: [Lemma]
lss@(Lemma
_:[Lemma]
ls)
  | [MatchItem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MatchItem]
mis Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Lemma] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Lemma]
lss = []
  | Bool
otherwise               =
    case [Lemma -> Bool] -> [Lemma] -> Maybe [Lemma]
forall a. [a -> Bool] -> [a] -> Maybe [a]
matchPrefix ((MatchItem -> Lemma -> Bool) -> [MatchItem] -> [Lemma -> Bool]
forall a b. (a -> b) -> [a] -> [b]
map (((Tag -> Bool) -> (Lemma -> Tag) -> Lemma -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lemma -> Tag
ltag) ((Tag -> Bool) -> Lemma -> Bool)
-> (MatchItem -> Tag -> Bool) -> MatchItem -> Lemma -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchItem -> Tag -> Bool
matchTag) [MatchItem]
mis) [Lemma]
lss of
      Maybe [Lemma]
Nothing -> [MatchItem] -> [Lemma] -> [[Lemma]]
matchLemmas [MatchItem]
mis [Lemma]
ls
      Just [Lemma]
m  ->  let rest :: [Lemma]
rest = Int -> [Lemma] -> [Lemma]
forall a. Int -> [a] -> [a]
drop ([MatchItem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MatchItem]
mis) [Lemma]
lss
                  in  [Lemma]
m [Lemma] -> [[Lemma]] -> [[Lemma]]
forall a. a -> [a] -> [a]
: [MatchItem] -> [Lemma] -> [[Lemma]]
matchLemmas [MatchItem]
mis [Lemma]
rest

matchPrefix :: [a -> Bool] -> [a] -> Maybe [a]
matchPrefix :: forall a. [a -> Bool] -> [a] -> Maybe [a]
matchPrefix [] [a]
_ = [a] -> Maybe [a]
forall a. a -> Maybe a
Just []
matchPrefix [a -> Bool]
_ [] = Maybe [a]
forall a. Maybe a
Nothing
matchPrefix (a -> Bool
p:[a -> Bool]
ps) (a
x:[a]
xs)
  | a -> Bool
p a
x       = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a -> Bool] -> [a] -> Maybe [a]
forall a. [a -> Bool] -> [a] -> Maybe [a]
matchPrefix [a -> Bool]
ps [a]
xs
  | Bool
otherwise = Maybe [a]
forall a. Maybe a
Nothing

matchTag :: MatchItem -> Tag -> Bool
matchTag :: MatchItem -> Tag -> Bool
matchTag (Exact   Tag
e)  = (Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
e)
matchTag (Not     Tag
n)  = (Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
/= Tag
n)
matchTag (OneOf   [Tag]
ts) = (Tag -> [Tag] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Tag]
ts)
matchTag (NoneOf  [Tag]
ts) = (Tag -> [Tag] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Tag]
ts)
matchTag MatchItem
Any          = Bool -> Tag -> Bool
forall a b. a -> b -> a
const Bool
True