{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, TypeOperators, TypeFamilies #-}
module Text.Boomerang.Prim
    ( -- * Types
    Parser(..), Boomerang(..), PrinterParser, (.~)
    -- * Running routers
    , parse, parse1, unparse, unparse1, bestErrors
    -- * Constructing / Manipulating Boomerangs
    , xpure, val, xmap
    -- heterogeneous list functions
    , xmaph
    ) where

import Prelude             hiding ((.), id)
import Control.Arrow       (first)
import Control.Applicative (Applicative(..), Alternative(..))
import Control.Category    (Category((.), id))
import Control.Monad       (MonadPlus(mzero, mplus), ap)
import Data.Either         (partitionEithers)
import Data.Function       (on)
import Data.Monoid         (Monoid(mappend, mempty))
import qualified Data.Semigroup as SG
import Text.Boomerang.HStack   ((:-)(..), hdMap, hdTraverse)
import Text.Boomerang.Pos     (ErrorPosition(..), InitialPosition(..), Pos)

compose
  :: (a -> b -> c)
  -> (i -> [(a, j)])
  -> (j -> [(b, k)])
  -> (i -> [(c, k)])
compose :: (a -> b -> c)
-> (i -> [(a, j)]) -> (j -> [(b, k)]) -> i -> [(c, k)]
compose a -> b -> c
op i -> [(a, j)]
mf j -> [(b, k)]
mg i
s = do
  (a
f, j
s') <- i -> [(a, j)]
mf i
s
  (b
g, k
s'') <- j -> [(b, k)]
mg j
s'
  (c, k) -> [(c, k)]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
f a -> b -> c
`op` b
g, k
s'')

-- | The 'maximumsBy' function takes a comparison function and a list
-- and returns the greatest elements of the list by the comparison function.
-- The list must be finite and non-empty.
maximumsBy               :: (a -> a -> Ordering) -> [a] -> [a]
maximumsBy :: (a -> a -> Ordering) -> [a] -> [a]
maximumsBy a -> a -> Ordering
_ []          =  [Char] -> [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"Text.Boomerang.Core.maximumsBy: empty list"
maximumsBy a -> a -> Ordering
cmp (a
x:[a]
xs)    =  ([a] -> a -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [a] -> a -> [a]
maxBy [a
x] [a]
xs
    where
      maxBy :: [a] -> a -> [a]
maxBy xs :: [a]
xs@(a
x:[a]
_) a
y =
          case a -> a -> Ordering
cmp a
x a
y of
            Ordering
GT -> [a]
xs
            Ordering
EQ -> (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
            Ordering
LT  -> [a
y]

-- |Yet another parser.
--
-- Returns all possible parses and parse errors
newtype Parser e tok a = Parser { Parser e tok a -> tok -> Pos e -> [Either e ((a, tok), Pos e)]
runParser :: tok -> Pos e -> [Either e ((a, tok), Pos e)] }

instance Functor (Parser e tok) where
    fmap :: (a -> b) -> Parser e tok a -> Parser e tok b
fmap a -> b
f (Parser tok -> Pos e -> [Either e ((a, tok), Pos e)]
p) =
        (tok -> Pos e -> [Either e ((b, tok), Pos e)]) -> Parser e tok b
forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser ((tok -> Pos e -> [Either e ((b, tok), Pos e)]) -> Parser e tok b)
-> (tok -> Pos e -> [Either e ((b, tok), Pos e)]) -> Parser e tok b
forall a b. (a -> b) -> a -> b
$ \tok
tok Pos e
pos ->
            (Either e ((a, tok), Pos e) -> Either e ((b, tok), Pos e))
-> [Either e ((a, tok), Pos e)] -> [Either e ((b, tok), Pos e)]
forall a b. (a -> b) -> [a] -> [b]
map ((((a, tok), Pos e) -> ((b, tok), Pos e))
-> Either e ((a, tok), Pos e) -> Either e ((b, tok), Pos e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a, tok) -> (b, tok)) -> ((a, tok), Pos e) -> ((b, tok), Pos e)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((a -> b) -> (a, tok) -> (b, tok)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> b
f))) (tok -> Pos e -> [Either e ((a, tok), Pos e)]
p tok
tok Pos e
pos)

instance Applicative (Parser e tok) where
    pure :: a -> Parser e tok a
pure  = a -> Parser e tok a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: Parser e tok (a -> b) -> Parser e tok a -> Parser e tok b
(<*>) = Parser e tok (a -> b) -> Parser e tok a -> Parser e tok b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (Parser e tok) where
    return :: a -> Parser e tok a
return a
a =
        (tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser ((tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a)
-> (tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
forall a b. (a -> b) -> a -> b
$ \tok
tok Pos e
pos ->
            [((a, tok), Pos e) -> Either e ((a, tok), Pos e)
forall a b. b -> Either a b
Right ((a
a, tok
tok), Pos e
pos)]
    (Parser tok -> Pos e -> [Either e ((a, tok), Pos e)]
p) >>= :: Parser e tok a -> (a -> Parser e tok b) -> Parser e tok b
>>= a -> Parser e tok b
f =
        (tok -> Pos e -> [Either e ((b, tok), Pos e)]) -> Parser e tok b
forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser ((tok -> Pos e -> [Either e ((b, tok), Pos e)]) -> Parser e tok b)
-> (tok -> Pos e -> [Either e ((b, tok), Pos e)]) -> Parser e tok b
forall a b. (a -> b) -> a -> b
$ \tok
tok Pos e
pos ->
            case [Either e ((a, tok), Pos e)] -> ([e], [((a, tok), Pos e)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers (tok -> Pos e -> [Either e ((a, tok), Pos e)]
p tok
tok Pos e
pos) of
              ([], []) -> []
              ([e]
errs,[]) -> (e -> Either e ((b, tok), Pos e))
-> [e] -> [Either e ((b, tok), Pos e)]
forall a b. (a -> b) -> [a] -> [b]
map e -> Either e ((b, tok), Pos e)
forall a b. a -> Either a b
Left [e]
errs
              ([e]
_,[((a, tok), Pos e)]
as) -> [[Either e ((b, tok), Pos e)]] -> [Either e ((b, tok), Pos e)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ Parser e tok b -> tok -> Pos e -> [Either e ((b, tok), Pos e)]
forall e tok a.
Parser e tok a -> tok -> Pos e -> [Either e ((a, tok), Pos e)]
runParser (a -> Parser e tok b
f a
a) tok
tok' Pos e
pos' | ((a
a, tok
tok'), Pos e
pos') <- [((a, tok), Pos e)]
as ]

instance Alternative (Parser e tok) where
    empty :: Parser e tok a
empty = Parser e tok a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    <|> :: Parser e tok a -> Parser e tok a -> Parser e tok a
(<|>) = Parser e tok a -> Parser e tok a -> Parser e tok a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus

instance MonadPlus (Parser e tok) where
    mzero :: Parser e tok a
mzero = (tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser ((tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a)
-> (tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
forall a b. (a -> b) -> a -> b
$ \tok
tok Pos e
pos -> []
    (Parser tok -> Pos e -> [Either e ((a, tok), Pos e)]
x) mplus :: Parser e tok a -> Parser e tok a -> Parser e tok a
`mplus` (Parser tok -> Pos e -> [Either e ((a, tok), Pos e)]
y) =
        (tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
forall e tok a.
(tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
Parser ((tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a)
-> (tok -> Pos e -> [Either e ((a, tok), Pos e)]) -> Parser e tok a
forall a b. (a -> b) -> a -> b
$ \tok
tok Pos e
pos ->
            (tok -> Pos e -> [Either e ((a, tok), Pos e)]
x tok
tok Pos e
pos) [Either e ((a, tok), Pos e)]
-> [Either e ((a, tok), Pos e)] -> [Either e ((a, tok), Pos e)]
forall a. [a] -> [a] -> [a]
++ (tok -> Pos e -> [Either e ((a, tok), Pos e)]
y tok
tok Pos e
pos)

composeP
  :: (a -> b -> c)
  -> Parser e tok a
  -> Parser e tok b
  -> Parser e tok c
composeP :: (a -> b -> c) -> Parser e tok a -> Parser e tok b -> Parser e tok c
composeP a -> b -> c
op Parser e tok a
mf Parser e tok b
mg =
    do a
f <- Parser e tok a
mf
       b
g <- Parser e tok b
mg
       c -> Parser e tok c
forall (m :: * -> *) a. Monad m => a -> m a
return (a
f a -> b -> c
`op` b
g)

-- | Attempt to extract the most relevant errors from a list of parse errors.
--
-- The current heuristic is to find error (or errors) where the error position is highest.
bestErrors :: (ErrorPosition e, Ord (Pos e)) => [e] -> [e]
bestErrors :: [e] -> [e]
bestErrors [] = []
bestErrors [e]
errs = (e -> e -> Ordering) -> [e] -> [e]
forall a. (a -> a -> Ordering) -> [a] -> [a]
maximumsBy (Maybe (Pos e) -> Maybe (Pos e) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Maybe (Pos e) -> Maybe (Pos e) -> Ordering)
-> (e -> Maybe (Pos e)) -> e -> e -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` e -> Maybe (Pos e)
forall err. ErrorPosition err => err -> Maybe (Pos err)
getPosition) [e]
errs

-- | A @Boomerang a b@ takes an @a@ to parse a URL and results in @b@ if parsing succeeds.
--   And it takes a @b@ to serialize to a URL and results in @a@ if serializing succeeds.
data Boomerang e tok a b = Boomerang
  { Boomerang e tok a b -> Parser e tok (a -> b)
prs :: Parser e tok (a -> b)
  , Boomerang e tok a b -> b -> [(tok -> tok, a)]
ser :: b -> [(tok -> tok, a)]
  }

type PrinterParser = Boomerang
{-# DEPRECATED PrinterParser "Use Boomerang instead" #-}

instance Category (Boomerang e tok) where
  id :: Boomerang e tok a a
id = Parser e tok (a -> a)
-> (a -> [(tok -> tok, a)]) -> Boomerang e tok a a
forall e tok a b.
Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
Boomerang
    ((a -> a) -> Parser e tok (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
    (\a
x -> [(tok -> tok
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id, a
x)])

  ~(Boomerang Parser e tok (b -> c)
pf c -> [(tok -> tok, b)]
sf) . :: Boomerang e tok b c -> Boomerang e tok a b -> Boomerang e tok a c
. ~(Boomerang Parser e tok (a -> b)
pg b -> [(tok -> tok, a)]
sg) = Parser e tok (a -> c)
-> (c -> [(tok -> tok, a)]) -> Boomerang e tok a c
forall e tok a b.
Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
Boomerang
    (((b -> c) -> (a -> b) -> a -> c)
-> Parser e tok (b -> c)
-> Parser e tok (a -> b)
-> Parser e tok (a -> c)
forall a b c e tok.
(a -> b -> c) -> Parser e tok a -> Parser e tok b -> Parser e tok c
composeP (b -> c) -> (a -> b) -> a -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.) Parser e tok (b -> c)
pf Parser e tok (a -> b)
pg)
    (((tok -> tok) -> (tok -> tok) -> tok -> tok)
-> (c -> [(tok -> tok, b)])
-> (b -> [(tok -> tok, a)])
-> c
-> [(tok -> tok, a)]
forall a b c i j k.
(a -> b -> c)
-> (i -> [(a, j)]) -> (j -> [(b, k)]) -> i -> [(c, k)]
compose (tok -> tok) -> (tok -> tok) -> tok -> tok
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.) c -> [(tok -> tok, b)]
sf b -> [(tok -> tok, a)]
sg)

instance SG.Semigroup (Boomerang e tok a b) where
  ~(Boomerang Parser e tok (a -> b)
pf b -> [(tok -> tok, a)]
sf) <> :: Boomerang e tok a b -> Boomerang e tok a b -> Boomerang e tok a b
<> ~(Boomerang Parser e tok (a -> b)
pg b -> [(tok -> tok, a)]
sg) = Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
forall e tok a b.
Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
Boomerang
    (Parser e tok (a -> b)
pf Parser e tok (a -> b)
-> Parser e tok (a -> b) -> Parser e tok (a -> b)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Parser e tok (a -> b)
pg)
    (\b
s -> b -> [(tok -> tok, a)]
sf b
s [(tok -> tok, a)] -> [(tok -> tok, a)] -> [(tok -> tok, a)]
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` b -> [(tok -> tok, a)]
sg b
s)

instance Monoid (Boomerang e tok a b) where
  mempty :: Boomerang e tok a b
mempty = Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
forall e tok a b.
Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
Boomerang
    Parser e tok (a -> b)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    ([(tok -> tok, a)] -> b -> [(tok -> tok, a)]
forall a b. a -> b -> a
const [(tok -> tok, a)]
forall (m :: * -> *) a. MonadPlus m => m a
mzero)
  mappend :: Boomerang e tok a b -> Boomerang e tok a b -> Boomerang e tok a b
mappend = Boomerang e tok a b -> Boomerang e tok a b -> Boomerang e tok a b
forall a. Semigroup a => a -> a -> a
(SG.<>)

infixr 9 .~
-- | Reverse composition, but with the side effects still in left-to-right order.
(.~) :: Boomerang e tok a b -> Boomerang e tok b c -> Boomerang e tok a c
~(Boomerang Parser e tok (a -> b)
pf b -> [(tok -> tok, a)]
sf) .~ :: Boomerang e tok a b -> Boomerang e tok b c -> Boomerang e tok a c
.~ ~(Boomerang Parser e tok (b -> c)
pg c -> [(tok -> tok, b)]
sg) = Parser e tok (a -> c)
-> (c -> [(tok -> tok, a)]) -> Boomerang e tok a c
forall e tok a b.
Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
Boomerang
  (((a -> b) -> (b -> c) -> a -> c)
-> Parser e tok (a -> b)
-> Parser e tok (b -> c)
-> Parser e tok (a -> c)
forall a b c e tok.
(a -> b -> c) -> Parser e tok a -> Parser e tok b -> Parser e tok c
composeP (((b -> c) -> (a -> b) -> a -> c) -> (a -> b) -> (b -> c) -> a -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b -> c) -> (a -> b) -> a -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.)) Parser e tok (a -> b)
pf Parser e tok (b -> c)
pg)
  (((tok -> tok) -> (tok -> tok) -> tok -> tok)
-> (c -> [(tok -> tok, b)])
-> (b -> [(tok -> tok, a)])
-> c
-> [(tok -> tok, a)]
forall a b c i j k.
(a -> b -> c)
-> (i -> [(a, j)]) -> (j -> [(b, k)]) -> i -> [(c, k)]
compose (((tok -> tok) -> (tok -> tok) -> tok -> tok)
-> (tok -> tok) -> (tok -> tok) -> tok -> tok
forall a b c. (a -> b -> c) -> b -> a -> c
flip (tok -> tok) -> (tok -> tok) -> tok -> tok
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.)) c -> [(tok -> tok, b)]
sg b -> [(tok -> tok, a)]
sf)

-- | Map over routers.
xmap :: (a -> b) -> (b -> Maybe a) -> Boomerang e tok r a -> Boomerang e tok r b
xmap :: (a -> b)
-> (b -> Maybe a) -> Boomerang e tok r a -> Boomerang e tok r b
xmap a -> b
f b -> Maybe a
g (Boomerang Parser e tok (r -> a)
p a -> [(tok -> tok, r)]
s) = Parser e tok (r -> b)
-> (b -> [(tok -> tok, r)]) -> Boomerang e tok r b
forall e tok a b.
Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
Boomerang Parser e tok (r -> b)
p' b -> [(tok -> tok, r)]
s'
    where
      p' :: Parser e tok (r -> b)
p' = ((r -> a) -> r -> b)
-> Parser e tok (r -> a) -> Parser e tok (r -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (r -> a) -> r -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Parser e tok (r -> a)
p
      s' :: b -> [(tok -> tok, r)]
s' b
url = [(tok -> tok, r)]
-> (a -> [(tok -> tok, r)]) -> Maybe a -> [(tok -> tok, r)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(tok -> tok, r)]
forall (m :: * -> *) a. MonadPlus m => m a
mzero a -> [(tok -> tok, r)]
s (b -> Maybe a
g b
url)

-- | Lift a constructor-destructor pair to a pure router.
xpure :: (a -> b) -> (b -> Maybe a) -> Boomerang e tok a b
xpure :: (a -> b) -> (b -> Maybe a) -> Boomerang e tok a b
xpure a -> b
f b -> Maybe a
g = (a -> b)
-> (b -> Maybe a) -> Boomerang e tok a a -> Boomerang e tok a b
forall a b e tok r.
(a -> b)
-> (b -> Maybe a) -> Boomerang e tok r a -> Boomerang e tok r b
xmap a -> b
f b -> Maybe a
g Boomerang e tok a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

-- | Like "xmap", but only maps over the top of the stack.
xmaph :: (a -> b) -> (b -> Maybe a) -> Boomerang e tok i (a :- o) -> Boomerang e tok i (b :- o)
xmaph :: (a -> b)
-> (b -> Maybe a)
-> Boomerang e tok i (a :- o)
-> Boomerang e tok i (b :- o)
xmaph a -> b
f b -> Maybe a
g = ((a :- o) -> b :- o)
-> ((b :- o) -> Maybe (a :- o))
-> Boomerang e tok i (a :- o)
-> Boomerang e tok i (b :- o)
forall a b e tok r.
(a -> b)
-> (b -> Maybe a) -> Boomerang e tok r a -> Boomerang e tok r b
xmap ((a -> b) -> (a :- o) -> b :- o
forall a1 a2 b. (a1 -> a2) -> (a1 :- b) -> a2 :- b
hdMap a -> b
f) ((b -> Maybe a) -> (b :- o) -> Maybe (a :- o)
forall (f :: * -> *) a b t.
Functor f =>
(a -> f b) -> (a :- t) -> f (b :- t)
hdTraverse b -> Maybe a
g)

-- | lift a 'Parser' and a printer into a 'Boomerang'
val :: forall e tok a r. Parser e tok a -> (a -> [tok -> tok]) -> Boomerang e tok r (a :- r)
val :: Parser e tok a -> (a -> [tok -> tok]) -> Boomerang e tok r (a :- r)
val Parser e tok a
rs a -> [tok -> tok]
ss = Parser e tok (r -> a :- r)
-> ((a :- r) -> [(tok -> tok, r)]) -> Boomerang e tok r (a :- r)
forall e tok a b.
Parser e tok (a -> b)
-> (b -> [(tok -> tok, a)]) -> Boomerang e tok a b
Boomerang Parser e tok (r -> a :- r)
rs' (a :- r) -> [(tok -> tok, r)]
ss'
    where
      rs' :: Parser e tok (r -> (a :- r))
      rs' :: Parser e tok (r -> a :- r)
rs' = (a -> r -> a :- r) -> Parser e tok a -> Parser e tok (r -> a :- r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> r -> a :- r
forall a b. a -> b -> a :- b
(:-) Parser e tok a
rs
      ss' :: (a :- r) -> [(tok -> tok, r)]
ss' =  (\(a
a :- r
r) -> ((tok -> tok) -> (tok -> tok, r))
-> [tok -> tok] -> [(tok -> tok, r)]
forall a b. (a -> b) -> [a] -> [b]
map (\tok -> tok
f -> (tok -> tok
f, r
r)) (a -> [tok -> tok]
ss a
a))

-- | Give all possible parses or errors.
parse :: forall e a p tok. (InitialPosition e) => Boomerang e tok () a -> tok -> [Either e (a, tok)]
parse :: Boomerang e tok () a -> tok -> [Either e (a, tok)]
parse Boomerang e tok () a
p tok
s =
    (Either e ((() -> a, tok), Pos e) -> Either e (a, tok))
-> [Either e ((() -> a, tok), Pos e)] -> [Either e (a, tok)]
forall a b. (a -> b) -> [a] -> [b]
map ((e -> Either e (a, tok))
-> (((() -> a, tok), Pos e) -> Either e (a, tok))
-> Either e ((() -> a, tok), Pos e)
-> Either e (a, tok)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Either e (a, tok)
forall a b. a -> Either a b
Left (\((() -> a
f, tok
tok), Pos e
_) -> (a, tok) -> Either e (a, tok)
forall a b. b -> Either a b
Right (() -> a
f (), tok
tok))) ([Either e ((() -> a, tok), Pos e)] -> [Either e (a, tok)])
-> [Either e ((() -> a, tok), Pos e)] -> [Either e (a, tok)]
forall a b. (a -> b) -> a -> b
$ Parser e tok (() -> a)
-> tok -> Pos e -> [Either e ((() -> a, tok), Pos e)]
forall e tok a.
Parser e tok a -> tok -> Pos e -> [Either e ((a, tok), Pos e)]
runParser (Boomerang e tok () a -> Parser e tok (() -> a)
forall e tok a b. Boomerang e tok a b -> Parser e tok (a -> b)
prs Boomerang e tok () a
p) tok
s (Maybe e -> Pos e
forall e. InitialPosition e => Maybe e -> Pos e
initialPos (Maybe e
forall a. Maybe a
Nothing :: Maybe e))

-- | Give the first parse, for Boomerangs with a parser that yields just one value.
-- Otherwise return the error (or errors) with the highest error position.
parse1 :: (ErrorPosition e, InitialPosition e, Show e, Ord (Pos e)) =>
          (tok -> Bool) -> Boomerang e tok () (a :- ()) -> tok -> Either [e] a
parse1 :: (tok -> Bool)
-> Boomerang e tok () (a :- ()) -> tok -> Either [e] a
parse1 tok -> Bool
isComplete Boomerang e tok () (a :- ())
r tok
paths =
    let results :: [Either e (a :- (), tok)]
results = Boomerang e tok () (a :- ()) -> tok -> [Either e (a :- (), tok)]
forall e a p tok.
InitialPosition e =>
Boomerang e tok () a -> tok -> [Either e (a, tok)]
parse Boomerang e tok () (a :- ())
r tok
paths
    in case [ a :- ()
a | (Right (a :- ()
a,tok
tok)) <- [Either e (a :- (), tok)]
results, tok -> Bool
isComplete tok
tok ] of
         ((a
u :- ()):[a :- ()]
_) -> a -> Either [e] a
forall a b. b -> Either a b
Right a
u
         [a :- ()]
_             -> [e] -> Either [e] a
forall a b. a -> Either a b
Left ([e] -> Either [e] a) -> [e] -> Either [e] a
forall a b. (a -> b) -> a -> b
$ [e] -> [e]
forall e. (ErrorPosition e, Ord (Pos e)) => [e] -> [e]
bestErrors [ e
e | Left e
e <- [Either e (a :- (), tok)]
results ]

-- | Give all possible serializations.
unparse :: tok -> Boomerang e tok () url -> url -> [tok]
unparse :: tok -> Boomerang e tok () url -> url -> [tok]
unparse tok
tok Boomerang e tok () url
p = (((tok -> tok, ()) -> tok) -> [(tok -> tok, ())] -> [tok]
forall a b. (a -> b) -> [a] -> [b]
map (((tok -> tok) -> tok -> tok
forall a b. (a -> b) -> a -> b
$ tok
tok) ((tok -> tok) -> tok)
-> ((tok -> tok, ()) -> tok -> tok) -> (tok -> tok, ()) -> tok
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (tok -> tok, ()) -> tok -> tok
forall a b. (a, b) -> a
fst)) ([(tok -> tok, ())] -> [tok])
-> (url -> [(tok -> tok, ())]) -> url -> [tok]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Boomerang e tok () url -> url -> [(tok -> tok, ())]
forall e tok a b. Boomerang e tok a b -> b -> [(tok -> tok, a)]
ser Boomerang e tok () url
p

-- | Give the first serialization, for Boomerangs with a serializer that needs just one value.
unparse1 :: tok -> Boomerang e tok () (a :- ()) -> a -> Maybe tok
unparse1 :: tok -> Boomerang e tok () (a :- ()) -> a -> Maybe tok
unparse1 tok
tok Boomerang e tok () (a :- ())
p a
a =
    case tok -> Boomerang e tok () (a :- ()) -> (a :- ()) -> [tok]
forall tok e url. tok -> Boomerang e tok () url -> url -> [tok]
unparse tok
tok Boomerang e tok () (a :- ())
p (a
a a -> () -> a :- ()
forall a b. a -> b -> a :- b
:- ()) of
      [] -> Maybe tok
forall a. Maybe a
Nothing
      (tok
s:[tok]
_) -> tok -> Maybe tok
forall a. a -> Maybe a
Just tok
s