uniplate is being weird

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
travMD :: Traversal' CompilationUnit MemberDecl
travMD = cuTDecls . traverse . tdClass . cdBody . cbDecls . traverse . declMem

execVDTop :: NormArrT IO CompilationUnit
execVDTop = travMD . mdBlock.bStmts %%~ vdMove

u = undefined

vdMove :: NormArrT IO [Stmt]
vdMove ss = do
  let (ssF, ssT) = runWriter (vdSteal ss)
  io $ do
    hcPrint ss
    putStrLn $ replicate 80 '-'
    hcPrint ssF
    putStrLn $ replicate 80 '-'
    hcPrint ssT
    putStrLn $ replicate 80 '-'
    hcPrint $ ssT `isPrefixOf` ss
  {-
  -}
  (if ssT `isPrefixOf` ss then unique else change) $ ssT ++ ssF

vdSteal :: [Stmt] -> Writer [Stmt] [Stmt]
vdSteal = normEvery $ filterM $ \s ->
  maybe (pure True) (const $ tell [s] >> pure False) $
        extTVD s >>= ensureMovable