{-# LANGUAGE CPP                                #-}
{-# LANGUAGE NoDeriveAnyClass                   #-}
{-# LANGUAGE QuantifiedConstraints              #-}
{-# LANGUAGE TypeFamilies                       #-}
{-# OPTIONS_GHC -Wno-orphans                    #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}

-- |
-- Module      : AOC.Common
-- Copyright   : (c) Justin Le 2019
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Common functions for solutions
--

module AOC.Common (
    trace'
  -- * Loops and searches
  , iterateMaybe
  , loopMaybe
  , loopMaybeM
  , loopEither
  , firstJust
  , (!!!)
  , strictIterate
  , (!?)
  , drop'
  , dup
  , scanlT
  , scanrT
  , firstRepeated
  , firstRepeatedBy
  , fixedPoint
  , floodFill
  , floodFillCount
  , countTrue
  , pickUnique
  -- * Lists
  , freqs
  , lookupFreq
  , freqList
  , revFreq
  , perturbations
  , perturbationsBy
  , select
  , slidingWindows
  , sortedSlidingWindows
  , sortedSlidingWindowsInt
  , clearOut
  , foldMapPar
  , foldMapPar1
  , foldMapParChunk
  , meanVar
  , maximumVal
  , maximumValBy
  , minimumVal
  , minimumValBy
  , maximumValNE
  , maximumValByNE
  , minimumValNE
  , minimumValByNE
  , listTup
  , _ListTup
  , listTup3
  , _ListTup3
  , listTup4
  , _ListTup4
  , sortSizedBy
  , withAllSized
  , binaryFold
  , binaryFoldPar
  -- * Simple type util
  , deleteFinite
  , Letter
  , charFinite
  , _CharFinite
  , hexDigit
  , decimalDigit
  , splitWord
  , digitToIntSafe
  , caeser
  , eitherItem
  -- , getDown
  , toNatural
  , factorial
  , integerFactorial
  , mapMaybeSet
  , symDiff
  , unfoldedIterate
  , memo4
  -- * Parsers
  , TokStream(..)
  , parseTokStream
  , parseTokStream_
  , parseTokStreamT
  , parseTokStreamT_
  , TokParser
  , parseWords
  , nextMatch
  , parseMaybeLenient
  , parseOrFail
  , CharParser
  , pWord
  , pHWord
  , pDecimal
  , pTok
  , pSpace
  , parseLines
  -- * Graph
  , Graph
  , toFGL
  -- * Recursion Schemes
  , anaM
#if !MIN_VERSION_recursion_schemes(5,2,0)
  , TreeF(..), ForestF
#endif
  ) where

import           AOC.Util
import           Control.Applicative
import           Control.Comonad.Store
import           Control.Lens
import           Control.Monad
import           Control.Monad.ST
import           Control.Monad.State
import           Control.Parallel.Strategies
import           Data.Bifunctor
import           Data.Char
import           Data.Coerce
import           Data.Finite
import           Data.Finite.Internal
import           Data.Foldable
import           Data.Function
import           Data.Functor.Compose
import           Data.Hashable
import           Data.IntMap                        (IntMap)
import           Data.List                          (uncons, sortOn)
import           Data.List.NonEmpty                 (NonEmpty(..))
import           Data.List.Split
import           Data.Map                           (Map)
import           Data.Map.NonEmpty                  (NEMap)
import           Data.Maybe
import           Data.Ord
import           Data.Semigroup
import           Data.Sequence                      (Seq(..))
import           Data.Set                           (Set)
import           Data.Set.NonEmpty                  (NESet)
import           Data.Traversable
import           Data.Tree                          (Tree(..))
import           Data.Tuple
import           Data.Void
import           Data.Word
import           Debug.Trace
import           GHC.Generics                       (Generic, (:*:)(..))
import           GHC.TypeNats
import           Linear                             (V2(..), V3(..), V4(..), R1(..), R2(..), R3(..), R4(..))
import           Numeric.Natural
import qualified Control.Foldl                      as F
import qualified Control.Monad.Combinators          as P
import qualified Data.Conduino                      as C
import qualified Data.Conduino.Combinators          as C
import qualified Data.Finitary                      as F
import qualified Data.Functor.Foldable              as R
import qualified Data.Functor.Foldable.TH           as R
import qualified Data.Graph.Inductive               as G
import qualified Data.IntMap                        as IM
import qualified Data.IntPSQ                        as IntPSQ
import qualified Data.List.NonEmpty                 as NE
import qualified Data.Map                           as M
import qualified Data.Map.NonEmpty                  as NEM
import qualified Data.MemoCombinators               as Memo
import qualified Data.OrdPSQ                        as OrdPSQ
import qualified Data.Sequence                      as Seq
import qualified Data.Set                           as S
import qualified Data.Set.NonEmpty                  as NES
import qualified Data.Type.Nat                      as N
import qualified Data.Vector.Algorithms.Intro       as VAI
import qualified Data.Vector.Generic                as VG
import qualified Data.Vector.Generic.Sized          as SVG
import qualified Data.Vector.Generic.Sized.Internal as SVG
import qualified Text.Megaparsec                    as P
import qualified Text.Megaparsec.Char               as P
import qualified Text.Megaparsec.Char.Lexer         as PL

-- | trace but only after something has evaluated to WHNF
trace' :: String -> a -> a
trace' :: forall a. String -> a -> a
trace' String
str a
x = String -> a -> a
forall a. String -> a -> a
trace (a
x a -> String -> String
`seq` String
str) a
x

-- | Strict (!!)
(!!!) :: [a] -> Int -> a
[] !!! :: forall a. [a] -> Int -> a
!!! Int
_ = String -> a
forall a. HasCallStack => String -> a
error String
"Out of range"
(a
x:[a]
_ ) !!! Int
0 = a
x
(a
x:[a]
xs) !!! Int
n = a
x a -> a -> a
`seq` ([a]
xs [a] -> Int -> a
forall a. [a] -> Int -> a
!!! (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

strictIterate :: (a -> a) -> a -> [a]
strictIterate :: forall a. (a -> a) -> a -> [a]
strictIterate a -> a
f = a -> [a]
go
  where
    go :: a -> [a]
go !a
x = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a]
go (a -> a
f a
x)

-- | Strict drop
drop' :: Int -> [a] -> [a]
drop' :: forall a. Int -> [a] -> [a]
drop' Int
0 [a]
xs     = [a]
xs
drop' Int
_ []     = []
drop' Int
n (a
x:[a]
xs) = a
x a -> [a] -> [a]
`seq` Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
xs

-- | Iterate until a 'Nothing' is produced
iterateMaybe :: (a -> Maybe a) -> a -> [a]
iterateMaybe :: forall a. (a -> Maybe a) -> a -> [a]
iterateMaybe a -> Maybe a
f = a -> [a]
go
  where
    go :: a -> [a]
go !a
x = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: case a -> Maybe a
f a
x of
      Maybe a
Nothing -> []
      Just a
y  -> a -> [a]
go a
y

(!?) :: [a] -> Int -> Maybe a
[]     !? :: forall a. [a] -> Int -> Maybe a
!? Int
_ = Maybe a
forall a. Maybe a
Nothing
(a
x:[a]
_ ) !? Int
0 = a -> Maybe a
forall a. a -> Maybe a
Just a
x
(a
x:[a]
xs) !? Int
n = a
x a -> Maybe a -> Maybe a
`seq` ([a]
xs [a] -> Int -> Maybe a
forall a. [a] -> Int -> Maybe a
!? (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

-- | Apply function until 'Nothing' is produced, and return last produced
-- value.
loopMaybe
    :: (a -> Maybe a)
    -> a
    -> a
loopMaybe :: forall a. (a -> Maybe a) -> a -> a
loopMaybe a -> Maybe a
f = a -> a
go
  where
    go :: a -> a
go !a
x = case a -> Maybe a
f a
x of
      Maybe a
Nothing -> a
x
      Just !a
y -> a -> a
go a
y

-- | Apply function until a 'Left'.
loopEither
    :: (a -> Either r a)
    -> a
    -> r
loopEither :: forall a r. (a -> Either r a) -> a -> r
loopEither a -> Either r a
f = a -> r
go
  where
    go :: a -> r
go !a
x = case a -> Either r a
f a
x of
      Left  r
r  -> r
r
      Right !a
y -> a -> r
go a
y


-- | Apply monadic function until 'Nothing' is produced, and return last produced
-- value.
loopMaybeM
    :: Monad m
    => (a -> m (Maybe a))
    -> a
    -> m a
loopMaybeM :: forall (m :: * -> *) a. Monad m => (a -> m (Maybe a)) -> a -> m a
loopMaybeM a -> m (Maybe a)
f = a -> m a
go
  where
    go :: a -> m a
go !a
x = a -> m (Maybe a)
f a
x m (Maybe a) -> (Maybe a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe a
Nothing -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
      Just !a
y -> a -> m a
go a
y

-- | A tuple of the same item twice
dup :: a -> (a, a)
dup :: forall a. a -> (a, a)
dup a
x = (a
x, a
x)

-- | 'scanl' generalized to all 'Traversable'.
scanlT :: Traversable t => (b -> a -> b) -> b -> t a -> t b
scanlT :: forall (t :: * -> *) b a.
Traversable t =>
(b -> a -> b) -> b -> t a -> t b
scanlT b -> a -> b
f b
z = (b, t b) -> t b
forall a b. (a, b) -> b
snd ((b, t b) -> t b) -> (t a -> (b, t b)) -> t a -> t b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a -> (b, b)) -> b -> t a -> (b, t b)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (\b
x -> b -> (b, b)
forall a. a -> (a, a)
dup (b -> (b, b)) -> (a -> b) -> a -> (b, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a -> b
f b
x) b
z

-- | 'scanr' generalized to all 'Traversable'.
scanrT :: Traversable t => (a -> b -> b) -> b -> t a -> t b
scanrT :: forall (t :: * -> *) a b.
Traversable t =>
(a -> b -> b) -> b -> t a -> t b
scanrT a -> b -> b
f b
z = (b, t b) -> t b
forall a b. (a, b) -> b
snd ((b, t b) -> t b) -> (t a -> (b, t b)) -> t a -> t b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a -> (b, b)) -> b -> t a -> (b, t b)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumR (\b
x -> b -> (b, b)
forall a. a -> (a, a)
dup (b -> (b, b)) -> (a -> b) -> a -> (b, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> b -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
f b
x) b
z

-- | Lazily find the first repeated item.
firstRepeated :: Ord a => [a] -> Maybe a
firstRepeated :: forall a. Ord a => [a] -> Maybe a
firstRepeated = (a -> a) -> [a] -> Maybe a
forall a b. Ord a => (b -> a) -> [b] -> Maybe b
firstRepeatedBy a -> a
forall a. a -> a
id

-- | Lazily find the first repeated projection.
firstRepeatedBy :: Ord a => (b -> a) -> [b] -> Maybe b
firstRepeatedBy :: forall a b. Ord a => (b -> a) -> [b] -> Maybe b
firstRepeatedBy b -> a
f = Set a -> [b] -> Maybe b
go Set a
forall a. Set a
S.empty
  where
    go :: Set a -> [b] -> Maybe b
go Set a
seen (b
x:[b]
xs)
      | b -> a
f b
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
seen = b -> Maybe b
forall a. a -> Maybe a
Just b
x
      | Bool
otherwise           = Set a -> [b] -> Maybe b
go (b -> a
f b
x a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
`S.insert` Set a
seen) [b]
xs
    go Set a
_ []     = Maybe b
forall a. Maybe a
Nothing


-- | Repeat a function until you get the same result twice.
fixedPoint :: Eq a => (a -> a) -> a -> a
fixedPoint :: forall a. Eq a => (a -> a) -> a -> a
fixedPoint a -> a
f = a -> a
go
  where
    go :: a -> a
go !a
x
        | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y    = a
x
        | Bool
otherwise = a -> a
go a
y
      where
        y :: a
y = a -> a
f a
x

-- | Count the number of items in a container where the predicate is true.
countTrue :: Foldable f => (a -> Bool) -> f a -> Int
countTrue :: forall (f :: * -> *) a. Foldable f => (a -> Bool) -> f a -> Int
countTrue a -> Bool
p = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> (f a -> [a]) -> f a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p ([a] -> [a]) -> (f a -> [a]) -> f a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | Given a map of @k@ to possible @a@s for that @k@, find possible
-- configurations where each @k@ is given its own unique @a@.
pickUnique :: (Ord k, Ord a) => [(k, Set a)] -> [Map k a]
pickUnique :: forall k a. (Ord k, Ord a) => [(k, Set a)] -> [Map k a]
pickUnique [(k, Set a)]
mp = (StateT (Set a) [] (Map k a) -> Set a -> [Map k a])
-> Set a -> StateT (Set a) [] (Map k a) -> [Map k a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (Set a) [] (Map k a) -> Set a -> [Map k a]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Set a
forall a. Set a
S.empty (StateT (Set a) [] (Map k a) -> [Map k a])
-> StateT (Set a) [] (Map k a) -> [Map k a]
forall a b. (a -> b) -> a -> b
$ do
    ([(k, a)] -> Map k a)
-> StateT (Set a) [] [(k, a)] -> StateT (Set a) [] (Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (StateT (Set a) [] [(k, a)] -> StateT (Set a) [] (Map k a))
-> ((Set a -> StateT (Set a) [] a) -> StateT (Set a) [] [(k, a)])
-> (Set a -> StateT (Set a) [] a)
-> StateT (Set a) [] (Map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, Set a)]
-> ((k, Set a) -> StateT (Set a) [] (k, a))
-> StateT (Set a) [] [(k, a)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(k, Set a)]
opts (((k, Set a) -> StateT (Set a) [] (k, a))
 -> StateT (Set a) [] [(k, a)])
-> ((Set a -> StateT (Set a) [] a)
    -> (k, Set a) -> StateT (Set a) [] (k, a))
-> (Set a -> StateT (Set a) [] a)
-> StateT (Set a) [] [(k, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set a -> StateT (Set a) [] a)
-> (k, Set a) -> StateT (Set a) [] (k, a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Set a -> StateT (Set a) [] a) -> StateT (Set a) [] (Map k a))
-> (Set a -> StateT (Set a) [] a) -> StateT (Set a) [] (Map k a)
forall a b. (a -> b) -> a -> b
$ \Set a
poss -> do
      Set a
seen <- StateT (Set a) [] (Set a)
forall s (m :: * -> *). MonadState s m => m s
get
      a
pick <- [a] -> StateT (Set a) [] a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([a] -> StateT (Set a) [] a) -> [a] -> StateT (Set a) [] a
forall a b. (a -> b) -> a -> b
$ Set a -> [a]
forall a. Set a -> [a]
S.toList (Set a
poss Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set a
seen)
      a
pick a -> StateT (Set a) [] () -> StateT (Set a) [] a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Set a -> Set a) -> StateT (Set a) [] ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
pick)
  where
    opts :: [(k, Set a)]
opts = ((k, Set a) -> Int) -> [(k, Set a)] -> [(k, Set a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Set a -> Int
forall a. Set a -> Int
S.size (Set a -> Int) -> ((k, Set a) -> Set a) -> (k, Set a) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, Set a) -> Set a
forall a b. (a, b) -> b
snd) [(k, Set a)]
mp


-- | Build a frequency map
freqs :: (Foldable f, Ord a) => f a -> Map a Int
freqs :: forall (f :: * -> *) a. (Foldable f, Ord a) => f a -> Map a Int
freqs = (Int -> Int -> Int) -> [(a, Int)] -> Map a Int
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ([(a, Int)] -> Map a Int)
-> (f a -> [(a, Int)]) -> f a -> Map a Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, Int)) -> [a] -> [(a, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (,Int
1) ([a] -> [(a, Int)]) -> (f a -> [a]) -> f a -> [(a, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | each item paired with the list not including that item
select :: [a] -> [(a,[a])]
select :: forall a. [a] -> [(a, [a])]
select = [a] -> [a] -> [(a, [a])]
forall {a}. [a] -> [a] -> [(a, [a])]
go []
  where
    go :: [a] -> [a] -> [(a, [a])]
go [a]
_  [] = []
    go [a]
xs (a
y:[a]
ys) = (a
y,[a]
xs[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
ys) (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [(a, [a])]
go (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys

-- | Look up a count from a frequency map, defaulting to zero if item is
-- not foudn
lookupFreq :: Ord a => a -> Map a Int -> Int
lookupFreq :: forall a. Ord a => a -> Map a Int -> Int
lookupFreq = Int -> a -> Map a Int -> Int
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Int
0

-- | Build a reverse frequency map
revFreq :: (Foldable f, Ord a) => f a -> IntMap (NESet a)
revFreq :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
f a -> IntMap (NESet a)
revFreq = (NESet a -> NESet a -> NESet a)
-> [(Int, NESet a)] -> IntMap (NESet a)
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith NESet a -> NESet a -> NESet a
forall a. Semigroup a => a -> a -> a
(<>)
        ([(Int, NESet a)] -> IntMap (NESet a))
-> (f a -> [(Int, NESet a)]) -> f a -> IntMap (NESet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Int) -> (Int, NESet a)) -> [(a, Int)] -> [(Int, NESet a)]
forall a b. (a -> b) -> [a] -> [b]
map ((NESet a, Int) -> (Int, NESet a)
forall a b. (a, b) -> (b, a)
swap ((NESet a, Int) -> (Int, NESet a))
-> ((a, Int) -> (NESet a, Int)) -> (a, Int) -> (Int, NESet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> NESet a) -> (a, Int) -> (NESet a, Int)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> NESet a
forall a. a -> NESet a
NES.singleton)
        ([(a, Int)] -> [(Int, NESet a)])
-> (f a -> [(a, Int)]) -> f a -> [(Int, NESet a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a Int -> [(a, Int)]
forall k a. Map k a -> [(k, a)]
M.toList
        (Map a Int -> [(a, Int)])
-> (f a -> Map a Int) -> f a -> [(a, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Map a Int
forall (f :: * -> *) a. (Foldable f, Ord a) => f a -> Map a Int
freqs

-- | Build a list of /descending/ frequencies.  Ties are sorted.
freqList :: (Foldable f, Ord a) => f a -> [(Int, a)]
freqList :: forall (f :: * -> *) a. (Foldable f, Ord a) => f a -> [(Int, a)]
freqList = ((Int, NESet a) -> [(Int, a)]) -> [(Int, NESet a)] -> [(Int, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((NESet a -> [a]) -> (Int, NESet a) -> [(Int, a)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse NESet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) ([(Int, NESet a)] -> [(Int, a)])
-> (f a -> [(Int, NESet a)]) -> f a -> [(Int, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap (NESet a) -> [(Int, NESet a)]
forall a. IntMap a -> [(Int, a)]
IM.toDescList (IntMap (NESet a) -> [(Int, NESet a)])
-> (f a -> IntMap (NESet a)) -> f a -> [(Int, NESet a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> IntMap (NESet a)
forall (f :: * -> *) a.
(Foldable f, Ord a) =>
f a -> IntMap (NESet a)
revFreq

eitherItem :: Lens' (Either a a) a
eitherItem :: forall a. Lens' (Either a a) a
eitherItem a -> f a
f (Left a
x) = a -> Either a a
forall a b. a -> Either a b
Left (a -> Either a a) -> f a -> f (Either a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
x
eitherItem a -> f a
f (Right a
x) = a -> Either a a
forall a b. b -> Either a b
Right (a -> Either a a) -> f a -> f (Either a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
x

-- getDown :: Down a -> a
-- getDown (Down x) = x

splitWord :: Word8 -> (Finite 16, Finite 16)
splitWord :: Word8 -> (Finite 16, Finite 16)
splitWord = (Finite 16, Finite 16) -> (Finite 16, Finite 16)
forall a b. (a, b) -> (b, a)
swap ((Finite 16, Finite 16) -> (Finite 16, Finite 16))
-> (Word8 -> (Finite 16, Finite 16))
-> Word8
-> (Finite 16, Finite 16)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finite 256 -> (Finite 16, Finite 16)
forall (n :: Nat) (m :: Nat).
KnownNat n =>
Finite (n * m) -> (Finite n, Finite m)
separateProduct (Finite 256 -> (Finite 16, Finite 16))
-> (Word8 -> Finite 256) -> Word8 -> (Finite 16, Finite 16)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Finite 256
forall a. Finitary a => a -> Finite (Cardinality a)
F.toFinite

decimalDigit :: Prism' Char (Finite 10)
decimalDigit :: Prism' Char (Finite 10)
decimalDigit = (Finite 10 -> Char)
-> (Char -> Maybe (Finite 10)) -> Prism' Char (Finite 10)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Finite 10 -> Char
_to Char -> Maybe (Finite 10)
forall {n :: Nat}. Char -> Maybe (Finite n)
_from
  where
    _to :: Finite 10 -> Char
_to           = Int -> Char
intToDigit (Int -> Char) -> (Finite 10 -> Int) -> Finite 10 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finite 10 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    _from :: Char -> Maybe (Finite n)
_from Char
c
      | Char -> Bool
isDigit Char
c = Finite n -> Maybe (Finite n)
forall a. a -> Maybe a
Just (Integer -> Finite n
forall (n :: Nat). Integer -> Finite n
Finite (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
c)))
      | Bool
otherwise = Maybe (Finite n)
forall a. Maybe a
Nothing


hexDigit :: Prism' Char (Finite 16)
hexDigit :: Prism' Char (Finite 16)
hexDigit = (Finite 16 -> Char)
-> (Char -> Maybe (Finite 16)) -> Prism' Char (Finite 16)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Finite 16 -> Char
_to Char -> Maybe (Finite 16)
forall {n :: Nat}. Char -> Maybe (Finite n)
_from
  where
    _to :: Finite 16 -> Char
_to              = Int -> Char
intToDigit (Int -> Char) -> (Finite 16 -> Int) -> Finite 16 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Finite 16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    _from :: Char -> Maybe (Finite n)
_from Char
c
      | Char -> Bool
isHexDigit Char
c = Finite n -> Maybe (Finite n)
forall a. a -> Maybe a
Just (Integer -> Finite n
forall (n :: Nat). Integer -> Finite n
Finite (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
c)))
      | Bool
otherwise    = Maybe (Finite n)
forall a. Maybe a
Nothing

type Letter = Finite 26

-- | Parse a letter into a number 0 to 25.  Returns 'False' if lowercase
-- and 'True' if uppercase.
charFinite :: Char -> Maybe (Bool, Finite 26)
charFinite :: Char -> Maybe (Bool, Finite 26)
charFinite (Char -> Int
ord->Int
c) = [Maybe (Bool, Finite 26)] -> Maybe (Bool, Finite 26)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ (Bool
False,) (Finite 26 -> (Bool, Finite 26))
-> Maybe (Finite 26) -> Maybe (Bool, Finite 26)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Maybe (Finite 26)
forall (n :: Nat). KnownNat n => Integer -> Maybe (Finite n)
packFinite (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a'))
    , (Bool
True ,) (Finite 26 -> (Bool, Finite 26))
-> Maybe (Finite 26) -> Maybe (Bool, Finite 26)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Maybe (Finite 26)
forall (n :: Nat). KnownNat n => Integer -> Maybe (Finite n)
packFinite (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A'))
    ]

digitToIntSafe :: Char -> Maybe Int
digitToIntSafe :: Char -> Maybe Int
digitToIntSafe Char
c = Char -> Int
digitToInt Char
c Int -> Maybe () -> Maybe Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Char -> Bool
isDigit Char
c)

-- | Prism for a 'Char' as @('Bool', 'Finite' 26)@, where the 'Finite' is
-- the letter parsed as a number from 0 to 25, and the 'Bool' is lowercase
-- ('False') or uppercase ('True').
_CharFinite :: Prism' Char (Bool, Finite 26)
_CharFinite :: Prism' Char (Bool, Finite 26)
_CharFinite = ((Bool, Finite 26) -> Char)
-> (Char -> Maybe (Bool, Finite 26))
-> Prism' Char (Bool, Finite 26)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (Bool, Finite 26) -> Char
forall {a}. Integral a => (Bool, a) -> Char
fromcf Char -> Maybe (Bool, Finite 26)
charFinite
  where
    fromcf :: (Bool, a) -> Char
fromcf (Bool
c, a
x) = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
b
      where
        b :: Char
b | Bool
c         = Char
'A'
          | Bool
otherwise = Char
'a'

-- | Caeser shift, preserving case.  If you have an 'Int' or 'Integer',
-- convert into 'Finite' using 'modulo'.
caeser :: Finite 26 -> Char -> Char
caeser :: Finite 26 -> Char -> Char
caeser Finite 26
i = ASetter Char Char (Finite 26) (Finite 26)
-> (Finite 26 -> Finite 26) -> Char -> Char
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((Bool, Finite 26) -> Identity (Bool, Finite 26))
-> Char -> Identity Char
Prism' Char (Bool, Finite 26)
_CharFinite (((Bool, Finite 26) -> Identity (Bool, Finite 26))
 -> Char -> Identity Char)
-> ((Finite 26 -> Identity (Finite 26))
    -> (Bool, Finite 26) -> Identity (Bool, Finite 26))
-> ASetter Char Char (Finite 26) (Finite 26)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Finite 26 -> Identity (Finite 26))
-> (Bool, Finite 26) -> Identity (Bool, Finite 26)
forall s t a b. Field2 s t a b => Lens s t a b
_2) (Finite 26 -> Finite 26 -> Finite 26
forall a. Num a => a -> a -> a
+ Finite 26
i)


-- | Collect all possible single-item perturbations from a given
-- perturbing function.
--
-- > perturbations (\i -> [i - 1, i + 1]) [0,10,100]
--      == [ [-1,10,100]
--         , [ 1,10,100]
--         , [ 0, 9,100]
--         , [ 0,11,100]
--         , [ 0,10, 99]
--         , [ 0,10,101]
--         ]
perturbations
    :: Traversable f
    => (a -> [a])
    -> f a
    -> [f a]
perturbations :: forall (f :: * -> *) a. Traversable f => (a -> [a]) -> f a -> [f a]
perturbations = Over (->) (Bazaar (->) a a) (f a) (f a) a a
-> (a -> [a]) -> f a -> [f a]
forall (p :: * -> * -> *) a s t.
Conjoined p =>
Over p (Bazaar p a a) s t a a -> (a -> [a]) -> s -> [t]
perturbationsBy Over (->) (Bazaar (->) a a) (f a) (f a) a a
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse

-- | Collect all possible single-item perturbations from a given
-- perturbing function.
--
-- > perturbations (\i -> [i - 1, i + 1]) [0,10,100]
--      == [ [-1,10,100]
--         , [ 1,10,100]
--         , [ 0, 9,100]
--         , [ 0,11,100]
--         , [ 0,10, 99]
--         , [ 0,10,101]
--         ]
perturbationsBy
    :: Conjoined p
    => Over p (Bazaar p a a) s t a a
    -> (a -> [a])
    -> s
    -> [t]
perturbationsBy :: forall (p :: * -> * -> *) a s t.
Conjoined p =>
Over p (Bazaar p a a) s t a a -> (a -> [a]) -> s -> [t]
perturbationsBy Over p (Bazaar p a a) s t a a
p a -> [a]
f = (a -> [a]) -> Pretext p a a t -> [t]
forall s (w :: * -> *) (f :: * -> *) a.
(ComonadStore s w, Functor f) =>
(s -> f s) -> w a -> f a
experiment a -> [a]
f (Pretext p a a t -> [t]) -> (s -> [Pretext p a a t]) -> s -> [t]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Over p (Bazaar p a a) s t a a -> s -> [Pretext p a a t]
forall (p :: * -> * -> *) a s t.
Conjoined p =>
Over p (Bazaar p a a) s t a a -> s -> [Pretext p a a t]
holesOf Over p (Bazaar p a a) s t a a
p

-- | Clear out characters not matching a predicate
clearOut :: (Char -> Bool) -> String -> String
clearOut :: (Char -> Bool) -> String -> String
clearOut Char -> Bool
p = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> String -> String)
-> (Char -> Char) -> String -> String
forall a b. (a -> b) -> a -> b
$ \Char
c -> if Char -> Bool
p Char
c then Char
' '
                                else Char
c

-- | sliding windows of a given length
slidingWindows :: Int -> [a] -> [Seq a]
slidingWindows :: forall a. Int -> [a] -> [Seq a]
slidingWindows Int
n = (Seq a -> [a] -> [Seq a]) -> (Seq a, [a]) -> [Seq a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Seq a -> [a] -> [Seq a]
forall {a}. Seq a -> [a] -> [Seq a]
go ((Seq a, [a]) -> [Seq a])
-> ([a] -> (Seq a, [a])) -> [a] -> [Seq a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Seq a) -> ([a], [a]) -> (Seq a, [a])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList (([a], [a]) -> (Seq a, [a]))
-> ([a] -> ([a], [a])) -> [a] -> (Seq a, [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n
  where
    go :: Seq a -> [a] -> [Seq a]
go ws :: Seq a
ws@(a
_ :<| Seq a
qs) = \case
      a
x:[a]
xs -> Seq a
ws Seq a -> [Seq a] -> [Seq a]
forall a. a -> [a] -> [a]
: Seq a -> [a] -> [Seq a]
go (Seq a
qs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
:|> a
x) [a]
xs
      []   -> Seq a
ws Seq a -> [Seq a] -> [Seq a]
forall a. a -> [a] -> [a]
: []
    go Seq a
_  = [Seq a] -> [a] -> [Seq a]
forall a b. a -> b -> a
const []

-- | sorted windows of a given length
sortedSlidingWindows
    :: forall k v. Ord k
    => Int
    -> [(k,v)]
    -> [OrdPSQ.OrdPSQ k Int v]
sortedSlidingWindows :: forall k v. Ord k => Int -> [(k, v)] -> [OrdPSQ k Int v]
sortedSlidingWindows Int
n = (OrdPSQ k Int v -> [(k, Int, v)] -> [OrdPSQ k Int v])
-> (OrdPSQ k Int v, [(k, Int, v)]) -> [OrdPSQ k Int v]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry OrdPSQ k Int v -> [(k, Int, v)] -> [OrdPSQ k Int v]
go ((OrdPSQ k Int v, [(k, Int, v)]) -> [OrdPSQ k Int v])
-> ([(k, v)] -> (OrdPSQ k Int v, [(k, Int, v)]))
-> [(k, v)]
-> [OrdPSQ k Int v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(k, Int, v)] -> OrdPSQ k Int v)
-> ([(k, Int, v)], [(k, Int, v)])
-> (OrdPSQ k Int v, [(k, Int, v)])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [(k, Int, v)] -> OrdPSQ k Int v
forall k p v. (Ord k, Ord p) => [(k, p, v)] -> OrdPSQ k p v
OrdPSQ.fromList (([(k, Int, v)], [(k, Int, v)]) -> (OrdPSQ k Int v, [(k, Int, v)]))
-> ([(k, v)] -> ([(k, Int, v)], [(k, Int, v)]))
-> [(k, v)]
-> (OrdPSQ k Int v, [(k, Int, v)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(k, Int, v)] -> ([(k, Int, v)], [(k, Int, v)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n ([(k, Int, v)] -> ([(k, Int, v)], [(k, Int, v)]))
-> ([(k, v)] -> [(k, Int, v)])
-> [(k, v)]
-> ([(k, Int, v)], [(k, Int, v)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (k, v) -> (k, Int, v))
-> [Int] -> [(k, v)] -> [(k, Int, v)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (k, v) -> (k, Int, v)
forall {b} {a} {c}. b -> (a, c) -> (a, b, c)
reIx [Int
0..]
  where
    reIx :: b -> (a, c) -> (a, b, c)
reIx b
i (a
j,c
k) = (a
j, b
i, c
k)
    go :: OrdPSQ.OrdPSQ k Int v -> [(k, Int, v)] -> [OrdPSQ.OrdPSQ k Int v]
    go :: OrdPSQ k Int v -> [(k, Int, v)] -> [OrdPSQ k Int v]
go OrdPSQ k Int v
ws = \case
      (k
k, Int
i, v
x):[(k, Int, v)]
xs -> OrdPSQ k Int v
ws OrdPSQ k Int v -> [OrdPSQ k Int v] -> [OrdPSQ k Int v]
forall a. a -> [a] -> [a]
: OrdPSQ k Int v -> [(k, Int, v)] -> [OrdPSQ k Int v]
go (k -> Int -> v -> OrdPSQ k Int v -> OrdPSQ k Int v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
OrdPSQ.insert k
k Int
i v
x (OrdPSQ k Int v -> OrdPSQ k Int v
forall k p v. (Ord k, Ord p) => OrdPSQ k p v -> OrdPSQ k p v
OrdPSQ.deleteMin OrdPSQ k Int v
ws)) [(k, Int, v)]
xs
      [(k, Int, v)]
_            -> OrdPSQ k Int v
ws OrdPSQ k Int v -> [OrdPSQ k Int v] -> [OrdPSQ k Int v]
forall a. a -> [a] -> [a]
: []

-- | sorted windows of a given length
sortedSlidingWindowsInt
    :: forall v. ()
    => Int
    -> [(Int,v)]
    -> [IntPSQ.IntPSQ Int v]
sortedSlidingWindowsInt :: forall v. Int -> [(Int, v)] -> [IntPSQ Int v]
sortedSlidingWindowsInt Int
n = (IntPSQ Int v -> [(Int, Int, v)] -> [IntPSQ Int v])
-> (IntPSQ Int v, [(Int, Int, v)]) -> [IntPSQ Int v]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry IntPSQ Int v -> [(Int, Int, v)] -> [IntPSQ Int v]
go ((IntPSQ Int v, [(Int, Int, v)]) -> [IntPSQ Int v])
-> ([(Int, v)] -> (IntPSQ Int v, [(Int, Int, v)]))
-> [(Int, v)]
-> [IntPSQ Int v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, Int, v)] -> IntPSQ Int v)
-> ([(Int, Int, v)], [(Int, Int, v)])
-> (IntPSQ Int v, [(Int, Int, v)])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [(Int, Int, v)] -> IntPSQ Int v
forall p v. Ord p => [(Int, p, v)] -> IntPSQ p v
IntPSQ.fromList (([(Int, Int, v)], [(Int, Int, v)])
 -> (IntPSQ Int v, [(Int, Int, v)]))
-> ([(Int, v)] -> ([(Int, Int, v)], [(Int, Int, v)]))
-> [(Int, v)]
-> (IntPSQ Int v, [(Int, Int, v)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Int, Int, v)] -> ([(Int, Int, v)], [(Int, Int, v)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n ([(Int, Int, v)] -> ([(Int, Int, v)], [(Int, Int, v)]))
-> ([(Int, v)] -> [(Int, Int, v)])
-> [(Int, v)]
-> ([(Int, Int, v)], [(Int, Int, v)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (Int, v) -> (Int, Int, v))
-> [Int] -> [(Int, v)] -> [(Int, Int, v)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (Int, v) -> (Int, Int, v)
forall {b} {a} {c}. b -> (a, c) -> (a, b, c)
reIx [Int
0..]
  where
    reIx :: b -> (a, c) -> (a, b, c)
reIx b
i (a
j,c
k) = (a
j, b
i, c
k)
    go :: IntPSQ.IntPSQ Int v -> [(Int, Int, v)] -> [IntPSQ.IntPSQ Int v]
    go :: IntPSQ Int v -> [(Int, Int, v)] -> [IntPSQ Int v]
go IntPSQ Int v
ws = \case
      (Int
k, Int
i, v
x):[(Int, Int, v)]
xs -> IntPSQ Int v
ws IntPSQ Int v -> [IntPSQ Int v] -> [IntPSQ Int v]
forall a. a -> [a] -> [a]
: IntPSQ Int v -> [(Int, Int, v)] -> [IntPSQ Int v]
go (Int -> Int -> v -> IntPSQ Int v -> IntPSQ Int v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
IntPSQ.insert Int
k Int
i v
x (IntPSQ Int v -> IntPSQ Int v
forall p v. Ord p => IntPSQ p v -> IntPSQ p v
IntPSQ.deleteMin IntPSQ Int v
ws)) [(Int, Int, v)]
xs
      [(Int, Int, v)]
_            -> IntPSQ Int v
ws IntPSQ Int v -> [IntPSQ Int v] -> [IntPSQ Int v]
forall a. a -> [a] -> [a]
: []

-- | Get the key-value pair corresponding to the maximum value in the map
maximumVal :: Ord b => Map a b -> Maybe (a, b)
maximumVal :: forall b a. Ord b => Map a b -> Maybe (a, b)
maximumVal = (b -> b -> Ordering) -> Map a b -> Maybe (a, b)
forall b a. (b -> b -> Ordering) -> Map a b -> Maybe (a, b)
maximumValBy b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | Get the key-value pair corresponding to the maximum value in the map,
-- with a custom comparing function.
--
-- > 'maximumVal' == 'maximumValBy' 'compare'
maximumValBy :: (b -> b -> Ordering) -> Map a b -> Maybe (a, b)
maximumValBy :: forall b a. (b -> b -> Ordering) -> Map a b -> Maybe (a, b)
maximumValBy b -> b -> Ordering
c = (NonEmpty (a, b) -> (a, b))
-> Maybe (NonEmpty (a, b)) -> Maybe (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a, b) -> (a, b) -> Ordering) -> NonEmpty (a, b) -> (a, b)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (b -> b -> Ordering
c (b -> b -> Ordering)
-> ((a, b) -> b) -> (a, b) -> (a, b) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, b) -> b
forall a b. (a, b) -> b
snd))
               (Maybe (NonEmpty (a, b)) -> Maybe (a, b))
-> (Map a b -> Maybe (NonEmpty (a, b))) -> Map a b -> Maybe (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> Maybe (NonEmpty (a, b))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
               ([(a, b)] -> Maybe (NonEmpty (a, b)))
-> (Map a b -> [(a, b)]) -> Map a b -> Maybe (NonEmpty (a, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
M.toList

-- | Get the key-value pair corresponding to the minimum value in the map,
-- with a custom comparing function.
--
-- > 'minimumVal' == 'minimumValBy' 'compare'
minimumValBy :: (b -> b -> Ordering) -> Map a b -> Maybe (a, b)
minimumValBy :: forall b a. (b -> b -> Ordering) -> Map a b -> Maybe (a, b)
minimumValBy b -> b -> Ordering
c = (NonEmpty (a, b) -> (a, b))
-> Maybe (NonEmpty (a, b)) -> Maybe (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a, b) -> (a, b) -> Ordering) -> NonEmpty (a, b) -> (a, b)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (b -> b -> Ordering
c (b -> b -> Ordering)
-> ((a, b) -> b) -> (a, b) -> (a, b) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, b) -> b
forall a b. (a, b) -> b
snd))
               (Maybe (NonEmpty (a, b)) -> Maybe (a, b))
-> (Map a b -> Maybe (NonEmpty (a, b))) -> Map a b -> Maybe (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> Maybe (NonEmpty (a, b))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
               ([(a, b)] -> Maybe (NonEmpty (a, b)))
-> (Map a b -> [(a, b)]) -> Map a b -> Maybe (NonEmpty (a, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
M.toList

-- | Get the key-value pair corresponding to the minimum value in the map
minimumVal :: Ord b => Map a b -> Maybe (a, b)
minimumVal :: forall b a. Ord b => Map a b -> Maybe (a, b)
minimumVal = (b -> b -> Ordering) -> Map a b -> Maybe (a, b)
forall b a. (b -> b -> Ordering) -> Map a b -> Maybe (a, b)
minimumValBy b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | Version of 'maximumValBy' for nonempty maps.
maximumValByNE :: (b -> b -> Ordering) -> NEMap a b -> (a, b)
maximumValByNE :: forall b a. (b -> b -> Ordering) -> NEMap a b -> (a, b)
maximumValByNE b -> b -> Ordering
c = ((a, b) -> (a, b) -> Ordering) -> NonEmpty (a, b) -> (a, b)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (b -> b -> Ordering
c (b -> b -> Ordering)
-> ((a, b) -> b) -> (a, b) -> (a, b) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, b) -> b
forall a b. (a, b) -> b
snd)
                 (NonEmpty (a, b) -> (a, b))
-> (NEMap a b -> NonEmpty (a, b)) -> NEMap a b -> (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEMap a b -> NonEmpty (a, b)
forall k a. NEMap k a -> NonEmpty (k, a)
NEM.toList

-- | Version of 'maximumVal' for nonempty maps.
maximumValNE :: Ord b => NEMap a b -> (a, b)
maximumValNE :: forall b a. Ord b => NEMap a b -> (a, b)
maximumValNE = (b -> b -> Ordering) -> NEMap a b -> (a, b)
forall b a. (b -> b -> Ordering) -> NEMap a b -> (a, b)
maximumValByNE b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | Version of 'minimumValBy' for nonempty maps.
minimumValByNE :: (b -> b -> Ordering) -> NEMap a b -> (a, b)
minimumValByNE :: forall b a. (b -> b -> Ordering) -> NEMap a b -> (a, b)
minimumValByNE b -> b -> Ordering
c = ((a, b) -> (a, b) -> Ordering) -> NonEmpty (a, b) -> (a, b)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (b -> b -> Ordering
c (b -> b -> Ordering)
-> ((a, b) -> b) -> (a, b) -> (a, b) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, b) -> b
forall a b. (a, b) -> b
snd)
                 (NonEmpty (a, b) -> (a, b))
-> (NEMap a b -> NonEmpty (a, b)) -> NEMap a b -> (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEMap a b -> NonEmpty (a, b)
forall k a. NEMap k a -> NonEmpty (k, a)
NEM.toList

-- | Version of 'minimumVal' for nonempty maps.
minimumValNE :: Ord b => NEMap a b -> (a, b)
minimumValNE :: forall b a. Ord b => NEMap a b -> (a, b)
minimumValNE = (b -> b -> Ordering) -> NEMap a b -> (a, b)
forall b a. (b -> b -> Ordering) -> NEMap a b -> (a, b)
minimumValByNE b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

foldMapParChunk
    :: forall a m. (NFData m, Monoid m)
    => Int      -- ^ chunk size
    -> (a -> m)
    -> [a]
    -> m
foldMapParChunk :: forall a m. (NFData m, Monoid m) => Int -> (a -> m) -> [a] -> m
foldMapParChunk Int
n a -> m
f [a]
xs = [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([m] -> m) -> [m] -> m
forall a b. (a -> b) -> a -> b
$
  Strategy m -> ([a] -> m) -> [[a]] -> [m]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy m
forall a. NFData a => Strategy a
rdeepseq ((a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) (Int -> [a] -> [[a]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
n [a]
xs)


binaryFold
    :: Monoid m
    => Int        -- ^ minimum size list
    -> (a -> m)
    -> [a]
    -> m
binaryFold :: forall m a. Monoid m => Int -> (a -> m) -> [a] -> m
binaryFold Int
n a -> m
f = Int -> [a] -> m
bigGo (Int
1 :: Int)
  where
    bigGo :: Int -> [a] -> m
bigGo Int
i [a]
xs = case Int -> [a] -> (m, [a])
go Int
i [a]
xs of
      (!m
r, []) -> m
r
      (!m
r, [a]
ys) -> m
r m -> m -> m
forall a. Semigroup a => a -> a -> a
<> Int -> [a] -> m
bigGo (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [a]
ys
    go :: Int -> [a] -> (m, [a])
go Int
1 [a]
xs = ([a] -> m) -> ([a], [a]) -> (m, [a])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) (Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs)
    go Int
i [a]
xs     = (m
t, [a]
zs)
      where
        !t :: m
t = m
r m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
s
        (m
r, [a]
ys) = Int -> [a] -> (m, [a])
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
xs
        (m
s, [a]
zs) = Int -> [a] -> (m, [a])
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
ys

binaryFoldPar
    :: Monoid m
    => Int        -- ^ minimum size list
    -> (a -> m)
    -> [a]
    -> m
binaryFoldPar :: forall m a. Monoid m => Int -> (a -> m) -> [a] -> m
binaryFoldPar Int
n a -> m
f = Eval m -> m
forall a. Eval a -> a
runEval (Eval m -> m) -> ([a] -> Eval m) -> [a] -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> Eval m
bigGo (Int
1 :: Int)
  where
    bigGo :: Int -> [a] -> Eval m
bigGo Int
i [a]
xs = do
      (!m
r, [a]
ys) <- Int -> [a] -> Eval (m, [a])
go Int
i [a]
xs
      case [a]
ys of
        [] -> m -> Eval m
forall (f :: * -> *) a. Applicative f => a -> f a
pure m
r
        a
_:[a]
_ -> do
          m
q <- Int -> [a] -> Eval m
bigGo (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [a]
ys
          pure (m
q m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
r)
    go :: Int -> [a] -> Eval (m, [a])
go Int
1 [a]
xs = (,[a]
zs) (m -> (m, [a])) -> Eval m -> Eval (m, [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m -> Eval m
forall a. Strategy a
rpar ((a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f [a]
ys)
      where
        ([a]
ys, [a]
zs) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs
    go Int
i [a]
xs = do
      (m
r, [a]
ys) <- Int -> [a] -> Eval (m, [a])
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
xs
      (m
s, [a]
zs) <- Int -> [a] -> Eval (m, [a])
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
ys
      let !t :: m
t = m
r m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
s
      (m, [a]) -> Eval (m, [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((m, [a]) -> Eval (m, [a])) -> (m, [a]) -> Eval (m, [a])
forall a b. (a -> b) -> a -> b
$ (m
t, [a]
zs)

listTup :: [a] -> Maybe (a,a)
listTup :: forall a. [a] -> Maybe (a, a)
listTup (a
x:a
y:[a]
_) = (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a
x,a
y)
listTup [a]
_       = Maybe (a, a)
forall a. Maybe a
Nothing

_ListTup :: Prism' [a] (a, a)
_ListTup :: forall a. Prism' [a] (a, a)
_ListTup = ((a, a) -> [a])
-> ([a] -> Maybe (a, a)) -> Prism [a] [a] (a, a) (a, a)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (\(a
x,a
y) -> [a
x,a
y]) (([a] -> Maybe (a, a)) -> p (a, a) (f (a, a)) -> p [a] (f [a]))
-> ([a] -> Maybe (a, a)) -> p (a, a) (f (a, a)) -> p [a] (f [a])
forall a b. (a -> b) -> a -> b
$ \case
    [a
x,a
y] -> (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a
x,a
y)
    [a]
_     -> Maybe (a, a)
forall a. Maybe a
Nothing

listTup3 :: [a] -> Maybe (a,a,a)
listTup3 :: forall a. [a] -> Maybe (a, a, a)
listTup3 (a
x:a
y:a
z:[a]
_) = (a, a, a) -> Maybe (a, a, a)
forall a. a -> Maybe a
Just (a
x,a
y,a
z)
listTup3 [a]
_         = Maybe (a, a, a)
forall a. Maybe a
Nothing

_ListTup3 :: Prism' [a] (a, a, a)
_ListTup3 :: forall a. Prism' [a] (a, a, a)
_ListTup3 = ((a, a, a) -> [a])
-> ([a] -> Maybe (a, a, a)) -> Prism [a] [a] (a, a, a) (a, a, a)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (\(a
x,a
y,a
z) -> [a
x,a
y,a
z]) (([a] -> Maybe (a, a, a))
 -> p (a, a, a) (f (a, a, a)) -> p [a] (f [a]))
-> ([a] -> Maybe (a, a, a))
-> p (a, a, a) (f (a, a, a))
-> p [a] (f [a])
forall a b. (a -> b) -> a -> b
$ \case
    [a
x,a
y,a
z] -> (a, a, a) -> Maybe (a, a, a)
forall a. a -> Maybe a
Just (a
x,a
y,a
z)
    [a]
_       -> Maybe (a, a, a)
forall a. Maybe a
Nothing

listTup4 :: [a] -> Maybe (a,a,a,a)
listTup4 :: forall a. [a] -> Maybe (a, a, a, a)
listTup4 (a
x:a
y:a
z:a
k:[a]
_) = (a, a, a, a) -> Maybe (a, a, a, a)
forall a. a -> Maybe a
Just (a
x,a
y,a
z,a
k)
listTup4 [a]
_           = Maybe (a, a, a, a)
forall a. Maybe a
Nothing

_ListTup4 :: Prism' [a] (a, a, a, a)
_ListTup4 :: forall a. Prism' [a] (a, a, a, a)
_ListTup4 = ((a, a, a, a) -> [a])
-> ([a] -> Maybe (a, a, a, a))
-> Prism [a] [a] (a, a, a, a) (a, a, a, a)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (\(a
x,a
y,a
z,a
k) -> [a
x,a
y,a
z,a
k]) (([a] -> Maybe (a, a, a, a))
 -> p (a, a, a, a) (f (a, a, a, a)) -> p [a] (f [a]))
-> ([a] -> Maybe (a, a, a, a))
-> p (a, a, a, a) (f (a, a, a, a))
-> p [a] (f [a])
forall a b. (a -> b) -> a -> b
$ \case
    [a
x,a
y,a
z,a
k] -> (a, a, a, a) -> Maybe (a, a, a, a)
forall a. a -> Maybe a
Just (a
x,a
y,a
z,a
k)
    [a]
_         -> Maybe (a, a, a, a)
forall a. Maybe a
Nothing

-- | Delete a potential value from a 'Finite'.
deleteFinite
    :: KnownNat n
    => Finite (n + 1)
    -> Finite (n + 1)
    -> Maybe (Finite n)
deleteFinite :: forall (n :: Nat).
KnownNat n =>
Finite (n + 1) -> Finite (n + 1) -> Maybe (Finite n)
deleteFinite Finite (n + 1)
n Finite (n + 1)
m = case Finite (n + 1)
n Finite (n + 1) -> Finite (n + 1) -> Ordering
forall (n :: Nat) (m :: Nat). Finite n -> Finite m -> Ordering
`cmp` Finite (n + 1)
m of
    Ordering
LT -> Finite (n + 1) -> Maybe (Finite n)
forall (n :: Nat). Finite (n + 1) -> Maybe (Finite n)
unshift Finite (n + 1)
m
    Ordering
EQ -> Maybe (Finite n)
forall a. Maybe a
Nothing
    Ordering
GT -> Finite (n + 1) -> Maybe (Finite n)
forall (n :: Nat). KnownNat n => Finite (n + 1) -> Maybe (Finite n)
strengthen Finite (n + 1)
m

-- | 'foldMap', but in parallel.
foldMapPar :: Monoid b => (a -> b) -> [a] -> b
foldMapPar :: forall b a. Monoid b => (a -> b) -> [a] -> b
foldMapPar a -> b
f = Eval b -> b
forall a. Eval a -> a
runEval (Eval b -> b) -> ([a] -> Eval b) -> [a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([b] -> b) -> Eval [b] -> Eval b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [b] -> b
forall a. Monoid a => [a] -> a
mconcat (Eval [b] -> Eval b) -> ([a] -> Eval [b]) -> [a] -> Eval b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Eval b) -> [a] -> Eval [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Strategy b
forall a. Strategy a
rpar Strategy b -> (a -> b) -> a -> Eval b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

-- | 'foldMap1', but in parallel.
foldMapPar1 :: Semigroup b => (a -> b) -> NonEmpty a -> b
foldMapPar1 :: forall b a. Semigroup b => (a -> b) -> NonEmpty a -> b
foldMapPar1 a -> b
f = Eval b -> b
forall a. Eval a -> a
runEval (Eval b -> b) -> (NonEmpty a -> Eval b) -> NonEmpty a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty b -> b) -> Eval (NonEmpty b) -> Eval b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty b -> b
forall a. Semigroup a => NonEmpty a -> a
sconcat (Eval (NonEmpty b) -> Eval b)
-> (NonEmpty a -> Eval (NonEmpty b)) -> NonEmpty a -> Eval b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Eval b) -> NonEmpty a -> Eval (NonEmpty b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Strategy b
forall a. Strategy a
rpar Strategy b -> (a -> b) -> a -> Eval b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

-- | 'F.Fold' for computing mean and variance
meanVar :: Fractional a => F.Fold a (a, a)
meanVar :: forall a. Fractional a => Fold a (a, a)
meanVar = do
    a
n  <- Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Fold a Int -> Fold a a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold a Int
forall a. Fold a Int
F.length
    a
x  <- Fold a a
forall a. Num a => Fold a a
F.sum
    a
x2 <- (a -> a) -> Fold a a -> Fold a a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int)) Fold a a
forall a. Num a => Fold a a
F.sum
    pure $ let μ :: a
μ  = a
x a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
n
               σ2 :: a
σ2 = a
x2 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
μ a -> a -> a
forall a. Num a => a -> a -> a
* a
μ
           in  (a
μ, a
σ2)

-- | Flood fill from a starting set
floodFill
    :: Ord a
    => (a -> Set a)     -- ^ Expansion (be sure to limit allowed points)
    -> Set a            -- ^ Start points
    -> Set a            -- ^ Flood filled
floodFill :: forall a. Ord a => (a -> Set a) -> Set a -> Set a
floodFill a -> Set a
f = (Int, Set a) -> Set a
forall a b. (a, b) -> b
snd ((Int, Set a) -> Set a)
-> (Set a -> (Int, Set a)) -> Set a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Set a) -> Set a -> (Int, Set a)
forall a. Ord a => (a -> Set a) -> Set a -> (Int, Set a)
floodFillCount a -> Set a
f

-- | Flood fill from a starting set, counting the number of steps
floodFillCount
    :: Ord a
    => (a -> Set a)     -- ^ Expansion (be sure to limit allowed points)
    -> Set a            -- ^ Start points
    -> (Int, Set a)     -- ^ Flood filled, with count of number of steps
floodFillCount :: forall a. Ord a => (a -> Set a) -> Set a -> (Int, Set a)
floodFillCount a -> Set a
f = Int -> Set a -> Set a -> (Int, Set a)
go Int
0 Set a
forall a. Set a
S.empty
  where
    go :: Int -> Set a -> Set a -> (Int, Set a)
go !Int
n !Set a
innr !Set a
outr
        | Set a -> Bool
forall a. Set a -> Bool
S.null Set a
outr' = (Int
n, Set a
innr')
        | Bool
otherwise    = Int -> Set a -> Set a -> (Int, Set a)
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Set a
innr' Set a
outr'
      where
        innr' :: Set a
innr' = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
innr Set a
outr
        outr' :: Set a
outr' = (a -> Set a) -> Set a -> Set a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Set a
f Set a
outr Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set a
innr'


type Graph v e = Map v (Map v e)

toFGL :: (G.Graph gr, Ord v) => Graph v e -> (gr v e, Set v)
toFGL :: forall (gr :: * -> * -> *) v e.
(Graph gr, Ord v) =>
Graph v e -> (gr v e, Set v)
toFGL Graph v e
gr = ( [LNode v] -> [LEdge e] -> gr v e
forall (gr :: * -> * -> *) a b.
Graph gr =>
[LNode a] -> [LEdge b] -> gr a b
G.mkGraph ([Int] -> [v] -> [LNode v]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([v] -> [LNode v]) -> [v] -> [LNode v]
forall a b. (a -> b) -> a -> b
$ Set v -> [v]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set v
vertices)
                ((\(v
v,v
u,e
e) -> (v -> Int
ixOf v
v, v -> Int
ixOf v
u, e
e)) ((v, v, e) -> LEdge e) -> [(v, v, e)] -> [LEdge e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, v, e)]
edges)
           , Set v
vertices
           )
  where
    edges :: [(v, v, e)]
edges = do
      (v
v, Map v e
es) <- Graph v e -> [(v, Map v e)]
forall k a. Map k a -> [(k, a)]
M.toList Graph v e
gr
      (v
u, e
e ) <- Map v e -> [(v, e)]
forall k a. Map k a -> [(k, a)]
M.toList Map v e
es
      (v, v, e) -> [(v, v, e)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v
v, v
u, e
e)
    vertices :: Set v
vertices = ((v, v, e) -> Set v) -> [(v, v, e)] -> Set v
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(v
v,v
u,e
_) -> [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList [v
v,v
u]) [(v, v, e)]
edges
    ixOf :: v -> Int
ixOf     = (v -> Set v -> Int
forall a. Ord a => a -> Set a -> Int
`S.findIndex` Set v
vertices)

-- data ExpGraph v e = ExpGraph (Map v )
-- data ExpGraph v e = ExpGraph e (Map v (ExpGraph v e))

-- data ExpGraph v e = ExpGraph (Map v (e, ExpGraph v e))
-- type ExpGraph v e = Map v (Map v (e, ExpGraph
-- data ExpGraph v e = ExpGraph v (Map v (e, ExpGraph v e))
                  -- { expGraphMap :: Map v [(v, e, ExpGraph v e)] }
-- -- newtype ExpGraph v e = ExpGraph { expGraphMap :: Map v [(v, e, ExpGraph v e)] }
--   deriving (Show, Eq, Ord, Functor)
-- R.makeBaseFunctor ''ExpGraph

-- -- Map v [(e, v)]

-- expandGraph :: forall v e. Ord v => Graph v e -> Map v (ExpGraph v e)
-- expandGraph gr = M.mapWithKey go gr
  -- where
  --   go :: v -> Map v e -> ExpGraph v e
  --   go
--   -- where
  --   go :: Map v e -> ExpandGrahF v e (Map v e)
  --   go vs = ExpandGraph

-- expandGraph :: forall v e. Ord v => Graph v e -> ExpGraph v e
-- expandGraph gr = go (M.keysSet gr)
--   where
--     go vs = ExpGraph $ M.fromSet (_ . flip M.lookup gr) vs


-- expandGraph gr = R.ana go (M.keysSet gr)
--   where
--     go :: Set v -> ExpGraphF v e (Set v)
--     go vs = ExpGraphF $
--       M.mapMaybe id $ M.fromSet (fmap () . flip M.lookup gr) vs
--       -- M.fromSet (_ . map swap . foldMap M.toList . flip M.lookup gr) vs
--     -- M.fromSet (_ . map swap . foldMap M.toList . flip M.lookup gr) vs

-- -- | Recursively fold up a monoid value for each vertex and all of its
-- -- children's monoid values.  You can transform the value in-transit before
-- -- it is accumulated if you want.
-- foldMapGraph
--     :: (Ord v, Monoid m)
--     => (v -> m)         -- ^ embed the vertex
--     -> (e -> m -> m)    -- ^ transform with edge before it is accumulated
--     -> Graph v e
--     -> Map v m
-- foldMapGraph f g gr = res
--   where
--     res = M.foldMapWithKey (\s v -> f s <> foldMap (g v) (M.lookup s res))
--        <$> gr

-- data ExpandGraph v e = ExpandGraph v e (ExpandGraph v e)

-- expandGraph :: Ord v => Graph v e -> Map v (v, [ExpandGraph v e])
-- expandGraph gr = M.mapWithKey
--   (\v es ->
--       ( v
--       , (\(u,e) -> ExpandGraph u e (go (gr M.! u)))
--         <$> M.toList es
--       )
--   )
--   gr

sortSizedBy
    :: VG.Vector v a
    => (a -> a -> Ordering)
    -> SVG.Vector v n a
    -> SVG.Vector v n a
sortSizedBy :: forall (v :: * -> *) a (n :: Nat).
Vector v a =>
(a -> a -> Ordering) -> Vector v n a -> Vector v n a
sortSizedBy a -> a -> Ordering
f (SVG.Vector v a
xs) = (forall s. ST s (Vector v n a)) -> Vector v n a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector v n a)) -> Vector v n a)
-> (forall s. ST s (Vector v n a)) -> Vector v n a
forall a b. (a -> b) -> a -> b
$ do
    Mutable v s a
ys <- v a -> ST s (Mutable v (PrimState (ST s)) a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.thaw v a
xs
    (a -> a -> Ordering) -> Mutable v (PrimState (ST s)) a -> ST s ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m ()
VAI.sortBy a -> a -> Ordering
f Mutable v s a
Mutable v (PrimState (ST s)) a
ys
    v a -> Vector v n a
forall (v :: * -> *) (n :: Nat) a. v a -> Vector v n a
SVG.Vector (v a -> Vector v n a) -> ST s (v a) -> ST s (Vector v n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable v (PrimState (ST s)) a -> ST s (v a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.unsafeFreeze Mutable v s a
Mutable v (PrimState (ST s)) a
ys
{-# INLINE sortSizedBy #-}

withAllSized
    :: VG.Vector v a
    => NonEmpty [a]
    -> (forall n. KnownNat n => NonEmpty (SVG.Vector v n a) -> Maybe r)
    -> Maybe r
withAllSized :: forall (v :: * -> *) a r.
Vector v a =>
NonEmpty [a]
-> (forall (n :: Nat).
    KnownNat n =>
    NonEmpty (Vector v n a) -> Maybe r)
-> Maybe r
withAllSized ([a]
x :| [[a]]
xs) forall (n :: Nat). KnownNat n => NonEmpty (Vector v n a) -> Maybe r
f = [a]
-> (forall (n :: Nat). KnownNat n => Vector v n a -> Maybe r)
-> Maybe r
forall (v :: * -> *) a r.
Vector v a =>
[a] -> (forall (n :: Nat). KnownNat n => Vector v n a -> r) -> r
SVG.withSizedList [a]
x ((forall (n :: Nat). KnownNat n => Vector v n a -> Maybe r)
 -> Maybe r)
-> (forall (n :: Nat). KnownNat n => Vector v n a -> Maybe r)
-> Maybe r
forall a b. (a -> b) -> a -> b
$ \Vector v n a
vx ->
    NonEmpty (Vector v n a) -> Maybe r
forall (n :: Nat). KnownNat n => NonEmpty (Vector v n a) -> Maybe r
f (NonEmpty (Vector v n a) -> Maybe r)
-> ([Vector v n a] -> NonEmpty (Vector v n a))
-> [Vector v n a]
-> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector v n a
vx Vector v n a -> [Vector v n a] -> NonEmpty (Vector v n a)
forall a. a -> [a] -> NonEmpty a
:|) ([Vector v n a] -> Maybe r) -> Maybe [Vector v n a] -> Maybe r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ([a] -> Maybe (Vector v n a)) -> [[a]] -> Maybe [Vector v n a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [a] -> Maybe (Vector v n a)
forall (v :: * -> *) a (n :: Nat).
(Vector v a, KnownNat n) =>
[a] -> Maybe (Vector v n a)
SVG.fromList [[a]]
xs
{-# INLINE withAllSized #-}

type instance Index   (SVG.Vector v n a) = Int
type instance IxValue (SVG.Vector v n a) = a

instance (Ixed (v a), Index (v a) ~ Int, IxValue (v a) ~ a) => Ixed (SVG.Vector v n a) where
    ix :: Index (Vector v n a)
-> Traversal' (Vector v n a) (IxValue (Vector v n a))
ix Index (Vector v n a)
i IxValue (Vector v n a) -> f (IxValue (Vector v n a))
f (SVG.Vector v a
v) = v a -> Vector v n a
forall (v :: * -> *) (n :: Nat) a. v a -> Vector v n a
SVG.Vector (v a -> Vector v n a) -> f (v a) -> f (Vector v n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index (v a) -> Traversal' (v a) (IxValue (v a))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (v a)
Index (Vector v n a)
i IxValue (v a) -> f (IxValue (v a))
IxValue (Vector v n a) -> f (IxValue (Vector v n a))
f v a
v

instance (KnownNat n, forall a. VG.Vector v a, 1 <= n) => R1 (SVG.Vector v n) where
    _x :: forall a. Lens' (Vector v n a) a
_x = Finite n -> (a -> f a) -> Vector v n a -> f (Vector v n a)
forall (v :: * -> *) (n :: Nat) a (f :: * -> *).
(Vector v a, Functor f) =>
Finite n -> (a -> f a) -> Vector v n a -> f (Vector v n a)
SVG.ix Finite n
0

instance (KnownNat n, forall a. VG.Vector v a, 2 <= n) => R2 (SVG.Vector v n) where
    _xy :: forall a. Lens' (Vector v n a) (V2 a)
_xy V2 a -> f (V2 a)
f Vector v n a
v = (\(V2 a
x a
y) -> Vector v n a
v Vector v n a -> [(Finite n, a)] -> Vector v n a
forall (v :: * -> *) a (m :: Nat).
Vector v a =>
Vector v m a -> [(Finite m, a)] -> Vector v m a
SVG.// [(Finite n
0, a
x), (Finite n
1, a
y)]) (V2 a -> Vector v n a) -> f (V2 a) -> f (Vector v n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V2 a -> f (V2 a)
f (a -> a -> V2 a
forall a. a -> a -> V2 a
V2 (Vector v n a
v Vector v n a -> Finite n -> a
forall (v :: * -> *) (n :: Nat) a.
Vector v a =>
Vector v n a -> Finite n -> a
`SVG.index` Finite n
0) (Vector v n a
v Vector v n a -> Finite n -> a
forall (v :: * -> *) (n :: Nat) a.
Vector v a =>
Vector v n a -> Finite n -> a
`SVG.index` Finite n
1))
    _y :: forall a. Lens' (Vector v n a) a
_y = Finite n -> (a -> f a) -> Vector v n a -> f (Vector v n a)
forall (v :: * -> *) (n :: Nat) a (f :: * -> *).
(Vector v a, Functor f) =>
Finite n -> (a -> f a) -> Vector v n a -> f (Vector v n a)
SVG.ix Finite n
1

instance (KnownNat n, forall a. VG.Vector v a, 3 <= n) => R3 (SVG.Vector v n) where
    _xyz :: forall a. Lens' (Vector v n a) (V3 a)
_xyz V3 a -> f (V3 a)
f Vector v n a
v = (\(V3 a
x a
y a
z) -> Vector v n a
v Vector v n a -> [(Finite n, a)] -> Vector v n a
forall (v :: * -> *) a (m :: Nat).
Vector v a =>
Vector v m a -> [(Finite m, a)] -> Vector v m a
SVG.// [(Finite n
0, a
x), (Finite n
1, a
y), (Finite n
2, a
z)])
           (V3 a -> Vector v n a) -> f (V3 a) -> f (Vector v n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V3 a -> f (V3 a)
f (a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 (Vector v n a
v Vector v n a -> Finite n -> a
forall (v :: * -> *) (n :: Nat) a.
Vector v a =>
Vector v n a -> Finite n -> a
`SVG.index` Finite n
0) (Vector v n a
v Vector v n a -> Finite n -> a
forall (v :: * -> *) (n :: Nat) a.
Vector v a =>
Vector v n a -> Finite n -> a
`SVG.index` Finite n
1) (Vector v n a
v Vector v n a -> Finite n -> a
forall (v :: * -> *) (n :: Nat) a.
Vector v a =>
Vector v n a -> Finite n -> a
`SVG.index` Finite n
2))
    _z :: forall a. Lens' (Vector v n a) a
_z = Finite n -> (a -> f a) -> Vector v n a -> f (Vector v n a)
forall (v :: * -> *) (n :: Nat) a (f :: * -> *).
(Vector v a, Functor f) =>
Finite n -> (a -> f a) -> Vector v n a -> f (Vector v n a)
SVG.ix Finite n
2

instance (KnownNat n, forall a. VG.Vector v a, 4 <= n) => R4 (SVG.Vector v n) where
    _xyzw :: forall a. Lens' (Vector v n a) (V4 a)
_xyzw V4 a -> f (V4 a)
f Vector v n a
v = (\(V4 a
x a
y a
z a
w) -> Vector v n a
v Vector v n a -> [(Finite n, a)] -> Vector v n a
forall (v :: * -> *) a (m :: Nat).
Vector v a =>
Vector v m a -> [(Finite m, a)] -> Vector v m a
SVG.// [(Finite n
0, a
x), (Finite n
1, a
y), (Finite n
2, a
z), (Finite n
3, a
w)])
           (V4 a -> Vector v n a) -> f (V4 a) -> f (Vector v n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> V4 a -> f (V4 a)
f (a -> a -> a -> a -> V4 a
forall a. a -> a -> a -> a -> V4 a
V4 (Vector v n a
v Vector v n a -> Finite n -> a
forall (v :: * -> *) (n :: Nat) a.
Vector v a =>
Vector v n a -> Finite n -> a
`SVG.index` Finite n
0) (Vector v n a
v Vector v n a -> Finite n -> a
forall (v :: * -> *) (n :: Nat) a.
Vector v a =>
Vector v n a -> Finite n -> a
`SVG.index` Finite n
1) (Vector v n a
v Vector v n a -> Finite n -> a
forall (v :: * -> *) (n :: Nat) a.
Vector v a =>
Vector v n a -> Finite n -> a
`SVG.index` Finite n
2) (Vector v n a
v Vector v n a -> Finite n -> a
forall (v :: * -> *) (n :: Nat) a.
Vector v a =>
Vector v n a -> Finite n -> a
`SVG.index` Finite n
3))
    _w :: forall a. Lens' (Vector v n a) a
_w = Finite n -> (a -> f a) -> Vector v n a -> f (Vector v n a)
forall (v :: * -> *) (n :: Nat) a (f :: * -> *).
(Vector v a, Functor f) =>
Finite n -> (a -> f a) -> Vector v n a -> f (Vector v n a)
SVG.ix Finite n
3

type instance Index   (OrdPSQ.OrdPSQ k p v) = k
type instance IxValue (OrdPSQ.OrdPSQ k p v) = v

instance (Ord k, Ord p) => Ixed (OrdPSQ.OrdPSQ k p v) where
    ix :: Index (OrdPSQ k p v)
-> Traversal' (OrdPSQ k p v) (IxValue (OrdPSQ k p v))
ix Index (OrdPSQ k p v)
i IxValue (OrdPSQ k p v) -> f (IxValue (OrdPSQ k p v))
f OrdPSQ k p v
q = case k -> OrdPSQ k p v -> Maybe (p, v)
forall k p v. Ord k => k -> OrdPSQ k p v -> Maybe (p, v)
OrdPSQ.lookup k
Index (OrdPSQ k p v)
i OrdPSQ k p v
q of
      Maybe (p, v)
Nothing    -> OrdPSQ k p v -> f (OrdPSQ k p v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure OrdPSQ k p v
q
      Just (p
p,v
x) -> (v -> OrdPSQ k p v -> OrdPSQ k p v)
-> OrdPSQ k p v -> v -> OrdPSQ k p v
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
OrdPSQ.insert k
Index (OrdPSQ k p v)
i p
p) OrdPSQ k p v
q (v -> OrdPSQ k p v) -> f v -> f (OrdPSQ k p v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IxValue (OrdPSQ k p v) -> f (IxValue (OrdPSQ k p v))
f v
IxValue (OrdPSQ k p v)
x

-- | Use a stream of tokens @a@ as the underlying parser stream.  Note that
-- error messages for parser errors are going necessarily to be wonky.
newtype TokStream a = TokStream { forall a. TokStream a -> [a]
getTokStream :: [a] }
  deriving (Eq (TokStream a)
Eq (TokStream a)
-> (TokStream a -> TokStream a -> Ordering)
-> (TokStream a -> TokStream a -> Bool)
-> (TokStream a -> TokStream a -> Bool)
-> (TokStream a -> TokStream a -> Bool)
-> (TokStream a -> TokStream a -> Bool)
-> (TokStream a -> TokStream a -> TokStream a)
-> (TokStream a -> TokStream a -> TokStream a)
-> Ord (TokStream a)
TokStream a -> TokStream a -> Bool
TokStream a -> TokStream a -> Ordering
TokStream a -> TokStream a -> TokStream a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (TokStream a)
forall a. Ord a => TokStream a -> TokStream a -> Bool
forall a. Ord a => TokStream a -> TokStream a -> Ordering
forall a. Ord a => TokStream a -> TokStream a -> TokStream a
min :: TokStream a -> TokStream a -> TokStream a
$cmin :: forall a. Ord a => TokStream a -> TokStream a -> TokStream a
max :: TokStream a -> TokStream a -> TokStream a
$cmax :: forall a. Ord a => TokStream a -> TokStream a -> TokStream a
>= :: TokStream a -> TokStream a -> Bool
$c>= :: forall a. Ord a => TokStream a -> TokStream a -> Bool
> :: TokStream a -> TokStream a -> Bool
$c> :: forall a. Ord a => TokStream a -> TokStream a -> Bool
<= :: TokStream a -> TokStream a -> Bool
$c<= :: forall a. Ord a => TokStream a -> TokStream a -> Bool
< :: TokStream a -> TokStream a -> Bool
$c< :: forall a. Ord a => TokStream a -> TokStream a -> Bool
compare :: TokStream a -> TokStream a -> Ordering
$ccompare :: forall a. Ord a => TokStream a -> TokStream a -> Ordering
Ord, TokStream a -> TokStream a -> Bool
(TokStream a -> TokStream a -> Bool)
-> (TokStream a -> TokStream a -> Bool) -> Eq (TokStream a)
forall a. Eq a => TokStream a -> TokStream a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokStream a -> TokStream a -> Bool
$c/= :: forall a. Eq a => TokStream a -> TokStream a -> Bool
== :: TokStream a -> TokStream a -> Bool
$c== :: forall a. Eq a => TokStream a -> TokStream a -> Bool
Eq, Int -> TokStream a -> String -> String
[TokStream a] -> String -> String
TokStream a -> String
(Int -> TokStream a -> String -> String)
-> (TokStream a -> String)
-> ([TokStream a] -> String -> String)
-> Show (TokStream a)
forall a. Show a => Int -> TokStream a -> String -> String
forall a. Show a => [TokStream a] -> String -> String
forall a. Show a => TokStream a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TokStream a] -> String -> String
$cshowList :: forall a. Show a => [TokStream a] -> String -> String
show :: TokStream a -> String
$cshow :: forall a. Show a => TokStream a -> String
showsPrec :: Int -> TokStream a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> TokStream a -> String -> String
Show, (forall x. TokStream a -> Rep (TokStream a) x)
-> (forall x. Rep (TokStream a) x -> TokStream a)
-> Generic (TokStream a)
forall x. Rep (TokStream a) x -> TokStream a
forall x. TokStream a -> Rep (TokStream a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (TokStream a) x -> TokStream a
forall a x. TokStream a -> Rep (TokStream a) x
$cto :: forall a x. Rep (TokStream a) x -> TokStream a
$cfrom :: forall a x. TokStream a -> Rep (TokStream a) x
Generic, (forall a b. (a -> b) -> TokStream a -> TokStream b)
-> (forall a b. a -> TokStream b -> TokStream a)
-> Functor TokStream
forall a b. a -> TokStream b -> TokStream a
forall a b. (a -> b) -> TokStream a -> TokStream b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> TokStream b -> TokStream a
$c<$ :: forall a b. a -> TokStream b -> TokStream a
fmap :: forall a b. (a -> b) -> TokStream a -> TokStream b
$cfmap :: forall a b. (a -> b) -> TokStream a -> TokStream b
Functor)

instance Hashable a => Hashable (TokStream a)
instance NFData a => NFData (TokStream a)



instance (Ord a, Show a) => P.Stream (TokStream a) where
    type Token  (TokStream a) = a
    type Tokens (TokStream a) = Seq a

    tokensToChunk :: Proxy (TokStream a)
-> [Token (TokStream a)] -> Tokens (TokStream a)
tokensToChunk Proxy (TokStream a)
_ = [Token (TokStream a)] -> Tokens (TokStream a)
forall a. [a] -> Seq a
Seq.fromList
    chunkToTokens :: Proxy (TokStream a)
-> Tokens (TokStream a) -> [Token (TokStream a)]
chunkToTokens Proxy (TokStream a)
_ = Tokens (TokStream a) -> [Token (TokStream a)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    chunkLength :: Proxy (TokStream a) -> Tokens (TokStream a) -> Int
chunkLength   Proxy (TokStream a)
_ = Tokens (TokStream a) -> Int
forall a. Seq a -> Int
Seq.length
    take1_ :: TokStream a -> Maybe (Token (TokStream a), TokStream a)
take1_          = Maybe (a, [a]) -> Maybe (a, TokStream a)
coerce (Maybe (a, [a]) -> Maybe (a, TokStream a))
-> (TokStream a -> Maybe (a, [a]))
-> TokStream a
-> Maybe (a, TokStream a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (a, [a])
forall a. [a] -> Maybe (a, [a])
Data.List.uncons ([a] -> Maybe (a, [a]))
-> (TokStream a -> [a]) -> TokStream a -> Maybe (a, [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokStream a -> [a]
forall a. TokStream a -> [a]
getTokStream
    takeN_ :: Int -> TokStream a -> Maybe (Tokens (TokStream a), TokStream a)
takeN_        Int
n (TokStream [a]
xs) = ([a] -> Seq a)
-> ([a] -> TokStream a) -> ([a], [a]) -> (Seq a, TokStream a)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList [a] -> TokStream a
forall a. [a] -> TokStream a
TokStream (Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs)
                                  (Seq a, TokStream a) -> Maybe () -> Maybe (Seq a, TokStream a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs))
    takeWhile_ :: (Token (TokStream a) -> Bool)
-> TokStream a -> (Tokens (TokStream a), TokStream a)
takeWhile_ Token (TokStream a) -> Bool
p = ([a] -> Seq a)
-> ([a] -> TokStream a) -> ([a], [a]) -> (Seq a, TokStream a)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList [a] -> TokStream a
forall a. [a] -> TokStream a
TokStream (([a], [a]) -> (Seq a, TokStream a))
-> (TokStream a -> ([a], [a]))
-> TokStream a
-> (Seq a, TokStream a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span a -> Bool
Token (TokStream a) -> Bool
p ([a] -> ([a], [a]))
-> (TokStream a -> [a]) -> TokStream a -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokStream a -> [a]
forall a. TokStream a -> [a]
getTokStream
    -- showTokens _ = show
    -- reachOffset o ps = ("<token stream>", ps')
    --   where
    --     step = o - P.pstateOffset ps
    --     ps' = ps { P.pstateOffset    = o
    --              , P.pstateInput     = TokStream ys
    --              , P.pstateSourcePos = (P.pstateSourcePos ps) {
    --                   P.sourceColumn = P.sourceColumn (P.pstateSourcePos ps)
    --                                 <> P.mkPos step
    --                 }
    --              }
    --     ys = drop step (getTokStream (P.pstateInput ps))

-- | Parse a stream of tokens @s@ purely, returning 'Either'
parseTokStream
    :: Foldable t
    => P.Parsec e (TokStream s) a
    -> t s
    -> Either (P.ParseErrorBundle (TokStream s) e) a
parseTokStream :: forall (t :: * -> *) e s a.
Foldable t =>
Parsec e (TokStream s) a
-> t s -> Either (ParseErrorBundle (TokStream s) e) a
parseTokStream Parsec e (TokStream s) a
p = Identity (Either (ParseErrorBundle (TokStream s) e) a)
-> Either (ParseErrorBundle (TokStream s) e) a
forall a. Identity a -> a
runIdentity (Identity (Either (ParseErrorBundle (TokStream s) e) a)
 -> Either (ParseErrorBundle (TokStream s) e) a)
-> (t s -> Identity (Either (ParseErrorBundle (TokStream s) e) a))
-> t s
-> Either (ParseErrorBundle (TokStream s) e) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec e (TokStream s) a
-> t s -> Identity (Either (ParseErrorBundle (TokStream s) e) a)
forall (t :: * -> *) (m :: * -> *) e s a.
(Foldable t, Monad m) =>
ParsecT e (TokStream s) m a
-> t s -> m (Either (ParseErrorBundle (TokStream s) e) a)
parseTokStreamT Parsec e (TokStream s) a
p

-- | Parse a stream of tokens @s@ purely
parseTokStream_
    :: (Alternative m, Foldable t)
    => P.Parsec e (TokStream s) a
    -> t s
    -> m a
parseTokStream_ :: forall (m :: * -> *) (t :: * -> *) e s a.
(Alternative m, Foldable t) =>
Parsec e (TokStream s) a -> t s -> m a
parseTokStream_ Parsec e (TokStream s) a
p = Identity (m a) -> m a
forall a. Identity a -> a
runIdentity (Identity (m a) -> m a) -> (t s -> Identity (m a)) -> t s -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec e (TokStream s) a -> t s -> Identity (m a)
forall (f :: * -> *) (t :: * -> *) (m :: * -> *) e s a.
(Alternative f, Foldable t, Monad m) =>
ParsecT e (TokStream s) m a -> t s -> m (f a)
parseTokStreamT_ Parsec e (TokStream s) a
p

-- | Parse a stream of tokens @s@ over an underlying monad, returning 'Either'
parseTokStreamT
    :: (Foldable t, Monad m)
    => P.ParsecT e (TokStream s) m a
    -> t s
    -> m (Either (P.ParseErrorBundle (TokStream s) e) a)
parseTokStreamT :: forall (t :: * -> *) (m :: * -> *) e s a.
(Foldable t, Monad m) =>
ParsecT e (TokStream s) m a
-> t s -> m (Either (ParseErrorBundle (TokStream s) e) a)
parseTokStreamT ParsecT e (TokStream s) m a
p = ParsecT e (TokStream s) m a
-> String
-> TokStream s
-> m (Either (ParseErrorBundle (TokStream s) e) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
P.runParserT ParsecT e (TokStream s) m a
p String
"" (TokStream s -> m (Either (ParseErrorBundle (TokStream s) e) a))
-> (t s -> TokStream s)
-> t s
-> m (Either (ParseErrorBundle (TokStream s) e) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [s] -> TokStream s
forall a. [a] -> TokStream a
TokStream ([s] -> TokStream s) -> (t s -> [s]) -> t s -> TokStream s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t s -> [s]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | Parse a stream of tokens @s@ over an underlying monad
parseTokStreamT_
    :: (Alternative f, Foldable t, Monad m)
    => P.ParsecT e (TokStream s) m a
    -> t s
    -> m (f a)
parseTokStreamT_ :: forall (f :: * -> *) (t :: * -> *) (m :: * -> *) e s a.
(Alternative f, Foldable t, Monad m) =>
ParsecT e (TokStream s) m a -> t s -> m (f a)
parseTokStreamT_ ParsecT e (TokStream s) m a
p = (Either (ParseErrorBundle (TokStream s) e) a -> f a)
-> m (Either (ParseErrorBundle (TokStream s) e) a) -> m (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (ParseErrorBundle (TokStream s) e) a -> f a
forall (m :: * -> *) e a. Alternative m => Either e a -> m a
eitherToMaybe (m (Either (ParseErrorBundle (TokStream s) e) a) -> m (f a))
-> (t s -> m (Either (ParseErrorBundle (TokStream s) e) a))
-> t s
-> m (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT e (TokStream s) m a
-> t s -> m (Either (ParseErrorBundle (TokStream s) e) a)
forall (t :: * -> *) (m :: * -> *) e s a.
(Foldable t, Monad m) =>
ParsecT e (TokStream s) m a
-> t s -> m (Either (ParseErrorBundle (TokStream s) e) a)
parseTokStreamT ParsecT e (TokStream s) m a
p

type CharParser = P.Parsec Void String

pWord :: (P.Stream s, P.Token s ~ Char, Ord e) => P.Parsec e s String
pWord :: forall s e. (Stream s, Token s ~ Char, Ord e) => Parsec e s String
pWord = Parsec e s String -> Parsec e s String
forall s e a.
(Stream s, Token s ~ Char, Ord e) =>
Parsec e s a -> Parsec e s a
pTok (Parsec e s String -> Parsec e s String)
-> Parsec e s String -> Parsec e s String
forall a b. (a -> b) -> a -> b
$ ParsecT e s Identity Char -> Parsec e s String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many ((Token s -> Bool) -> ParsecT e s Identity (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace))

pHWord :: (P.Stream s, P.Token s ~ Char, Ord e) => P.Parsec e s String
pHWord :: forall s e. (Stream s, Token s ~ Char, Ord e) => Parsec e s String
pHWord = ParsecT e s Identity Char -> ParsecT e s Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many ((Token s -> Bool) -> ParsecT e s Identity (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)) ParsecT e s Identity String
-> ParsecT e s Identity String -> ParsecT e s Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT e s Identity Char -> ParsecT e s Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many ((Token s -> Bool) -> ParsecT e s Identity (Token s)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '))

pDecimal :: (P.Stream s, P.Token s ~ Char, Ord e, Num a) => P.Parsec e s a
pDecimal :: forall s e a.
(Stream s, Token s ~ Char, Ord e, Num a) =>
Parsec e s a
pDecimal = ParsecT e s Identity ()
-> ParsecT e s Identity a -> ParsecT e s Identity a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
PL.signed ParsecT e s Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space ParsecT e s Identity a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
PL.decimal

pTok :: (P.Stream s, P.Token s ~ Char, Ord e) => P.Parsec e s a -> P.Parsec e s a
pTok :: forall s e a.
(Stream s, Token s ~ Char, Ord e) =>
Parsec e s a -> Parsec e s a
pTok Parsec e s a
p = Parsec e s a
p Parsec e s a -> ParsecT e s Identity () -> Parsec e s a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT e s Identity ()
forall s e. (Stream s, Token s ~ Char, Ord e) => Parsec e s ()
pSpace

pSpace :: (P.Stream s, P.Token s ~ Char, Ord e) => P.Parsec e s ()
pSpace :: forall s e. (Stream s, Token s ~ Char, Ord e) => Parsec e s ()
pSpace = ParsecT e s Identity Char -> ParsecT e s Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
P.skipMany (Token s -> ParsecT e s Identity (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token s
' ')

parseMaybeLenient :: P.Parsec Void s a -> s -> Maybe a
parseMaybeLenient :: forall s a. Parsec Void s a -> s -> Maybe a
parseMaybeLenient Parsec Void s a
p = Either (ParseErrorBundle s Void) a -> Maybe a
forall (m :: * -> *) e a. Alternative m => Either e a -> m a
eitherToMaybe (Either (ParseErrorBundle s Void) a -> Maybe a)
-> (s -> Either (ParseErrorBundle s Void) a) -> s -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void s a
-> String -> s -> Either (ParseErrorBundle s Void) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.parse Parsec Void s a
p String
"parseMaybeLenient"

parseOrFail :: (P.ShowErrorComponent e, P.VisualStream s, P.TraversableStream s) => P.Parsec e s a -> s -> a
parseOrFail :: forall e s a.
(ShowErrorComponent e, VisualStream s, TraversableStream s) =>
Parsec e s a -> s -> a
parseOrFail Parsec e s a
p = (ParseErrorBundle s e -> a)
-> (a -> a) -> Either (ParseErrorBundle s e) a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> a
forall a. HasCallStack => String -> a
error (String -> a)
-> (ParseErrorBundle s e -> String) -> ParseErrorBundle s e -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle s e -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
P.errorBundlePretty) a -> a
forall a. a -> a
id (Either (ParseErrorBundle s e) a -> a)
-> (s -> Either (ParseErrorBundle s e) a) -> s -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.parse Parsec e s a
p String
"parseMaybeLenient"

parseLines :: P.Parsec Void String a -> String -> Maybe [a]
parseLines :: forall a. Parsec Void String a -> String -> Maybe [a]
parseLines Parsec Void String a
p = [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> (String -> [a]) -> String -> Maybe [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe a) -> [String] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Parsec Void String a -> String -> Maybe a
forall s a. Parsec Void s a -> s -> Maybe a
parseMaybeLenient Parsec Void String a
p) ([String] -> [a]) -> (String -> [String]) -> String -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

parseWords :: P.Parsec Void (TokStream String) a -> String -> Maybe a
parseWords :: forall a. Parsec Void (TokStream String) a -> String -> Maybe a
parseWords Parsec Void (TokStream String) a
p = Parsec Void (TokStream String) a -> TokStream String -> Maybe a
forall s a. Parsec Void s a -> s -> Maybe a
parseMaybeLenient Parsec Void (TokStream String) a
p (TokStream String -> Maybe a)
-> (String -> TokStream String) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> TokStream String
forall a. [a] -> TokStream a
TokStream ([String] -> TokStream String)
-> (String -> [String]) -> String -> TokStream String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words

type TokParser s = P.Parsec Void (TokStream s)

-- | Skip every result until this token matches
nextMatch :: P.MonadParsec e s m => m a -> m a
nextMatch :: forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
nextMatch = m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (m a -> m a) -> (m a -> m a) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Token s], a) -> a) -> m ([Token s], a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Token s], a) -> a
forall a b. (a, b) -> b
snd (m ([Token s], a) -> m a)
-> (m a -> m ([Token s], a)) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Token s) -> m a -> m ([Token s], a)
forall (m :: * -> *) a end.
MonadPlus m =>
m a -> m end -> m ([a], end)
P.manyTill_ (m (Token s) -> m (Token s)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try m (Token s)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
P.anySingle)

toNatural :: Integral a => a -> Maybe Natural
toNatural :: forall a. Integral a => a -> Maybe Natural
toNatural a
x = a -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x Natural -> Maybe () -> Maybe Natural
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0)

factorial :: Int -> Int
factorial :: Int -> Int
factorial Int
n = Int -> Int -> Int
go Int
2 Int
1
  where
    go :: Int -> Int -> Int
go Int
i !Int
x
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n     = Int
x
      | Bool
otherwise = Int -> Int -> Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)

integerFactorial :: Integer -> Integer
integerFactorial :: Integer -> Integer
integerFactorial Integer
n = Integer -> Integer -> Integer
go Integer
2 Integer
1
  where
    go :: Integer -> Integer -> Integer
go Integer
i !Integer
x
      | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
n     = Integer
x
      | Bool
otherwise = Integer -> Integer -> Integer
go (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
i)

mapMaybeSet :: Ord b => (a -> Maybe b) -> Set a -> Set b
mapMaybeSet :: forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
mapMaybeSet a -> Maybe b
f = [b] -> Set b
forall a. Ord a => [a] -> Set a
S.fromList ([b] -> Set b) -> (Set a -> [b]) -> Set a -> Set b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f ([a] -> [b]) -> (Set a -> [a]) -> Set a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
S.toList

symDiff :: Ord a => Set a -> Set a -> Set a
symDiff :: forall a. Ord a => Set a -> Set a -> Set a
symDiff Set a
x Set a
y = (Set a
x Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set a
y) Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.\\ (Set a
x Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.intersection` Set a
y)

memo4
    :: Memo.Memo a -> Memo.Memo b -> Memo.Memo c -> Memo.Memo d
    -> (a -> b -> c -> d -> r)
    -> (a -> b -> c -> d -> r)
memo4 :: forall a b c d r.
Memo a
-> Memo b
-> Memo c
-> Memo d
-> (a -> b -> c -> d -> r)
-> a
-> b
-> c
-> d
-> r
memo4 Memo a
a Memo b
b Memo c
c Memo d
d = (a -> b -> c -> d -> r) -> a -> b -> c -> d -> r
Memo a
a ((a -> b -> c -> d -> r) -> a -> b -> c -> d -> r)
-> ((a -> b -> c -> d -> r) -> a -> b -> c -> d -> r)
-> (a -> b -> c -> d -> r)
-> a
-> b
-> c
-> d
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Memo b
-> Memo c -> Memo d -> (b -> c -> d -> r) -> b -> c -> d -> r
forall a b c r.
Memo a
-> Memo b -> Memo c -> (a -> b -> c -> r) -> a -> b -> c -> r
Memo.memo3 Memo b
b Memo c
c Memo d
d ((b -> c -> d -> r) -> b -> c -> d -> r)
-> (a -> b -> c -> d -> r) -> a -> b -> c -> d -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

anaM
    :: (Monad m, R.Corecursive t, Traversable (R.Base t))
    => (a -> m (R.Base t a))
    -> a
    -> m t
anaM :: forall (m :: * -> *) t a.
(Monad m, Corecursive t, Traversable (Base t)) =>
(a -> m (Base t a)) -> a -> m t
anaM a -> m (Base t a)
f = (Compose m (Base t) (m t) -> m t)
-> (a -> Compose m (Base t) a) -> a -> m t
forall (f :: * -> *) b a.
Functor f =>
(f b -> b) -> (a -> f a) -> a -> b
R.hylo ((Base t t -> t) -> m (Base t t) -> m t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Base t t -> t
forall t. Corecursive t => Base t t -> t
R.embed (m (Base t t) -> m t)
-> (Compose m (Base t) (m t) -> m (Base t t))
-> Compose m (Base t) (m t)
-> m t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (m (Base t t)) -> m (Base t t)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m (Base t t)) -> m (Base t t))
-> (Compose m (Base t) (m t) -> m (m (Base t t)))
-> Compose m (Base t) (m t)
-> m (Base t t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Base t (m t) -> m (Base t t))
-> m (Base t (m t)) -> m (m (Base t t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Base t (m t) -> m (Base t t)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (m (Base t (m t)) -> m (m (Base t t)))
-> (Compose m (Base t) (m t) -> m (Base t (m t)))
-> Compose m (Base t) (m t)
-> m (m (Base t t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose m (Base t) (m t) -> m (Base t (m t))
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) (m (Base t a) -> Compose m (Base t) a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (m (Base t a) -> Compose m (Base t) a)
-> (a -> m (Base t a)) -> a -> Compose m (Base t) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Base t a)
f)

newtype Iterate n a = Iterate { forall {k} (n :: k) a. Iterate n a -> a
runIterate :: a }

unfoldedIterate
    :: forall n a proxy. N.SNatI n
    => proxy n
    -> (a -> a)
    -> a -> a
unfoldedIterate :: forall (n :: Nat) a (proxy :: Nat -> *).
SNatI n =>
proxy n -> (a -> a) -> a -> a
unfoldedIterate proxy n
_ a -> a
f a
x = Iterate n a -> a
forall {k} (n :: k) a. Iterate n a -> a
runIterate (Iterate 'Z a
-> (forall (m :: Nat). SNatI m => Iterate m a -> Iterate ('S m) a)
-> Iterate n a
forall (n :: Nat) (f :: Nat -> * -> *) a.
SNatI n =>
f 'Z a
-> (forall (m :: Nat). SNatI m => f m a -> f ('S m) a) -> f n a
N.induction1 Iterate 'Z a
start forall (m :: Nat). SNatI m => Iterate m a -> Iterate ('S m) a
forall (m :: Nat). Iterate m a -> Iterate ('S m) a
step :: Iterate n a)
  where
    start :: Iterate 'N.Z a
    start :: Iterate 'Z a
start = a -> Iterate 'Z a
forall {k} (n :: k) a. a -> Iterate n a
Iterate a
x
    step :: Iterate m a -> Iterate ('N.S m) a
    step :: forall (m :: Nat). Iterate m a -> Iterate ('S m) a
step = (a -> a) -> Iterate m a -> Iterate ('S m) a
coerce a -> a
f


-- instance Hashable a => Hashable (Seq a) where
--     hashWithSalt s = hashWithSalt s . toList
--     hash = hash . toList

instance FunctorWithIndex k (NEMap k) where
    imap :: forall a b. (k -> a -> b) -> NEMap k a -> NEMap k b
imap = (k -> a -> b) -> NEMap k a -> NEMap k b
forall k a b. (k -> a -> b) -> NEMap k a -> NEMap k b
NEM.mapWithKey
instance FoldableWithIndex k (NEMap k) where
    ifoldMap :: forall m a. Monoid m => (k -> a -> m) -> NEMap k a -> m
ifoldMap = (k -> a -> m) -> NEMap k a -> m
forall m k a. Semigroup m => (k -> a -> m) -> NEMap k a -> m
NEM.foldMapWithKey
instance TraversableWithIndex k (NEMap k) where
    itraverse :: forall (f :: * -> *) a b.
Applicative f =>
(k -> a -> f b) -> NEMap k a -> f (NEMap k b)
itraverse = (k -> a -> f b) -> NEMap k a -> f (NEMap k b)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> NEMap k a -> t (NEMap k b)
NEM.traverseWithKey

#if !MIN_VERSION_recursion_schemes(5,2,0)
data TreeF a b = NodeF a (ForestF a b)
  deriving (Show, Functor, Generic)

instance (NFData a, NFData b) => NFData (TreeF a b)
type ForestF a b = [b]

type instance R.Base (Tree a) = TreeF a
instance R.Recursive (Tree a) where
    project (Node x xs) = NodeF x xs
instance R.Corecursive (Tree a) where
    embed (NodeF x xs) = Node x xs
#endif