{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE TypeFamilies #-}
module Matterhorn.Types.DirectionalSeq where
import Prelude ()
import Matterhorn.Prelude
import qualified Data.Sequence as Seq
data Chronological
data Retrograde
class SeqDirection a where
type ReverseDirection a
instance SeqDirection Chronological
where type ReverseDirection Chronological = Retrograde
instance SeqDirection Retrograde
where type ReverseDirection Retrograde = Chronological
data SeqDirection dir => DirectionalSeq dir a =
DSeq { DirectionalSeq dir a -> Seq a
dseq :: Seq a }
deriving (Int -> DirectionalSeq dir a -> ShowS
[DirectionalSeq dir a] -> ShowS
DirectionalSeq dir a -> String
(Int -> DirectionalSeq dir a -> ShowS)
-> (DirectionalSeq dir a -> String)
-> ([DirectionalSeq dir a] -> ShowS)
-> Show (DirectionalSeq dir a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall dir a.
(SeqDirection dir, Show a) =>
Int -> DirectionalSeq dir a -> ShowS
forall dir a.
(SeqDirection dir, Show a) =>
[DirectionalSeq dir a] -> ShowS
forall dir a.
(SeqDirection dir, Show a) =>
DirectionalSeq dir a -> String
showList :: [DirectionalSeq dir a] -> ShowS
$cshowList :: forall dir a.
(SeqDirection dir, Show a) =>
[DirectionalSeq dir a] -> ShowS
show :: DirectionalSeq dir a -> String
$cshow :: forall dir a.
(SeqDirection dir, Show a) =>
DirectionalSeq dir a -> String
showsPrec :: Int -> DirectionalSeq dir a -> ShowS
$cshowsPrec :: forall dir a.
(SeqDirection dir, Show a) =>
Int -> DirectionalSeq dir a -> ShowS
Show, a -> DirectionalSeq dir b -> DirectionalSeq dir a
(a -> b) -> DirectionalSeq dir a -> DirectionalSeq dir b
(forall a b.
(a -> b) -> DirectionalSeq dir a -> DirectionalSeq dir b)
-> (forall a b. a -> DirectionalSeq dir b -> DirectionalSeq dir a)
-> Functor (DirectionalSeq dir)
forall dir a b.
SeqDirection dir =>
a -> DirectionalSeq dir b -> DirectionalSeq dir a
forall dir a b.
SeqDirection dir =>
(a -> b) -> DirectionalSeq dir a -> DirectionalSeq dir b
forall a b. a -> DirectionalSeq dir b -> DirectionalSeq dir a
forall a b.
(a -> b) -> DirectionalSeq dir a -> DirectionalSeq dir b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DirectionalSeq dir b -> DirectionalSeq dir a
$c<$ :: forall dir a b.
SeqDirection dir =>
a -> DirectionalSeq dir b -> DirectionalSeq dir a
fmap :: (a -> b) -> DirectionalSeq dir a -> DirectionalSeq dir b
$cfmap :: forall dir a b.
SeqDirection dir =>
(a -> b) -> DirectionalSeq dir a -> DirectionalSeq dir b
Functor, DirectionalSeq dir a -> Bool
(a -> m) -> DirectionalSeq dir a -> m
(a -> b -> b) -> b -> DirectionalSeq dir a -> b
(forall m. Monoid m => DirectionalSeq dir m -> m)
-> (forall m a. Monoid m => (a -> m) -> DirectionalSeq dir a -> m)
-> (forall m a. Monoid m => (a -> m) -> DirectionalSeq dir a -> m)
-> (forall a b. (a -> b -> b) -> b -> DirectionalSeq dir a -> b)
-> (forall a b. (a -> b -> b) -> b -> DirectionalSeq dir a -> b)
-> (forall b a. (b -> a -> b) -> b -> DirectionalSeq dir a -> b)
-> (forall b a. (b -> a -> b) -> b -> DirectionalSeq dir a -> b)
-> (forall a. (a -> a -> a) -> DirectionalSeq dir a -> a)
-> (forall a. (a -> a -> a) -> DirectionalSeq dir a -> a)
-> (forall a. DirectionalSeq dir a -> [a])
-> (forall a. DirectionalSeq dir a -> Bool)
-> (forall a. DirectionalSeq dir a -> Int)
-> (forall a. Eq a => a -> DirectionalSeq dir a -> Bool)
-> (forall a. Ord a => DirectionalSeq dir a -> a)
-> (forall a. Ord a => DirectionalSeq dir a -> a)
-> (forall a. Num a => DirectionalSeq dir a -> a)
-> (forall a. Num a => DirectionalSeq dir a -> a)
-> Foldable (DirectionalSeq dir)
forall a. Eq a => a -> DirectionalSeq dir a -> Bool
forall a. Num a => DirectionalSeq dir a -> a
forall a. Ord a => DirectionalSeq dir a -> a
forall m. Monoid m => DirectionalSeq dir m -> m
forall a. DirectionalSeq dir a -> Bool
forall a. DirectionalSeq dir a -> Int
forall a. DirectionalSeq dir a -> [a]
forall dir a.
(SeqDirection dir, Eq a) =>
a -> DirectionalSeq dir a -> Bool
forall dir a.
(SeqDirection dir, Num a) =>
DirectionalSeq dir a -> a
forall dir a.
(SeqDirection dir, Ord a) =>
DirectionalSeq dir a -> a
forall dir m.
(SeqDirection dir, Monoid m) =>
DirectionalSeq dir m -> m
forall dir a. SeqDirection dir => DirectionalSeq dir a -> Bool
forall dir a. SeqDirection dir => DirectionalSeq dir a -> Int
forall dir a. SeqDirection dir => DirectionalSeq dir a -> [a]
forall dir a.
SeqDirection dir =>
(a -> a -> a) -> DirectionalSeq dir a -> a
forall dir m a.
(SeqDirection dir, Monoid m) =>
(a -> m) -> DirectionalSeq dir a -> m
forall dir b a.
SeqDirection dir =>
(b -> a -> b) -> b -> DirectionalSeq dir a -> b
forall dir a b.
SeqDirection dir =>
(a -> b -> b) -> b -> DirectionalSeq dir a -> b
forall a. (a -> a -> a) -> DirectionalSeq dir a -> a
forall m a. Monoid m => (a -> m) -> DirectionalSeq dir a -> m
forall b a. (b -> a -> b) -> b -> DirectionalSeq dir a -> b
forall a b. (a -> b -> b) -> b -> DirectionalSeq dir a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: DirectionalSeq dir a -> a
$cproduct :: forall dir a.
(SeqDirection dir, Num a) =>
DirectionalSeq dir a -> a
sum :: DirectionalSeq dir a -> a
$csum :: forall dir a.
(SeqDirection dir, Num a) =>
DirectionalSeq dir a -> a
minimum :: DirectionalSeq dir a -> a
$cminimum :: forall dir a.
(SeqDirection dir, Ord a) =>
DirectionalSeq dir a -> a
maximum :: DirectionalSeq dir a -> a
$cmaximum :: forall dir a.
(SeqDirection dir, Ord a) =>
DirectionalSeq dir a -> a
elem :: a -> DirectionalSeq dir a -> Bool
$celem :: forall dir a.
(SeqDirection dir, Eq a) =>
a -> DirectionalSeq dir a -> Bool
length :: DirectionalSeq dir a -> Int
$clength :: forall dir a. SeqDirection dir => DirectionalSeq dir a -> Int
null :: DirectionalSeq dir a -> Bool
$cnull :: forall dir a. SeqDirection dir => DirectionalSeq dir a -> Bool
toList :: DirectionalSeq dir a -> [a]
$ctoList :: forall dir a. SeqDirection dir => DirectionalSeq dir a -> [a]
foldl1 :: (a -> a -> a) -> DirectionalSeq dir a -> a
$cfoldl1 :: forall dir a.
SeqDirection dir =>
(a -> a -> a) -> DirectionalSeq dir a -> a
foldr1 :: (a -> a -> a) -> DirectionalSeq dir a -> a
$cfoldr1 :: forall dir a.
SeqDirection dir =>
(a -> a -> a) -> DirectionalSeq dir a -> a
foldl' :: (b -> a -> b) -> b -> DirectionalSeq dir a -> b
$cfoldl' :: forall dir b a.
SeqDirection dir =>
(b -> a -> b) -> b -> DirectionalSeq dir a -> b
foldl :: (b -> a -> b) -> b -> DirectionalSeq dir a -> b
$cfoldl :: forall dir b a.
SeqDirection dir =>
(b -> a -> b) -> b -> DirectionalSeq dir a -> b
foldr' :: (a -> b -> b) -> b -> DirectionalSeq dir a -> b
$cfoldr' :: forall dir a b.
SeqDirection dir =>
(a -> b -> b) -> b -> DirectionalSeq dir a -> b
foldr :: (a -> b -> b) -> b -> DirectionalSeq dir a -> b
$cfoldr :: forall dir a b.
SeqDirection dir =>
(a -> b -> b) -> b -> DirectionalSeq dir a -> b
foldMap' :: (a -> m) -> DirectionalSeq dir a -> m
$cfoldMap' :: forall dir m a.
(SeqDirection dir, Monoid m) =>
(a -> m) -> DirectionalSeq dir a -> m
foldMap :: (a -> m) -> DirectionalSeq dir a -> m
$cfoldMap :: forall dir m a.
(SeqDirection dir, Monoid m) =>
(a -> m) -> DirectionalSeq dir a -> m
fold :: DirectionalSeq dir m -> m
$cfold :: forall dir m.
(SeqDirection dir, Monoid m) =>
DirectionalSeq dir m -> m
Foldable, Functor (DirectionalSeq dir)
Foldable (DirectionalSeq dir)
Functor (DirectionalSeq dir)
-> Foldable (DirectionalSeq dir)
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DirectionalSeq dir a -> f (DirectionalSeq dir b))
-> (forall (f :: * -> *) a.
Applicative f =>
DirectionalSeq dir (f a) -> f (DirectionalSeq dir a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DirectionalSeq dir a -> m (DirectionalSeq dir b))
-> (forall (m :: * -> *) a.
Monad m =>
DirectionalSeq dir (m a) -> m (DirectionalSeq dir a))
-> Traversable (DirectionalSeq dir)
(a -> f b) -> DirectionalSeq dir a -> f (DirectionalSeq dir b)
forall dir. SeqDirection dir => Functor (DirectionalSeq dir)
forall dir. SeqDirection dir => Foldable (DirectionalSeq dir)
forall dir (m :: * -> *) a.
(SeqDirection dir, Monad m) =>
DirectionalSeq dir (m a) -> m (DirectionalSeq dir a)
forall dir (f :: * -> *) a.
(SeqDirection dir, Applicative f) =>
DirectionalSeq dir (f a) -> f (DirectionalSeq dir a)
forall dir (m :: * -> *) a b.
(SeqDirection dir, Monad m) =>
(a -> m b) -> DirectionalSeq dir a -> m (DirectionalSeq dir b)
forall dir (f :: * -> *) a b.
(SeqDirection dir, Applicative f) =>
(a -> f b) -> DirectionalSeq dir a -> f (DirectionalSeq dir b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
DirectionalSeq dir (m a) -> m (DirectionalSeq dir a)
forall (f :: * -> *) a.
Applicative f =>
DirectionalSeq dir (f a) -> f (DirectionalSeq dir a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> DirectionalSeq dir a -> m (DirectionalSeq dir b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DirectionalSeq dir a -> f (DirectionalSeq dir b)
sequence :: DirectionalSeq dir (m a) -> m (DirectionalSeq dir a)
$csequence :: forall dir (m :: * -> *) a.
(SeqDirection dir, Monad m) =>
DirectionalSeq dir (m a) -> m (DirectionalSeq dir a)
mapM :: (a -> m b) -> DirectionalSeq dir a -> m (DirectionalSeq dir b)
$cmapM :: forall dir (m :: * -> *) a b.
(SeqDirection dir, Monad m) =>
(a -> m b) -> DirectionalSeq dir a -> m (DirectionalSeq dir b)
sequenceA :: DirectionalSeq dir (f a) -> f (DirectionalSeq dir a)
$csequenceA :: forall dir (f :: * -> *) a.
(SeqDirection dir, Applicative f) =>
DirectionalSeq dir (f a) -> f (DirectionalSeq dir a)
traverse :: (a -> f b) -> DirectionalSeq dir a -> f (DirectionalSeq dir b)
$ctraverse :: forall dir (f :: * -> *) a b.
(SeqDirection dir, Applicative f) =>
(a -> f b) -> DirectionalSeq dir a -> f (DirectionalSeq dir b)
$cp2Traversable :: forall dir. SeqDirection dir => Foldable (DirectionalSeq dir)
$cp1Traversable :: forall dir. SeqDirection dir => Functor (DirectionalSeq dir)
Traversable)
emptyDirSeq :: DirectionalSeq dir a
emptyDirSeq :: DirectionalSeq dir a
emptyDirSeq = Seq a -> DirectionalSeq dir a
forall dir a. Seq a -> DirectionalSeq dir a
DSeq Seq a
forall a. Monoid a => a
mempty
appendDirSeq :: DirectionalSeq dir a -> DirectionalSeq dir a -> DirectionalSeq dir a
appendDirSeq :: DirectionalSeq dir a
-> DirectionalSeq dir a -> DirectionalSeq dir a
appendDirSeq DirectionalSeq dir a
a DirectionalSeq dir a
b = Seq a -> DirectionalSeq dir a
forall dir a. Seq a -> DirectionalSeq dir a
DSeq (Seq a -> DirectionalSeq dir a) -> Seq a -> DirectionalSeq dir a
forall a b. (a -> b) -> a -> b
$ Seq a -> Seq a -> Seq a
forall a. Monoid a => a -> a -> a
mappend (DirectionalSeq dir a -> Seq a
forall dir a. DirectionalSeq dir a -> Seq a
dseq DirectionalSeq dir a
a) (DirectionalSeq dir a -> Seq a
forall dir a. DirectionalSeq dir a -> Seq a
dseq DirectionalSeq dir a
b)
onDirectedSeq :: SeqDirection dir => (Seq a -> Seq b)
-> DirectionalSeq dir a -> DirectionalSeq dir b
onDirectedSeq :: (Seq a -> Seq b) -> DirectionalSeq dir a -> DirectionalSeq dir b
onDirectedSeq Seq a -> Seq b
f = Seq b -> DirectionalSeq dir b
forall dir a. Seq a -> DirectionalSeq dir a
DSeq (Seq b -> DirectionalSeq dir b)
-> (DirectionalSeq dir a -> Seq b)
-> DirectionalSeq dir a
-> DirectionalSeq dir b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> Seq b
f (Seq a -> Seq b)
-> (DirectionalSeq dir a -> Seq a) -> DirectionalSeq dir a -> Seq b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirectionalSeq dir a -> Seq a
forall dir a. DirectionalSeq dir a -> Seq a
dseq
onDirSeqSubset :: SeqDirection dir =>
(e -> Bool) -> (e -> Bool)
-> (DirectionalSeq dir e -> (DirectionalSeq dir e, a))
-> DirectionalSeq dir e
-> (DirectionalSeq dir e, a)
onDirSeqSubset :: (e -> Bool)
-> (e -> Bool)
-> (DirectionalSeq dir e -> (DirectionalSeq dir e, a))
-> DirectionalSeq dir e
-> (DirectionalSeq dir e, a)
onDirSeqSubset e -> Bool
startPred e -> Bool
endPred DirectionalSeq dir e -> (DirectionalSeq dir e, a)
op DirectionalSeq dir e
entries =
let ml :: Seq e
ml = DirectionalSeq dir e -> Seq e
forall dir a. DirectionalSeq dir a -> Seq a
dseq DirectionalSeq dir e
entries
(Seq e
bl, Seq e
ml1) = (e -> Bool) -> Seq e -> (Seq e, Seq e)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.breakl e -> Bool
startPred Seq e
ml
(Seq e
ml2, Seq e
el) = (e -> Bool) -> Seq e -> (Seq e, Seq e)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.breakl e -> Bool
endPred Seq e
ml1
(Seq e
ml2', Seq e
el') = if Bool -> Bool
not (Seq e -> Bool
forall a. Seq a -> Bool
Seq.null Seq e
el)
then (Seq e
ml2 Seq e -> Seq e -> Seq e
forall a. Semigroup a => a -> a -> a
<> Int -> Seq e -> Seq e
forall a. Int -> Seq a -> Seq a
Seq.take Int
1 Seq e
el, Int -> Seq e -> Seq e
forall a. Int -> Seq a -> Seq a
Seq.drop Int
1 Seq e
el)
else (Seq e
ml2, Seq e
el)
(DirectionalSeq dir e
ml3, a
rval) = DirectionalSeq dir e -> (DirectionalSeq dir e, a)
op (DirectionalSeq dir e -> (DirectionalSeq dir e, a))
-> DirectionalSeq dir e -> (DirectionalSeq dir e, a)
forall a b. (a -> b) -> a -> b
$ Seq e -> DirectionalSeq dir e
forall dir a. Seq a -> DirectionalSeq dir a
DSeq Seq e
ml2'
in (Seq e -> DirectionalSeq dir e
forall dir a. Seq a -> DirectionalSeq dir a
DSeq Seq e
bl DirectionalSeq dir e
-> DirectionalSeq dir e -> DirectionalSeq dir e
forall dir a.
DirectionalSeq dir a
-> DirectionalSeq dir a -> DirectionalSeq dir a
`appendDirSeq` DirectionalSeq dir e
ml3 DirectionalSeq dir e
-> DirectionalSeq dir e -> DirectionalSeq dir e
forall dir a.
DirectionalSeq dir a
-> DirectionalSeq dir a -> DirectionalSeq dir a
`appendDirSeq` Seq e -> DirectionalSeq dir e
forall dir a. Seq a -> DirectionalSeq dir a
DSeq Seq e
el', a
rval)
dirSeqBreakl :: SeqDirection dir =>
(e -> Bool) -> DirectionalSeq dir e
-> (DirectionalSeq dir e, DirectionalSeq dir e)
dirSeqBreakl :: (e -> Bool)
-> DirectionalSeq dir e
-> (DirectionalSeq dir e, DirectionalSeq dir e)
dirSeqBreakl e -> Bool
isMatch DirectionalSeq dir e
entries =
let (Seq e
removed, Seq e
remaining) = (e -> Bool) -> Seq e -> (Seq e, Seq e)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.breakl e -> Bool
isMatch (Seq e -> (Seq e, Seq e)) -> Seq e -> (Seq e, Seq e)
forall a b. (a -> b) -> a -> b
$ DirectionalSeq dir e -> Seq e
forall dir a. DirectionalSeq dir a -> Seq a
dseq DirectionalSeq dir e
entries
in (Seq e -> DirectionalSeq dir e
forall dir a. Seq a -> DirectionalSeq dir a
DSeq Seq e
removed, Seq e -> DirectionalSeq dir e
forall dir a. Seq a -> DirectionalSeq dir a
DSeq Seq e
remaining)
dirSeqPartition :: SeqDirection dir =>
(e -> Bool) -> DirectionalSeq dir e
-> (DirectionalSeq dir e, DirectionalSeq dir e)
dirSeqPartition :: (e -> Bool)
-> DirectionalSeq dir e
-> (DirectionalSeq dir e, DirectionalSeq dir e)
dirSeqPartition e -> Bool
isMatch DirectionalSeq dir e
entries =
let (Seq e
match, Seq e
nomatch) = (e -> Bool) -> Seq e -> (Seq e, Seq e)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.partition e -> Bool
isMatch (Seq e -> (Seq e, Seq e)) -> Seq e -> (Seq e, Seq e)
forall a b. (a -> b) -> a -> b
$ DirectionalSeq dir e -> Seq e
forall dir a. DirectionalSeq dir a -> Seq a
dseq DirectionalSeq dir e
entries
in (Seq e -> DirectionalSeq dir e
forall dir a. Seq a -> DirectionalSeq dir a
DSeq Seq e
match, Seq e -> DirectionalSeq dir e
forall dir a. Seq a -> DirectionalSeq dir a
DSeq Seq e
nomatch)
withDirSeqHead :: SeqDirection dir => (e -> r) -> DirectionalSeq dir e -> Maybe r
withDirSeqHead :: (e -> r) -> DirectionalSeq dir e -> Maybe r
withDirSeqHead e -> r
op DirectionalSeq dir e
entries =
case Seq e -> ViewL e
forall a. Seq a -> ViewL a
Seq.viewl (DirectionalSeq dir e -> Seq e
forall dir a. DirectionalSeq dir a -> Seq a
dseq DirectionalSeq dir e
entries) of
ViewL e
Seq.EmptyL -> Maybe r
forall a. Maybe a
Nothing
e
e Seq.:< Seq e
_ -> r -> Maybe r
forall a. a -> Maybe a
Just (r -> Maybe r) -> r -> Maybe r
forall a b. (a -> b) -> a -> b
$ e -> r
op e
e