-------------------------------------------------------------------------------

  {-  LANGUAGE CPP #-}

#define DO_TRACE 0
#define WARN_IGNORED_SUBPATTERNS 1
#define NEVER_IGNORE_SUBPATTERNS 0

-- Now specified via --flag=[-]USE_WWW_DEEPSEQ
--- #define USE_WW_DEEPSEQ 1

-------------------------------------------------------------------------------

#if USE_SOP
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE ConstraintKinds #-}
  {-# LANGUAGE GADTs #-}  -- for GHC 7.6.3
#endif

  {-# LANGUAGE Rank2Types #-}
  {-  LANGUAGE ScopedTypeVariables #-}

  -- For tracing only:
  {-  LANGUAGE BangPatterns #-}

-------------------------------------------------------------------------------

-- |
-- Module      :  Control.DeepSeq.Bounded.NFDataPDyn
-- Copyright   :  (c) 2014, Andrew G. Seniuk
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Andrew Seniuk <rasfar@gmail.com>
-- Stability   :  experimental
-- Portability :  GHC
--

-------------------------------------------------------------------------------

  module Control.DeepSeq.Bounded.NFDataPDyn

  (

     -- * Dynamic pattern-directed forcing

     -- | These functions are concerned with extending the forcing pattern
     -- dynamically, depending on the types of the nodes encountered while
     -- generically traversing a term.
     --
     -- (Work in progress...).

       rnfpDyn
     , deepseqpDyn
     , forcepDyn

     , rnfpDyn'
     , deepseqpDyn'
     , forcepDyn'

     , rnfpDyn''
     , deepseqpDyn''
     , forcepDyn''

     -- * Re-exported for convenience

     , module Control.DeepSeq.Bounded.NFDataP

  )

  where

-------------------------------------------------------------------------------

  import Control.DeepSeq.Bounded.NFDataP

  import Control.DeepSeq.Bounded.NFDataN  -- finally used ("*3" etc.)

#if USE_WW_DEEPSEQ
  import Control.DeepSeq ( NFData )
--import Control.DeepSeq ( rnf )
#endif

  import Data.Data ( Data )

#if 1
  import Data.Typeable ( Typeable )
  import Data.Typeable ( typeOf )
#else
-- XXX These are NOT interchangeable!
#if __GLASGOW_HASKELL__ >= 781
  import Data.Typeable ( typeRep )
#else
  import Data.Typeable ( typeOf )
#endif
#endif

  import Debug.Trace ( trace )

#if USE_SOP
  import Generics.SOP hiding ( Shape )
#endif

-------------------------------------------------------------------------------

#if DO_TRACE
  mytrace = trace
#else
  mytrace _ = id
#endif

-------------------------------------------------------------------------------

  -- | SOP/SYB hybrid dynamic 'deepseqp'.
  deepseqpDyn :: (Show a, NFDataP a, Generic a, Data a
    , All2 Show (Code a)
    , All2 NFData (Code a)
    , All2 NFDataN (Code a)
    , All2 NFDataP (Code a)
    , All2 Data (Code a)
    ) => (forall c. Data c => c -> PatNode) -> a -> b -> b
  deepseqpDyn fg a b = rnfpDyn fg a `seq` b
  -- XXX Partially-applied; is that okay in GHC RULES?
  {-  RULES
    "deepseqpDyn/composition"    forall fg1 fg2 x.  (.) (deepseqpDyn fg2) (deepseqpDyn fg1) x = deepseqpDyn (gcombQ fg1 fg2) x
      #-}

  -- | SOP/Typeable hybrid dynamic 'deepseqp'.
  deepseqpDyn'' :: (Show a, NFDataP a, Generic a, Data a
    , All2 Show (Code a)
    , All2 NFData (Code a)
    , All2 NFDataN (Code a)
    , All2 NFDataP (Code a)
--  , All2 Data (Code a)
    ) => (forall c. Typeable c => c -> PatNode) -> a -> b -> b
  deepseqpDyn'' fg a b = rnfpDyn'' fg a `seq` b
  -- XXX Partially-applied; is that okay in GHC RULES?
  {-  RULES
    "deepseqpDyn''/composition"    forall fg1 fg2 x.  (.) (deepseqpDyn'' fg2) (deepseqpDyn'' fg1) x = deepseqpDyn'' (gcombQ fg1 fg2) x
      #-}

  -- | SOP-only dynamic 'deepseqp'.
  deepseqpDyn' :: (Show a, NFDataP a, Generic a, Data a
    , All2 Generic (Code a)
    , All2 Show (Code a)
    , All2 NFData (Code a)
    , All2 NFDataN (Code a)
    , All2 NFDataP (Code a)
    ) => (forall c. Generic c => c -> PatNode) -> a -> b -> b
  deepseqpDyn' fg a b = rnfpDyn' fg a `seq` b

-------------------------------------------------------------------------------

  -- | SOP/SYB hybrid dynamic 'forcep'.
  forcepDyn :: (Show a, NFDataP a, Generic a, Data a
    , All2 Show (Code a)
    , All2 NFData (Code a)
    , All2 NFDataN (Code a)
    , All2 NFDataP (Code a)
    , All2 Data (Code a)
    ) => (forall c. Data c => c -> PatNode) -> a -> a
  forcepDyn fg x = deepseqpDyn fg x x
  {-  RULES
    "forcepDyn/composition"    forall fg1 fg2 x.  (.) (forcepDyn fg2) (forcepDyn fg1) x = forcepDyn (gcombQ fg1 fg2) x
      #-}

  -- | SOP/Typeable hybrid dynamic 'forcep'.
  forcepDyn'' :: (Show a, NFDataP a, Generic a, Data a
    , All2 Show (Code a)
    , All2 NFData (Code a)
    , All2 NFDataN (Code a)
    , All2 NFDataP (Code a)
--  , All2 Data (Code a)
    ) => (forall c. Typeable c => c -> PatNode) -> a -> a
  forcepDyn'' fg x = deepseqpDyn'' fg x x
  {-  RULES
    "forcepDyn''/composition"    forall fg1 fg2 x.  (.) (forcepDyn'' fg2) (forcepDyn'' fg1) x = forcepDyn'' (gcombQ fg1 fg2) x
      #-}

  -- | SOP-only dynamic 'forcep'.
  forcepDyn' :: (Show a, NFDataP a, Generic a, Data a
    , All2 Generic (Code a)
    , All2 Show (Code a)
    , All2 NFData (Code a)
    , All2 NFDataN (Code a)
    , All2 NFDataP (Code a)
    ) => (forall c. Generic c => c -> PatNode) -> a -> a
  forcepDyn' fg x = deepseqpDyn' fg x x

-------------------------------------------------------------------------------

#if USE_SOP

-------------------------------------------------------------------------------

#if 1

-------------------------------------------------------------------------------

-- This one, trying for a SOP (not SYB) based generic stop function arg.
-- This should be straightforward. We have adequate precedent in GNFDataP.

  -- | SOP-only dynamic 'rnfp'.
  -- Takes an SOP generic function yielding 'PatNode', which extends
  -- the pattern dynamically, depending on the type of the value node.
  rnfpDyn' :: forall a. (
               Generic a
             , All2 Generic (Code a)
             , All2 Show    (Code a)
             , All2 NFData  (Code a)
             , All2 NFDataN (Code a)
             , All2 NFDataP (Code a)
--           , NFData  a
--           , NFDataN a
--           , NFDataP a
             ) =>
                     ( forall c. (
                         Generic c
--                     , All2 Show (Code c)
                       ) => c -> PatNode
                     )
                  -> a
                  -> ()
  rnfpDyn' fg d = rnfpDynS' fg (from d)

  rnfpDynS' :: forall xss. (
                All2 Generic xss
              , All2 Show    xss
              , All2 NFData  xss
              , All2 NFDataN xss
              , All2 NFDataP xss
--            , NFData  xss
--            , NFDataN xss
--            , NFDataP xss
              ) =>
                      ( forall c. (
                          Generic c
--                      , All2 Show (Code c)
                        ) => c -> PatNode
                      )
                   -> SOP I xss
                   -> ()
  rnfpDynS' fg (SOP (Z xs))  = rnfpDynP' fg xs
  rnfpDynS' fg (SOP (S xss)) = rnfpDynS' fg (SOP xss)

  rnfpDynP' :: forall xs. (
                All Generic xs
              , All Show    xs
              , All NFData  xs
              , All NFDataN xs
              , All NFDataP xs
--            , NFData  xs
--            , NFDataN xs
--            , NFDataP xs
              ) =>
                      ( forall c. (
                          Generic c
--                      , All2 Show (Code c)
                        ) => c -> PatNode
                      )
                   -> NP I xs
                   -> ()
  rnfpDynP' fg Nil         = ()
  rnfpDynP' fg (I x :* xs)
   | trace (show $ typeOf x) False = undefined
   | WI <- pn   = trace ("Boo A "        ) $ rnfpDynP' fg xs         `seq` ()
   | otherwise  = trace ("Boo B "++show x) $ rnfpDynP' fg xs `seq` x `seq` ()
   where
--  pn = WR
    pn = fg x {-:: PatNode-}
    pat = Node pn [] {-:: Pattern-}

-------------------------------------------------------------------------------

-- Trying explicit SOP recursion, since it seems then Proxy isn't needed?

  -- | SOP/SYB hybrid dynamic 'rnfp'.
  -- Takes a SYB 'GenericQ' 'PatNode' argument, which extends the pattern
  -- dynamically, depending on the type of the value node.
---rnfpDyn :: (Generic a, All2 NFData (Code a)) => a -> ()
  rnfpDyn :: forall a. (
               Generic a
             , All2 Show    (Code a)
             , All2 NFData  (Code a)
             , All2 NFDataN (Code a)
             , All2 NFDataP (Code a)
             , All2 Data    (Code a)
--           , NFData  a
--           , NFDataN a
--           , NFDataP a
             ) =>
#if 0
                     a
#else
                     ( forall c. (
#if 1
                         Data c
#else
                         Generic c
--                     , All2 Show (Code c)
#endif
                       ) => c -> PatNode
                     )
                  -> a
#endif
                  -> ()
#if 0
  rnfpDyn d = ()
#else
  rnfpDyn fg d = rnfpDynS fg (from d)
--rnfpDyn fg d = ()
#endif

--rnfpDynS :: (All2 NFData xss) => SOP I xss -> ()
  rnfpDynS :: forall xss. (
                All2 Show    xss
              , All2 NFData  xss
              , All2 NFDataN xss
              , All2 NFDataP xss
              , All2 Data    xss
--            , NFData  xss
--            , NFDataN xss
--            , NFDataP xss
              ) =>
#if 0
                      SOP I xss
#else
                      ( forall c. (
                          Data c
                        ) => c -> PatNode
                      )
                   -> SOP I xss
#endif
                   -> ()
  rnfpDynS fg (SOP (Z xs))  = rnfpDynP fg xs
  rnfpDynS fg (SOP (S xss)) = rnfpDynS fg (SOP xss)

--rnfpDynP :: (All NFData xs) => NP I xs -> ()
  rnfpDynP :: forall xs. (
                All Show    xs
              , All NFData  xs
              , All NFDataN xs
              , All NFDataP xs
              , All Data    xs
--            , NFData  xs
--            , NFDataN xs
--            , NFDataP xs
              ) =>
#if 0
                      NP I xs
#else
                      ( forall c. (
                          Data c
                        ) => c -> PatNode
                      )
                   -> NP I xs
#endif
                   -> ()
  rnfpDynP fg Nil         = ()
--rnfpDynP fg (I x :* xs) = rnfpDynP fg xs `seq` x `seq` ()
  rnfpDynP fg (I x :* xs)
   | trace (show $ typeOf x) False = undefined
--- | trace (show $ typeOf x) $! False = undefined
#if 0
   | WI <- pn   = trace ("AAA "++show x) $ ()
   | otherwise  = trace ("BBB "++show x) $ ()
#else
   | WI <- pn   = trace ("AAA "        ) $ rnfpDynP fg xs         `seq` ()
--- | WI <- pn   = trace ("AAA "++show x) $ rnfpDynP fg xs         `seq` ()
--- | WI <- pn   = trace ("AAA "++show x) $ ()
--- | otherwise  = trace ("BBB "++show x) $ rnfpDynP fg xs `seq` rnfp pat x `seq` ()
---- | otherwise  = trace ("BBB "++show x) $ rnfpDynP fg xs `seq` rnfpDyn fg x `seq` ()
   | otherwise  = trace ("BBB "++show x) $ rnfpDynP fg xs `seq` x `seq` ()
#endif
   where
#if 0
    pn = WR
#else
    pn = trace (show $ fg x) $ fg x {-:: PatNode-}
--  pn = fg x {-:: PatNode-}
#endif
    pat = Node pn [] {-:: Pattern-}
#if 0
    proxy_a = Proxy :: Proxy a
--  proxy_a = Proxy (Proxy :: Proxy a, Proxy :: Proxy b)
#endif
--rnfpDynP (I x :* xs) = x `deepseq` (rnfpDynP xs)

-------------------------------------------------------------------------------

  -- | SOP/Typeable hybrid dynamic 'rnfp'.
  -- Takes a SYB 'GenericQ' 'PatNode' argument, which extends the pattern
  -- dynamically, depending on the type of the value node.
  rnfpDyn'' :: forall a. (
               Generic a
             , All2 Show    (Code a)
             , All2 NFData  (Code a)
             , All2 NFDataN (Code a)
             , All2 NFDataP (Code a)
--           , All2 Data    (Code a)
             ) =>
                     ( forall c. (
                         Typeable c
                       ) => c -> PatNode
                     )
                  -> a
                  -> ()
  rnfpDyn'' fg d = rnfpDyn''S fg (from d)

  rnfpDyn''S :: forall xss. (
                All2 Show    xss
              , All2 NFData  xss
              , All2 NFDataN xss
              , All2 NFDataP xss
--            , All2 Data    xss
              ) =>
                      ( forall c. (
                          Typeable c
                        ) => c -> PatNode
                      )
                   -> SOP I xss
                   -> ()
  rnfpDyn''S fg (SOP (Z xs))  = rnfpDyn''P fg xs
  rnfpDyn''S fg (SOP (S xss)) = rnfpDyn''S fg (SOP xss)

  rnfpDyn''P :: forall xs. (
                All Show    xs
              , All NFData  xs
              , All NFDataN xs
              , All NFDataP xs
--            , All Data    xs
              ) =>
                      ( forall c. (
                          Typeable c
                        ) => c -> PatNode
                      )
                   -> NP I xs
                   -> ()
  rnfpDyn''P fg Nil         = ()
  rnfpDyn''P fg (I x :* xs)
   | trace (show $ typeOf x) False = undefined
   | WI <- pn   = trace ("AAA "        ) $ rnfpDyn''P fg xs         `seq` ()
   | otherwise  = trace ("BBB "++show x) $ rnfpDyn''P fg xs `seq` x `seq` ()
   where
    pn = trace (show $ fg x) $ fg x {-:: PatNode-}
--  pn = fg x {-:: PatNode-}
    pat = Node pn [] {-:: Pattern-}

-------------------------------------------------------------------------------

#else

#if 0
               Generic a
             , HasDatatypeInfo a
--           , All Show (Map ConstructorInfo (Code a))
             , All2 NFDataP (Code a)
             , All2 Show (Code a)
             , Typeable a
             , NFDataN a
             , NFDataP a
#endif
  rnfpDyn :: forall a. (
               Generic a
             , All2 Show    (Code a)
             , All2 NFDataP (Code a)
             , All2 NFData  (Code a)
             , NFDataP a
             , NFData  a
             ) =>
#if 1
                     a
#else
                     ( forall b. (
                         Generic b
                       , All2 Show    (Code b)
                       ) => b -> PatNode
                     )
                  -> a
#endif
                  -> ()
--rnfpDyn fg d = ()
#if 1
  rnfpDyn d
#else
  rnfpDyn fg d
#endif
   -- This appears to work from the bottom-up which is not
   -- what's wanted ... but I must be mistaken? Well, not "must"...
   -- The question is whether hcollapse makes a head available
   -- without having to finish recursions completely.
#if 1
   = (rnfp pat . hcollapse . hcliftA (Proxy :: Proxy a) (\ (I x) -> K (rnfpDyn x)) . from) d
-- = (rnfp pat . hcollapse . hcliftA (Proxy :: Proxy NFDataP) (\ (I x) -> K (rnfpDyn x)) . from) d
#else
   = (rnfp pat . hcollapse . hcliftA (Proxy :: Proxy NFDataP) (\ (I x) -> K (rnfpDyn fg x)) . from) d
#endif
-- = (rnfp pat . hcollapse . hcliftA (Proxy :: Proxy a) (\ (I x) -> K (rnfpDyn fg x)) . from) d
-- = (rnfp pat . hcollapse . hcliftA proxy_a (\ (I x) -> K (rnfpDyn fg x)) . from) d
-- = rnfp pat x `seq` map (rnfpDyn fg) x `seq` ()
   where
#if 1
    pn = WR
#else
    pn = fg d {-:: PatNode-}
#endif
    pat = Node pn [] {-:: Pattern-}
    proxy_a = Proxy :: Proxy a
--  proxy_a = Proxy (Proxy :: Proxy a, Proxy :: Proxy b)

#endif

-------------------------------------------------------------------------------

#else

-------------------------------------------------------------------------------

#if 0
  -- XXX This was written to try to get rid of type errors, b/c
  -- I have definitely seen SYB refuse to compile until things
  -- are USED. (No joy yet.)
  blah :: (Show a, NFData a, NFDataP a, Data a) => a -> ()
  blah x = rnfpDynG (mkQ WI f :: GenericQ PatNode) x
   where
    f :: (Int,Bool) -> PatNode
    f (n,b) | n < 3 || not b  = WI
            | otherwise       = WS
#endif

-------------------------------------------------------------------------------

#if 0

-- Well Fuck.

#if 0
  rnfpDynG :: (Show d,NFDataP d,NFData d,Data d) => d -> ()
--rnfpDynG :: (Typeable d,Show d,NFDataP d,NFData d,Data d) => d -> ()
--rnfpDynG :: (Typeable d,Show d,NFDataP d,NFData d) => d -> ()
--rnfpDynG :: Data d => d -> ()
  rnfpDynG x = rnfpDynG' f x
   where
    f :: (Int,Bool) -> PatNode
    f (n,b) | n < 3 || not b  = WI
            | otherwise       = WS
    rnfpDynG' :: forall e. Data e => ((Int,Bool) -> PatNode) -> e -> ()
--  rnfpDynG' :: ((Int,Bool) -> PatNode) -> d -> ()
--  rnfpDynG' :: (Show d,NFDataP d,NFData d,Data d) => ((Int,Bool) -> PatNode) -> d -> ()
    rnfpDynG' f x
     = (gmapQ (rnfpDynG' f) x) `seq` ()
     where
      pn = fg x :: PatNode
      pat = Node pn [] {-:: Pattern-}
      fg = mkQ WI f
--    fg = ( mkQ WI f :: d -> PatNode )
--    fg = mkQ WI ( f :: (Int,Bool) -> PatNode )
#else
  -- Note that (rnfpDynG fg) is itself a GenericQ ().
  rnfpDynG :: forall d. (Show d,NFDataP d,NFData d,Data d) => (forall e. (Show e,NFDataP e,NFData e,Data e) => e -> PatNode) -> d -> ()
--rnfpDynG :: forall d. (Show d,NFDataP d,NFData d,Data d) => (d -> PatNode) -> d -> ()
--rnfpDynG :: forall d. (Typeable d,Show d,NFDataP d,NFData d,Data d) => (d -> PatNode) -> d -> ()
--rnfpDynG :: forall d. (Typeable d,Show d,NFDataP d,NFData d,Data d) => (forall e. (NFDataP e,NFData e,Data e) => e -> PatNode) -> d -> ()
--rnfpDynG :: (Typeable d,Show d,NFDataP d,NFData d,Data d) => (forall e. (NFDataP e,NFData e,Data e) => e -> PatNode) -> d -> ()
--rnfpDynG :: (Typeable d,Show d,NFDataP d,NFData d,Data d) => GenericQ PatNode -> d -> ()
--rnfpDynG :: forall d. (Show d, NFDataP d, Data d) => (forall d. Data d => d -> PatNode) -> d -> ()
--rnfpDynG :: GenericQ PatNode -> GenericQ ()
--rnfpDynG :: forall d a. (Show d, NFDataP d, Data d, Show a, NFDataP a, Data a) => GenericQ PatNode -> a -> ()
--rnfpDynG :: forall d. (Show d, NFDataP d, NFData d, Data d) => (d -> PatNode) -> d -> ()
--rnfpDynG :: forall d. (Show d, NFDataP d, NFData d, Data d) => GenericQ PatNode -> d -> ()
--rnfpDynG :: forall d. (Show d, NFDataP d, Data d) => GenericQ PatNode -> d -> ()
--rnfpDynG :: forall d. (Show d, NFDataP d, Data d) => GenericQ PatNode -> d -> ()
  rnfpDynG fg x
#if 0
-- = (rnfp pat x) `seq` ()
-- =                    (gmapQ ((rnfpDynG fg)::GenericQ ()) x) `seq` ()
-- =                    (gmapQ ((rnfpDynG fg)::d->()) x) `seq` ()
-- =                    (gmapQ ((rnfpDynG fg)::NFDataP d => d->()) x) `seq` ()
-- =                    ((gmapQ (rnfpDynG fg) x)::[()]) `seq` ()
   =                    (gmapQ (rnfpDynG fg) x) `seq` ()
-- = (rnfp pat x) `seq` (gmapQ (rnfpDynG fg) x) `seq` ()
#else
   | WI <- pn   = ()
   | otherwise  = (rnfp pat x) `seq` (gmapQ ((rnfpDynG (fg::forall b. (Show b,NFDataP b,NFData b,Data b) => b -> PatNode)) :: forall c. (Show c,NFDataP c,NFData c,Data c) => c -> ()) x) `seq` ()
--- | otherwise  = (rnfp pat x) `seq` (gmapQ ((rnfpDynG fg) :: forall e. (Show e,NFDataP e,NFData e,Data e) => e -> ()) x) `seq` ()
--- | otherwise  = (rnfp pat x) `seq` (gmapQ ((rnfpDynG fg) :: forall e. Data e => e -> ()) x) `seq` ()
--- | otherwise  = (rnfp pat x) `seq` (gmapQ (rnfpDynG fg) x) `seq` ()
--- | otherwise  = (rnfp pat x) `seq` ()  -- this is fine
--- | otherwise  = rnfp pat x `seq` gmapQ (rnfpDynG fg) x `seq` ()
--- | otherwise  = rnfp pat x `seq` gmapQ ((rnfpDynG fg) :: GenericQ ()) x `seq` ()
--- | otherwise  = ( ( rnfp pat ) :: d -> () ) d `seq` gmapQ (rnfpDynG fg) d `seq` ()
#endif
   where
    pn = fg x {-:: PatNode-}
    pat = Node pn [] {-:: Pattern-}
#endif

#endif

-------------------------------------------------------------------------------

#endif

-------------------------------------------------------------------------------