{-# LANGUAGE StrictData #-}
module Lasercutter.Types where
import Control.Applicative
import Control.Selective
import Data.Monoid
import Data.Profunctor
import Witherable
class IsTree t where
getChildren :: t -> [t]
data Parser bc t a where
Pure :: a -> Parser bc t a
LiftA2 :: (b -> c -> a) -> Parser bc t b -> Parser bc t c -> Parser bc t a
GetCrumbs :: Parser bc t bc
Target :: (t -> Bool) -> Parser bc t a -> Parser bc t [a]
OnChildren :: Parser bc t a -> Parser bc t [a]
Current :: Parser bc t t
Expect :: Parser bc t (Maybe a) -> Parser bc t a
Fail :: Parser bc t a
deriving (b -> Parser bc t a -> Parser bc t a
NonEmpty (Parser bc t a) -> Parser bc t a
Parser bc t a -> Parser bc t a -> Parser bc t a
(Parser bc t a -> Parser bc t a -> Parser bc t a)
-> (NonEmpty (Parser bc t a) -> Parser bc t a)
-> (forall b. Integral b => b -> Parser bc t a -> Parser bc t a)
-> Semigroup (Parser bc t a)
forall b. Integral b => b -> Parser bc t a -> Parser bc t a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall bc t a.
Semigroup a =>
NonEmpty (Parser bc t a) -> Parser bc t a
forall bc t a.
Semigroup a =>
Parser bc t a -> Parser bc t a -> Parser bc t a
forall bc t a b.
(Semigroup a, Integral b) =>
b -> Parser bc t a -> Parser bc t a
stimes :: b -> Parser bc t a -> Parser bc t a
$cstimes :: forall bc t a b.
(Semigroup a, Integral b) =>
b -> Parser bc t a -> Parser bc t a
sconcat :: NonEmpty (Parser bc t a) -> Parser bc t a
$csconcat :: forall bc t a.
Semigroup a =>
NonEmpty (Parser bc t a) -> Parser bc t a
<> :: Parser bc t a -> Parser bc t a -> Parser bc t a
$c<> :: forall bc t a.
Semigroup a =>
Parser bc t a -> Parser bc t a -> Parser bc t a
Semigroup, Semigroup (Parser bc t a)
Parser bc t a
Semigroup (Parser bc t a)
-> Parser bc t a
-> (Parser bc t a -> Parser bc t a -> Parser bc t a)
-> ([Parser bc t a] -> Parser bc t a)
-> Monoid (Parser bc t a)
[Parser bc t a] -> Parser bc t a
Parser bc t a -> Parser bc t a -> Parser bc t a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall bc t a. Monoid a => Semigroup (Parser bc t a)
forall bc t a. Monoid a => Parser bc t a
forall bc t a. Monoid a => [Parser bc t a] -> Parser bc t a
forall bc t a.
Monoid a =>
Parser bc t a -> Parser bc t a -> Parser bc t a
mconcat :: [Parser bc t a] -> Parser bc t a
$cmconcat :: forall bc t a. Monoid a => [Parser bc t a] -> Parser bc t a
mappend :: Parser bc t a -> Parser bc t a -> Parser bc t a
$cmappend :: forall bc t a.
Monoid a =>
Parser bc t a -> Parser bc t a -> Parser bc t a
mempty :: Parser bc t a
$cmempty :: forall bc t a. Monoid a => Parser bc t a
$cp1Monoid :: forall bc t a. Monoid a => Semigroup (Parser bc t a)
Monoid) via (Ap (Parser bc t) a)
instance Show (Parser bc t a) where
show :: Parser bc t a -> String
show (Pure a
_) = String
"(Pure _)"
show (LiftA2 b -> c -> a
_ Parser bc t b
pa' Parser bc t c
pa_bctc) =
String
"(LiftA2 _ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Parser bc t b -> String
forall a. Show a => a -> String
show Parser bc t b
pa' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Parser bc t c -> String
forall a. Show a => a -> String
show Parser bc t c
pa_bctc String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
show Parser bc t a
GetCrumbs = String
"GetCrumbs"
show (Target t -> Bool
_ Parser bc t a
pa') = String
"(Target _ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Parser bc t a -> String
forall a. Show a => a -> String
show Parser bc t a
pa' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"')"
show (OnChildren Parser bc t a
pa') = String
"(OnChildren " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Parser bc t a -> String
forall a. Show a => a -> String
show Parser bc t a
pa' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
show Parser bc t a
Current = String
"Current"
show (Expect Parser bc t (Maybe a)
pa') = String
"(Expect " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Parser bc t (Maybe a) -> String
forall a. Show a => a -> String
show Parser bc t (Maybe a)
pa' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
show Parser bc t a
Fail = String
"Fail"
instance Functor (Parser bc t) where
fmap :: (a -> b) -> Parser bc t a -> Parser bc t b
fmap = (a -> b) -> Parser bc t a -> Parser bc t b
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA
instance Applicative (Parser bc t) where
pure :: a -> Parser bc t a
pure = a -> Parser bc t a
forall a bc t. a -> Parser bc t a
Pure
liftA2 :: (a -> b -> c) -> Parser bc t a -> Parser bc t b -> Parser bc t c
liftA2 a -> b -> c
f (Pure a
a) (Pure b
b) = c -> Parser bc t c
forall a bc t. a -> Parser bc t a
Pure (c -> Parser bc t c) -> c -> Parser bc t c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
a b
b
liftA2 a -> b -> c
_ Parser bc t a
Fail Parser bc t b
_ = Parser bc t c
forall bc t a. Parser bc t a
Fail
liftA2 a -> b -> c
_ Parser bc t a
_ Parser bc t b
Fail = Parser bc t c
forall bc t a. Parser bc t a
Fail
liftA2 a -> b -> c
f Parser bc t a
a Parser bc t b
b = (a -> b -> c) -> Parser bc t a -> Parser bc t b -> Parser bc t c
forall b c a bc t.
(b -> c -> a) -> Parser bc t b -> Parser bc t c -> Parser bc t a
LiftA2 a -> b -> c
f Parser bc t a
a Parser bc t b
b
instance Alternative (Parser bc t) where
empty :: Parser bc t a
empty = Parser bc t a
forall bc t a. Parser bc t a
Fail
Parser bc t a
pa1 <|> :: Parser bc t a -> Parser bc t a -> Parser bc t a
<|> Parser bc t a
pa2 =
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
$ Maybe a -> (a -> Maybe a) -> Maybe a -> Maybe a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> (a -> Maybe a) -> Maybe a -> Maybe a)
-> Parser bc t (Maybe a)
-> Parser bc t ((a -> Maybe a) -> Maybe a -> Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser bc t a -> Parser bc t (Maybe a)
forall bc t a. Parser bc t a -> Parser bc t (Maybe a)
try Parser bc t a
pa2 Parser bc t ((a -> Maybe a) -> Maybe a -> Maybe a)
-> Parser bc t (a -> Maybe a) -> Parser bc t (Maybe a -> Maybe a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> Maybe a) -> Parser bc t (a -> Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> Maybe a
forall a. a -> Maybe a
Just Parser bc t (Maybe a -> Maybe a)
-> Parser bc t (Maybe a) -> Parser bc t (Maybe a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser bc t a -> Parser bc t (Maybe a)
forall bc t a. Parser bc t a -> Parser bc t (Maybe a)
try Parser bc t a
pa1
instance Selective (Parser bc t) where
select :: Parser bc t (Either a b) -> Parser bc t (a -> b) -> Parser bc t b
select = Parser bc t (Either a b) -> Parser bc t (a -> b) -> Parser bc t b
forall (f :: * -> *) a b.
Applicative f =>
f (Either a b) -> f (a -> b) -> f b
selectA
instance Filterable (Parser bc t) where
catMaybes :: Parser bc t (Maybe a) -> Parser bc t a
catMaybes = Parser bc t (Maybe a) -> Parser bc t a
forall bc t a. Parser bc t (Maybe a) -> Parser bc t a
Expect
instance Profunctor (Parser bc) where
lmap :: (a -> b) -> Parser bc b c -> Parser bc a c
lmap = (a -> b) -> Parser bc b c -> Parser bc a c
forall t t' bc a. (t -> t') -> Parser bc t' a -> Parser bc t a
mapTree
rmap :: (b -> c) -> Parser bc a b -> Parser bc a c
rmap = (b -> c) -> Parser bc a b -> Parser bc a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
mapTree :: (t -> t') -> Parser bc t' a -> Parser bc t a
mapTree :: (t -> t') -> Parser bc t' a -> Parser bc t a
mapTree t -> t'
_ (Pure a
a) = a -> Parser bc t a
forall a bc t. a -> Parser bc t a
Pure a
a
mapTree t -> t'
t (LiftA2 b -> c -> a
f Parser bc t' b
pa Parser bc t' c
pb) = (b -> c -> a) -> Parser bc t b -> Parser bc t c -> Parser bc t a
forall b c a bc t.
(b -> c -> a) -> Parser bc t b -> Parser bc t c -> Parser bc t a
LiftA2 b -> c -> a
f ((t -> t') -> Parser bc t' b -> Parser bc t b
forall t t' bc a. (t -> t') -> Parser bc t' a -> Parser bc t a
mapTree t -> t'
t Parser bc t' b
pa) ((t -> t') -> Parser bc t' c -> Parser bc t c
forall t t' bc a. (t -> t') -> Parser bc t' a -> Parser bc t a
mapTree t -> t'
t Parser bc t' c
pb)
mapTree t -> t'
_ Parser bc t' a
GetCrumbs = Parser bc t a
forall bc t. Parser bc t bc
GetCrumbs
mapTree t -> t'
t (Target t' -> Bool
p Parser bc t' a
pa) = (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 (t' -> Bool
p (t' -> Bool) -> (t -> t') -> t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> t'
t) (Parser bc t a -> Parser bc t [a])
-> Parser bc t a -> Parser bc t [a]
forall a b. (a -> b) -> a -> b
$ (t -> t') -> Parser bc t' a -> Parser bc t a
forall t t' bc a. (t -> t') -> Parser bc t' a -> Parser bc t a
mapTree t -> t'
t Parser bc t' a
pa
mapTree t -> t'
t (OnChildren Parser bc t' a
pa) = Parser bc t a -> Parser bc t [a]
forall bc t a. Parser bc t a -> Parser bc t [a]
OnChildren (Parser bc t a -> Parser bc t [a])
-> Parser bc t a -> Parser bc t [a]
forall a b. (a -> b) -> a -> b
$ (t -> t') -> Parser bc t' a -> Parser bc t a
forall t t' bc a. (t -> t') -> Parser bc t' a -> Parser bc t a
mapTree t -> t'
t Parser bc t' a
pa
mapTree t -> t'
t Parser bc t' a
Current = (t -> t') -> Parser bc t t -> Parser bc t t'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t -> t'
t Parser bc t t
forall bc t. Parser bc t t
Current
mapTree t -> t'
t (Expect Parser bc t' (Maybe a)
pa) = 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
$ (t -> t') -> Parser bc t' (Maybe a) -> Parser bc t (Maybe a)
forall t t' bc a. (t -> t') -> Parser bc t' a -> Parser bc t a
mapTree t -> t'
t Parser bc t' (Maybe a)
pa
mapTree t -> t'
_ Parser bc t' a
Fail = Parser bc t a
forall bc t a. Parser bc t a
Fail
data Split bc t a where
Split
:: Parser bc t a
-> ([a] -> Parser bc t b)
-> Split bc t b
expect :: Parser bc t (Maybe a) -> Parser bc t a
expect :: Parser bc t (Maybe a) -> Parser bc t a
expect (Pure Maybe a
Nothing) = Parser bc t a
forall bc t a. Parser bc t a
Fail
expect (Pure (Just a
a)) = a -> Parser bc t a
forall a bc t. a -> Parser bc t a
Pure a
a
expect Parser bc t (Maybe a)
p = 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)
p
try :: Parser bc t a -> Parser bc t (Maybe a)
try :: Parser bc t a -> Parser bc t (Maybe a)
try Parser bc t a
Fail = Maybe a -> Parser bc t (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
try (Expect Parser bc t (Maybe a)
p) = Parser bc t (Maybe a)
p
try (LiftA2 b -> c -> a
f Parser bc t b
a Parser bc t c
b) = (Maybe b -> Maybe c -> Maybe a)
-> Parser bc t (Maybe b)
-> Parser bc t (Maybe c)
-> Parser bc t (Maybe a)
forall b c a bc t.
(b -> c -> a) -> Parser bc t b -> Parser bc t c -> Parser bc t a
LiftA2 ((b -> c -> a) -> Maybe b -> Maybe c -> Maybe a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> c -> a
f) (Parser bc t b -> Parser bc t (Maybe b)
forall bc t a. Parser bc t a -> Parser bc t (Maybe a)
try Parser bc t b
a) (Parser bc t c -> Parser bc t (Maybe c)
forall bc t a. Parser bc t a -> Parser bc t (Maybe a)
try Parser bc t c
b)
try Parser bc t a
p = (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
p