module Lasercutter
  ( -- * Core types
    Parser
  , runParser
  , IsTree (..)

  -- * Building parsers
  -- ** Primitives
  , self
  , proj

  -- ** Controlling failure
  , expect
  , one
  , try
  , empty
  , (<|>)

  -- ** Traversing trees
  , onChildren
  , onSingleChild
  , target
  , targetMap

  -- ** Conditional parsing
  , when
  , whenNode
  , ifS
  , ifNode

  -- ** Breadcrumbs
  -- | All parsers support a notion of *breadcrumbs* --- a monoid that gets
  -- accumulated along subtrees. Callers to 'runParser' can choose
  -- a *summarization* function which describes how to generate the breadcrumb
  -- monoid from the current node.
  --
  -- Breadcrumbs are often used to refine the results of 'target', which has no
  -- notion of history, and thus can be too coarse for many position-depending
  -- parsing tasks.
  , breadcrumbs
  , onBreadcrumbs
  , mapBreadcrumbs

  -- * Re-exports
  -- | The 'Parser' is an instance of all of the following classes, and thus
  -- all of these methods are available on 'Parser's.

  -- ** 'Profunctor'
  -- | Even though 'Parser's are contravariant in their breadcrumbs and
  -- tree type, this instance targets only the tree. Use 'mapBreadcrumbs' to
  -- modify the breadcrumbs.
  , dimap
  , rmap
  , lmap

  -- ** 'Applicative'
  , liftA2

  -- ** 'Alternative'
  , optional
  , guard
  , asum

  -- ** 'Filterable'
  , mapMaybe
  , catMaybes

  -- ** 'Selective'
  -- | 'Parser's are boring 'Selective' functors that are unfortunately unable
  -- to elide any effects. Nevertheless, the 'Selective' API is often quite
  -- useful for everyday parsing tasks.
  , select
  , (<*?)
  , branch
  , fromMaybeS
  , orElse
  , andAlso
  , (<||>)
  , (<&&>)
  , foldS
  , anyS
  , allS
  , bindS
  ) where

import Control.Applicative
import Control.Monad (guard)
import Control.Selective
import Data.Foldable (asum)
import Data.Maybe (listToMaybe, isJust)
import Lasercutter.Internal
import Lasercutter.Types
import Prelude hiding (filter)
import Witherable (Filterable (..))
import Data.Profunctor


------------------------------------------------------------------------------
-- | Project a value out of the current node. This is the main way to build
-- primitive parsers.
--
-- * @'proj' f = 'fmap' f 'self'@
--
-- @since 0.1.0.0
proj :: (t -> a) -> Parser bc t a
proj :: (t -> a) -> Parser bc t a
proj t -> a
f = (t -> a) -> Parser bc t t -> Parser bc t a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t -> a
f Parser bc t t
forall bc t. Parser bc t t
self


------------------------------------------------------------------------------
-- | Run the given parser on every immediate child of the current node.
--
-- @since 0.1.0.0
onChildren :: Parser bc t a -> Parser bc t [a]
onChildren :: Parser bc t a -> Parser bc t [a]
onChildren = Parser bc t a -> Parser bc t [a]
forall bc t a. Parser bc t a -> Parser bc t [a]
OnChildren


------------------------------------------------------------------------------
-- | Run the given parser on every predicate-satisfying subtree of the current
-- node. This combinator is not recursive --- that is, if the predicate
-- is satisfied by both a node and its descendent, the descendent *will not*
-- receive the parser.
--
-- @since 0.1.0.0
target :: (t -> Bool) -> Parser bc t a -> Parser bc t [a]
target :: (t -> Bool) -> Parser bc t a -> Parser bc t [a]
target = (t -> Bool) -> Parser bc t a -> Parser bc t [a]
forall t bc a. (t -> Bool) -> Parser bc t a -> Parser bc t [a]
Target


------------------------------------------------------------------------------
-- | Get the breadcrumbs at the current node. This is useful for refining the
-- coarse-grained matches of 'target' by restricting matches to certain
-- subtrees.
--
-- @since 0.1.0.0
breadcrumbs :: Parser bc t bc
breadcrumbs :: Parser bc t bc
breadcrumbs = Parser bc t bc
forall bc t. Parser bc t bc
GetCrumbs


------------------------------------------------------------------------------
-- | Get a value computed on the current breadcrumbs.
--
-- * @'onBreadcrumbs' f = 'fmap' f 'breadcrumbs'@
--
-- @since 0.1.0.0
onBreadcrumbs :: (bc -> a) -> Parser bc t a
onBreadcrumbs :: (bc -> a) -> Parser bc t a
onBreadcrumbs bc -> a
f = (bc -> a) -> Parser bc t bc -> Parser bc t a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap bc -> a
f Parser bc t bc
forall bc t. Parser bc t bc
breadcrumbs


------------------------------------------------------------------------------
-- | Run a parser on the immediate children of the current node, returning the
-- first success.
--
-- * @'onSingleChild' = 'fmap' 'listToMaybe' . 'onChildren'@
--
-- @since 0.1.0.0
onSingleChild :: Parser bc t a -> Parser bc t (Maybe a)
onSingleChild :: Parser bc t a -> Parser bc t (Maybe a)
onSingleChild = ([a] -> Maybe a) -> Parser bc t [a] -> Parser bc t (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe (Parser bc t [a] -> Parser bc t (Maybe a))
-> (Parser bc t a -> Parser bc t [a])
-> Parser bc t a
-> Parser bc t (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser bc t a -> Parser bc t [a]
forall bc t a. Parser bc t a -> Parser bc t [a]
onChildren


------------------------------------------------------------------------------
-- | Get the current node.
--
-- @since 0.1.0.0
self :: Parser bc t t
self :: Parser bc t t
self = Parser bc t t
forall bc t. Parser bc t t
Current


------------------------------------------------------------------------------
-- | Get the first result of a list of results, failing if there are none.
--
-- * @'one' = 'expect' . 'fmap' 'listToMaybe'@
--
-- @since 0.1.0.0
one :: Parser bc t [a] -> Parser bc t a
one :: Parser bc t [a] -> Parser bc t a
one = Parser bc t (Maybe a) -> Parser bc t a
forall bc t a. Parser bc t (Maybe a) -> Parser bc t a
expect (Parser bc t (Maybe a) -> Parser bc t a)
-> (Parser bc t [a] -> Parser bc t (Maybe a))
-> Parser bc t [a]
-> Parser bc t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Maybe a) -> Parser bc t [a] -> Parser bc t (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe


------------------------------------------------------------------------------
-- | @'when' pc pa@ returns @pa@ when @pc@ evaluates to 'True', failing
-- otherwise.
--
-- @since 0.1.0.0
when
    :: Parser bc t Bool
    -> Parser bc t a
    -> Parser bc t a
when :: Parser bc t Bool -> Parser bc t a -> Parser bc t a
when Parser bc t Bool
b Parser bc t a
tr = Parser bc t (Maybe a) -> Parser bc t a
forall bc t a. Parser bc t (Maybe a) -> Parser bc t a
expect (Parser bc t (Maybe a) -> Parser bc t a)
-> Parser bc t (Maybe a) -> Parser bc t a
forall a b. (a -> b) -> a -> b
$ Parser bc t Bool
-> Parser bc t (Maybe a)
-> Parser bc t (Maybe a)
-> Parser bc t (Maybe a)
forall (f :: * -> *) a. Selective f => f Bool -> f a -> f a -> f a
ifS Parser bc t Bool
b ((a -> Maybe a) -> Parser bc t a -> Parser bc t (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just Parser bc t a
tr) (Parser bc t (Maybe a) -> Parser bc t (Maybe a))
-> Parser bc t (Maybe a) -> Parser bc t (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> Parser bc t (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | @'ifNode' f pt pf@ runs @pt@ when @f@ evaluates to 'True' on the
-- current node, running @pf@ otherwise.
--
-- * @'ifNode' f tr fl = 'ifS' ('proj' f) tr fl@
--
-- @since 0.1.0.0
ifNode
    :: (t -> Bool)
    -> Parser bc t a
    -> Parser bc t a
    -> Parser bc t a
ifNode :: (t -> Bool) -> Parser bc t a -> Parser bc t a -> Parser bc t a
ifNode t -> Bool
f Parser bc t a
tr Parser bc t a
fl = Parser bc t Bool -> Parser bc t a -> Parser bc t a -> Parser bc t a
forall (f :: * -> *) a. Selective f => f Bool -> f a -> f a -> f a
ifS ((t -> Bool) -> Parser bc t Bool
forall t a bc. (t -> a) -> Parser bc t a
proj t -> Bool
f) Parser bc t a
tr Parser bc t a
fl


------------------------------------------------------------------------------
-- | @'whenNode' f pa@ returns @pa@ when @pc@ evaluates to 'True' on the
-- current node, failing otherwise.
--
-- * @'whenNode' = 'when' . 'proj'@
--
-- @since 0.1.0.0
whenNode :: (t -> Bool) -> Parser bc t a -> Parser bc t a
whenNode :: (t -> Bool) -> Parser bc t a -> Parser bc t a
whenNode = Parser bc t Bool -> Parser bc t a -> Parser bc t a
forall bc t a. Parser bc t Bool -> Parser bc t a -> Parser bc t a
when (Parser bc t Bool -> Parser bc t a -> Parser bc t a)
-> ((t -> Bool) -> Parser bc t Bool)
-> (t -> Bool)
-> Parser bc t a
-> Parser bc t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> Bool) -> Parser bc t Bool
forall t a bc. (t -> a) -> Parser bc t a
proj


------------------------------------------------------------------------------
-- | Run the given function on every subtree, accumulating those which return
-- 'Just'.
--
-- @since 0.1.0.0
targetMap :: (t -> Maybe a) -> Parser bc t [a]
targetMap :: (t -> Maybe a) -> Parser bc t [a]
targetMap t -> Maybe a
f = ([Maybe a] -> [a]) -> Parser bc t [Maybe a] -> Parser bc t [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes (Parser bc t [Maybe a] -> Parser bc t [a])
-> Parser bc t [Maybe a] -> Parser bc t [a]
forall a b. (a -> b) -> a -> b
$ (t -> Bool) -> Parser bc t (Maybe a) -> Parser bc t [Maybe a]
forall t bc a. (t -> Bool) -> Parser bc t a -> Parser bc t [a]
target (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust  (Maybe a -> Bool) -> (t -> Maybe a) -> t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Maybe a
f) (Parser bc t (Maybe a) -> Parser bc t [Maybe a])
-> Parser bc t (Maybe a) -> Parser bc t [Maybe a]
forall a b. (a -> b) -> a -> b
$ (t -> Maybe a) -> Parser bc t (Maybe a)
forall t a bc. (t -> a) -> Parser bc t a
proj t -> Maybe a
f