    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE Rank2Types #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Control.Lens.Internal.Level
    -- Copyright   :  (C) 2012-2016 Edward Kmett
    -- License     :  BSD-style (see the file LICENSE)
    -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    -- This module provides implementation details of the combinators in
    -- "Control.Lens.Level", which provides for the breadth-first 'Control.Lens.Traversal.Traversal' of
    -- an arbitrary 'Control.Lens.Traversal.Traversal'.
    ----------------------------------------------------------------------------
    module Control.Lens.Internal.Level
      (
      -- * Levels
        Level(..)
      , Deepening(..), deepening
      , Flows(..)
      ) where

    import Control.Applicative
    import Control.Category
    import Control.Comonad
    import Data.Foldable
    import Data.Functor.Apply
    import Data.Int
    import Data.Semigroup
    import Data.Traversable
    import Data.Word
    import Prelude hiding ((.),id)

    ------------------------------------------------------------------------------
    -- Levels
    ------------------------------------------------------------------------------

    -- | This data type represents a path-compressed copy of one level of a source
    -- data structure. We can safely use path-compression because we know the depth
    -- of the tree.
    --
    -- Path compression is performed by viewing a 'Level' as a PATRICIA trie of the
    -- paths into the structure to leaves at a given depth, similar in many ways
    -- to a 'Data.IntMap.IntMap', but unlike a regular PATRICIA trie we do not need
    -- to store the mask bits merely the depth of the fork.
    --
    -- One invariant of this structure is that underneath a 'Two' node you will not
    -- find any 'Zero' nodes, so 'Zero' can only occur at the root.
    data Level i a
      = Two {-# UNPACK #-} !Word !(Level i a) !(Level i a)
      | One i a
      | Zero
      deriving (Level i a -> Level i a -> Bool
    (Level i a -> Level i a -> Bool)
    -> (Level i a -> Level i a -> Bool) -> Eq (Level i a)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    forall i a. (Eq i, Eq a) => Level i a -> Level i a -> Bool
    /= :: Level i a -> Level i a -> Bool
    $c/= :: forall i a. (Eq i, Eq a) => Level i a -> Level i a -> Bool
    == :: Level i a -> Level i a -> Bool
    $c== :: forall i a. (Eq i, Eq a) => Level i a -> Level i a -> Bool
    Eq,Eq (Level i a)
    Eq (Level i a) =>
    (Level i a -> Level i a -> Ordering)
    -> (Level i a -> Level i a -> Bool)
    -> (Level i a -> Level i a -> Bool)
    -> (Level i a -> Level i a -> Bool)
    -> (Level i a -> Level i a -> Bool)
    -> (Level i a -> Level i a -> Level i a)
    -> (Level i a -> Level i a -> Level i a)
    -> Ord (Level i a)
    Level i a -> Level i a -> Bool
    Level i a -> Level i a -> Ordering
    Level i a -> Level i a -> Level i 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 i a. (Ord i, Ord a) => Eq (Level i a)
    forall i a. (Ord i, Ord a) => Level i a -> Level i a -> Bool
    forall i a. (Ord i, Ord a) => Level i a -> Level i a -> Ordering
    forall i a. (Ord i, Ord a) => Level i a -> Level i a -> Level i a
    min :: Level i a -> Level i a -> Level i a
    $cmin :: forall i a. (Ord i, Ord a) => Level i a -> Level i a -> Level i a
    max :: Level i a -> Level i a -> Level i a
    $cmax :: forall i a. (Ord i, Ord a) => Level i a -> Level i a -> Level i a
    >= :: Level i a -> Level i a -> Bool
    $c>= :: forall i a. (Ord i, Ord a) => Level i a -> Level i a -> Bool
    > :: Level i a -> Level i a -> Bool
    $c> :: forall i a. (Ord i, Ord a) => Level i a -> Level i a -> Bool
    <= :: Level i a -> Level i a -> Bool
    $c<= :: forall i a. (Ord i, Ord a) => Level i a -> Level i a -> Bool
    < :: Level i a -> Level i a -> Bool
    $c< :: forall i a. (Ord i, Ord a) => Level i a -> Level i a -> Bool
    compare :: Level i a -> Level i a -> Ordering
    $ccompare :: forall i a. (Ord i, Ord a) => Level i a -> Level i a -> Ordering
    $cp1Ord :: forall i a. (Ord i, Ord a) => Eq (Level i a)
    Ord,Int -> Level i a -> ShowS
    [Level i a] -> ShowS
    Level i a -> String
    (Int -> Level i a -> ShowS)
    -> (Level i a -> String)
    -> ([Level i a] -> ShowS)
    -> Show (Level i a)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    forall i a. (Show i, Show a) => Int -> Level i a -> ShowS
    forall i a. (Show i, Show a) => [Level i a] -> ShowS
    forall i a. (Show i, Show a) => Level i a -> String
    showList :: [Level i a] -> ShowS
    $cshowList :: forall i a. (Show i, Show a) => [Level i a] -> ShowS
    show :: Level i a -> String
    $cshow :: forall i a. (Show i, Show a) => Level i a -> String
    showsPrec :: Int -> Level i a -> ShowS
    $cshowsPrec :: forall i a. (Show i, Show a) => Int -> Level i a -> ShowS
    Show,ReadPrec [Level i a]
    ReadPrec (Level i a)
    Int -> ReadS (Level i a)
    ReadS [Level i a]
    (Int -> ReadS (Level i a))
    -> ReadS [Level i a]
    -> ReadPrec (Level i a)
    -> ReadPrec [Level i a]
    -> Read (Level i a)
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    forall i a. (Read i, Read a) => ReadPrec [Level i a]
    forall i a. (Read i, Read a) => ReadPrec (Level i a)
    forall i a. (Read i, Read a) => Int -> ReadS (Level i a)
    forall i a. (Read i, Read a) => ReadS [Level i a]
    readListPrec :: ReadPrec [Level i a]
    $creadListPrec :: forall i a. (Read i, Read a) => ReadPrec [Level i a]
    readPrec :: ReadPrec (Level i a)
    $creadPrec :: forall i a. (Read i, Read a) => ReadPrec (Level i a)
    readList :: ReadS [Level i a]
    $creadList :: forall i a. (Read i, Read a) => ReadS [Level i a]
    readsPrec :: Int -> ReadS (Level i a)
    $creadsPrec :: forall i a. (Read i, Read a) => Int -> ReadS (Level i a)
    Read)

    -- | Append a pair of 'Level' values to get a new 'Level' with path compression.
    --
    -- As the 'Level' type is user-visible, we do not expose this as an illegal
    -- 'Semigroup' instance, and just use it directly in 'Deepening' as needed.
    lappend :: Level i a -> Level i a -> Level i a
    lappend :: Level i a -> Level i a -> Level i a
    lappend Zero        Zero        = Level i a
    forall i a. Level i a
    Zero
    lappend Zero        r :: Level i a
    r@One{}     = Level i a
    r
    lappend l :: Level i a
    l@One{}     Zero        = Level i a
    l
    lappend Zero        (Two n :: Word
    n l :: Level i a
    l r :: Level i a
    r) = Word -> Level i a -> Level i a -> Level i a
    forall i a. Word -> Level i a -> Level i a -> Level i a
    Two (Word
    n Word -> Word -> Word
    forall a. Num a => a -> a -> a
    + 1) Level i a
    l Level i a
    r
    lappend (Two n :: Word
    n l :: Level i a
    l r :: Level i a
    r) Zero        = Word -> Level i a -> Level i a -> Level i a
    forall i a. Word -> Level i a -> Level i a -> Level i a
    Two (Word
    n Word -> Word -> Word
    forall a. Num a => a -> a -> a
    + 1) Level i a
    l Level i a
    r
    lappend l :: Level i a
    l           r :: Level i a
    r           = Word -> Level i a -> Level i a -> Level i a
    forall i a. Word -> Level i a -> Level i a -> Level i a
    Two 0 Level i a
    l Level i a
    r
    {-# INLINE lappend #-}

    instance Functor (Level i) where
      fmap :: (a -> b) -> Level i a -> Level i b
    fmap f :: a -> b
    f = Level i a -> Level i b
    go where
        go :: Level i a -> Level i b
    go (Two n :: Word
    n l :: Level i a
    l r :: Level i a
    r) = Word -> Level i b -> Level i b -> Level i b
    forall i a. Word -> Level i a -> Level i a -> Level i a
    Two Word
    n (Level i a -> Level i b
    go Level i a
    l) (Level i a -> Level i b
    go Level i a
    r)
        go (One i :: i
    i a :: a
    a)   = i -> b -> Level i b
    forall i a. i -> a -> Level i a
    One i
    i (a -> b
    f a
    a)
        go Zero        = Level i b
    forall i a. Level i a
    Zero
      {-# INLINE fmap #-}

    instance Foldable (Level i) where
      foldMap :: (a -> m) -> Level i a -> m
    foldMap f :: a -> m
    f = Level i a -> m
    go where
        go :: Level i a -> m
    go (Two _ l :: Level i a
    l r :: Level i a
    r) = Level i a -> m
    go Level i a
    l m -> m -> m
    forall a. Monoid a => a -> a -> a
    `mappend` Level i a -> m
    go Level i a
    r
        go (One _ a :: a
    a) = a -> m
    f a
    a
        go Zero = m
    forall a. Monoid a => a
    mempty
      {-# INLINE foldMap #-}

    instance Traversable (Level i) where
      traverse :: (a -> f b) -> Level i a -> f (Level i b)
    traverse f :: a -> f b
    f = Level i a -> f (Level i b)
    go where
        go :: Level i a -> f (Level i b)
    go (Two n :: Word
    n l :: Level i a
    l r :: Level i a
    r) = Word -> Level i b -> Level i b -> Level i b
    forall i a. Word -> Level i a -> Level i a -> Level i a
    Two Word
    n (Level i b -> Level i b -> Level i b)
    -> f (Level i b) -> f (Level i b -> Level i b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Level i a -> f (Level i b)
    go Level i a
    l f (Level i b -> Level i b) -> f (Level i b) -> f (Level i b)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Level i a -> f (Level i b)
    go Level i a
    r
        go (One i :: i
    i a :: a
    a) = i -> b -> Level i b
    forall i a. i -> a -> Level i a
    One i
    i (b -> Level i b) -> f b -> f (Level i b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> f b
    f a
    a
        go Zero = Level i b -> f (Level i b)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Level i b
    forall i a. Level i a
    Zero
      {-# INLINE traverse #-}

    ------------------------------------------------------------------------------
    -- Generating Levels
    ------------------------------------------------------------------------------

    -- | This is an illegal 'Monoid' used to construct a single 'Level'.
    newtype Deepening i a = Deepening { Deepening i a -> forall r. Int -> (Level i a -> Bool -> r) -> r
    runDeepening :: forall r. Int -> (Level i a -> Bool -> r) -> r }

    instance Semigroup (Deepening i a) where
      Deepening l :: forall r. Int -> (Level i a -> Bool -> r) -> r
    l <> :: Deepening i a -> Deepening i a -> Deepening i a
    <> Deepening r :: forall r. Int -> (Level i a -> Bool -> r) -> r
    r = (forall r. Int -> (Level i a -> Bool -> r) -> r) -> Deepening i a
    forall i a.
    (forall r. Int -> (Level i a -> Bool -> r) -> r) -> Deepening i a
    Deepening ((forall r. Int -> (Level i a -> Bool -> r) -> r) -> Deepening i a)
    -> (forall r. Int -> (Level i a -> Bool -> r) -> r)
    -> Deepening i a
    forall a b. (a -> b) -> a -> b
    $ \ n :: Int
    n k :: Level i a -> Bool -> r
    k -> case Int
    n of
        0 -> Level i a -> Bool -> r
    k Level i a
    forall i a. Level i a
    Zero Bool
    True
        _ -> let n' :: Int
    n' = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1 in Int -> (Level i a -> Bool -> r) -> r
    forall r. Int -> (Level i a -> Bool -> r) -> r
    l Int
    n' ((Level i a -> Bool -> r) -> r) -> (Level i a -> Bool -> r) -> r
    forall a b. (a -> b) -> a -> b
    $ \x :: Level i a
    x a :: Bool
    a -> Int -> (Level i a -> Bool -> r) -> r
    forall r. Int -> (Level i a -> Bool -> r) -> r
    r Int
    n' ((Level i a -> Bool -> r) -> r) -> (Level i a -> Bool -> r) -> r
    forall a b. (a -> b) -> a -> b
    $ \y :: Level i a
    y b :: Bool
    b -> Level i a -> Bool -> r
    k (Level i a -> Level i a -> Level i a
    forall i a. Level i a -> Level i a -> Level i a
    lappend Level i a
    x Level i a
    y) (Bool
    a Bool -> Bool -> Bool
    || Bool
    b)
      {-# INLINE (<>) #-}

    -- | This is an illegal 'Monoid'.
    instance Monoid (Deepening i a) where
      mempty :: Deepening i a
    mempty = (forall r. Int -> (Level i a -> Bool -> r) -> r) -> Deepening i a
    forall i a.
    (forall r. Int -> (Level i a -> Bool -> r) -> r) -> Deepening i a
    Deepening ((forall r. Int -> (Level i a -> Bool -> r) -> r) -> Deepening i a)
    -> (forall r. Int -> (Level i a -> Bool -> r) -> r)
    -> Deepening i a
    forall a b. (a -> b) -> a -> b
    $ \ _ k :: Level i a -> Bool -> r
    k -> Level i a -> Bool -> r
    k Level i a
    forall i a. Level i a
    Zero Bool
    False
      {-# INLINE mempty #-}
      mappend :: Deepening i a -> Deepening i a -> Deepening i a
    mappend (Deepening l :: forall r. Int -> (Level i a -> Bool -> r) -> r
    l) (Deepening r :: forall r. Int -> (Level i a -> Bool -> r) -> r
    r) = (forall r. Int -> (Level i a -> Bool -> r) -> r) -> Deepening i a
    forall i a.
    (forall r. Int -> (Level i a -> Bool -> r) -> r) -> Deepening i a
    Deepening ((forall r. Int -> (Level i a -> Bool -> r) -> r) -> Deepening i a)
    -> (forall r. Int -> (Level i a -> Bool -> r) -> r)
    -> Deepening i a
    forall a b. (a -> b) -> a -> b
    $ \ n :: Int
    n k :: Level i a -> Bool -> r
    k -> case Int
    n of
        0 -> Level i a -> Bool -> r
    k Level i a
    forall i a. Level i a
    Zero Bool
    True
        _ -> let n' :: Int
    n' = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1 in Int -> (Level i a -> Bool -> r) -> r
    forall r. Int -> (Level i a -> Bool -> r) -> r
    l Int
    n' ((Level i a -> Bool -> r) -> r) -> (Level i a -> Bool -> r) -> r
    forall a b. (a -> b) -> a -> b
    $ \x :: Level i a
    x a :: Bool
    a -> Int -> (Level i a -> Bool -> r) -> r
    forall r. Int -> (Level i a -> Bool -> r) -> r
    r Int
    n' ((Level i a -> Bool -> r) -> r) -> (Level i a -> Bool -> r) -> r
    forall a b. (a -> b) -> a -> b
    $ \y :: Level i a
    y b :: Bool
    b -> Level i a -> Bool -> r
    k (Level i a -> Level i a -> Level i a
    forall i a. Level i a -> Level i a -> Level i a
    lappend Level i a
    x Level i a
    y) (Bool
    a Bool -> Bool -> Bool
    || Bool
    b)
      {-# INLINE mappend #-}

    -- | Generate the leaf of a given 'Deepening' based on whether or not we're at the correct depth.
    deepening :: i -> a -> Deepening i a
    deepening :: i -> a -> Deepening i a
    deepening i :: i
    i a :: a
    a = (forall r. Int -> (Level i a -> Bool -> r) -> r) -> Deepening i a
    forall i a.
    (forall r. Int -> (Level i a -> Bool -> r) -> r) -> Deepening i a
    Deepening ((forall r. Int -> (Level i a -> Bool -> r) -> r) -> Deepening i a)
    -> (forall r. Int -> (Level i a -> Bool -> r) -> r)
    -> Deepening i a
    forall a b. (a -> b) -> a -> b
    $ \n :: Int
    n k :: Level i a -> Bool -> r
    k -> Level i a -> Bool -> r
    k (if Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 then i -> a -> Level i a
    forall i a. i -> a -> Level i a
    One i
    i a
    a else Level i a
    forall i a. Level i a
    Zero) Bool
    False
    {-# INLINE deepening #-}

    ------------------------------------------------------------------------------
    -- Reassembling Levels
    ------------------------------------------------------------------------------

    -- | This is an illegal 'Applicative' used to replace the contents of a list of consecutive 'Level' values
    -- representing each layer of a structure into the original shape that they were derived from.
    --
    -- Attempting to 'Flow' something back into a shape other than the one it was taken from will fail.
    newtype Flows i b a = Flows { Flows i b a -> [Level i b] -> a
    runFlows :: [Level i b] -> a }

    instance Functor (Flows i b) where
      fmap :: (a -> b) -> Flows i b a -> Flows i b b
    fmap f :: a -> b
    f (Flows g :: [Level i b] -> a
    g) = ([Level i b] -> b) -> Flows i b b
    forall i b a. ([Level i b] -> a) -> Flows i b a
    Flows (a -> b
    f (a -> b) -> ([Level i b] -> a) -> [Level i b] -> b
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . [Level i b] -> a
    g)
      {-# INLINE fmap #-}

    -- | Walk down one constructor in a 'Level', veering left.
    triml :: Level i b -> Level i b
    triml :: Level i b -> Level i b
    triml (Two 0 l :: Level i b
    l _) = Level i b
    l
    triml (Two n :: Word
    n l :: Level i b
    l r :: Level i b
    r) = Word -> Level i b -> Level i b -> Level i b
    forall i a. Word -> Level i a -> Level i a -> Level i a
    Two (Word
    n Word -> Word -> Word
    forall a. Num a => a -> a -> a
    - 1) Level i b
    l Level i b
    r
    triml x :: Level i b
    x           = Level i b
    x
    {-# INLINE triml #-}

    -- | Walk down one constructor in a 'Level', veering right.
    trimr :: Level i b -> Level i b
    trimr :: Level i b -> Level i b
    trimr (Two 0 _ r :: Level i b
    r) = Level i b
    r
    trimr (Two n :: Word
    n l :: Level i b
    l r :: Level i b
    r) = Word -> Level i b -> Level i b -> Level i b
    forall i a. Word -> Level i a -> Level i a -> Level i a
    Two (Word
    n Word -> Word -> Word
    forall a. Num a => a -> a -> a
    - 1) Level i b
    l Level i b
    r
    trimr x :: Level i b
    x           = Level i b
    x
    {-# INLINE trimr #-}

    instance Apply (Flows i b) where
      Flows mf :: [Level i b] -> a -> b
    mf <.> :: Flows i b (a -> b) -> Flows i b a -> Flows i b b
    <.> Flows ma :: [Level i b] -> a
    ma = ([Level i b] -> b) -> Flows i b b
    forall i b a. ([Level i b] -> a) -> Flows i b a
    Flows (([Level i b] -> b) -> Flows i b b)
    -> ([Level i b] -> b) -> Flows i b b
    forall a b. (a -> b) -> a -> b
    $ \ xss :: [Level i b]
    xss -> case [Level i b]
    xss of
        []             -> [Level i b] -> a -> b
    mf [] ([Level i b] -> a
    ma [])
        (_:xs :: [Level i b]
    xs)         -> [Level i b] -> a -> b
    mf (Level i b -> Level i b
    forall i b. Level i b -> Level i b
    triml (Level i b -> Level i b) -> [Level i b] -> [Level i b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Level i b]
    xs) (a -> b) -> a -> b
    forall a b. (a -> b) -> a -> b
    $ [Level i b] -> a
    ma (Level i b -> Level i b
    forall i b. Level i b -> Level i b
    trimr (Level i b -> Level i b) -> [Level i b] -> [Level i b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Level i b]
    xs)
      {-# INLINE (<.>) #-}

    -- | This is an illegal 'Applicative'.
    instance Applicative (Flows i b) where
      pure :: a -> Flows i b a
    pure a :: a
    a = ([Level i b] -> a) -> Flows i b a
    forall i b a. ([Level i b] -> a) -> Flows i b a
    Flows (a -> [Level i b] -> a
    forall a b. a -> b -> a
    const a
    a)
      {-# INLINE pure #-}
      Flows mf :: [Level i b] -> a -> b
    mf <*> :: Flows i b (a -> b) -> Flows i b a -> Flows i b b
    <*> Flows ma :: [Level i b] -> a
    ma = ([Level i b] -> b) -> Flows i b b
    forall i b a. ([Level i b] -> a) -> Flows i b a
    Flows (([Level i b] -> b) -> Flows i b b)
    -> ([Level i b] -> b) -> Flows i b b
    forall a b. (a -> b) -> a -> b
    $ \ xss :: [Level i b]
    xss -> case [Level i b]
    xss of
        []             -> [Level i b] -> a -> b
    mf [] ([Level i b] -> a
    ma [])
        (_:xs :: [Level i b]
    xs)         -> [Level i b] -> a -> b
    mf (Level i b -> Level i b
    forall i b. Level i b -> Level i b
    triml (Level i b -> Level i b) -> [Level i b] -> [Level i b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Level i b]
    xs) (a -> b) -> a -> b
    forall a b. (a -> b) -> a -> b
    $ [Level i b] -> a
    ma (Level i b -> Level i b
    forall i b. Level i b -> Level i b
    trimr (Level i b -> Level i b) -> [Level i b] -> [Level i b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Level i b]
    xs)
      {-# INLINE (<*>) #-}