content: {-# OPTIONS_GHC -fglasgow-exts #-}
  
  module DeriveHand where
  
  import Data
  import Data.Generics.Biplate
  import Data.Generics.Str
  
  
  instance Uniplate NExpr where
      uniplate x =
          case x of
              NNeg  a    -> (One a                , \(One a')    -> NNeg  a'     )
              NAdd  a b  -> (Two (One a) (One b)  , \(Two (One a') (One b')) -> NAdd  a' b'  )
              NSub  a b  -> (Two (One a) (One b)  , \(Two (One a') (One b')) -> NSub  a' b'  )
              NMul  a b  -> (Two (One a) (One b)  , \(Two (One a') (One b')) -> NMul  a' b'  )
              NDiv  a b  -> (Two (One a) (One b)  , \(Two (One a') (One b')) -> NDiv  a' b'  )
              _          -> (Zero                 , \_         -> x           )
  
  instance Biplate NExpr NExpr where
      biplate x = (Zero, const x)
  
  instance Biplate NStm NVar where
      biplate x =
          case x of
              NSDecl a b -> (One b, \(One b') -> NSDecl a b')
              NSAss a b -> (Two (One a) get, \(Two (One a') bs) -> NSAss a' (gen bs))
                  where (get,gen) = biplate b
              NSBlock xs -> (get, \xs -> NSBlock (gen xs))
                  where (get,gen) = biplate xs
              NSReturn x -> (get, \xs -> NSReturn (gen xs))
                  where (get,gen) = biplate x
  
  instance Uniplate NVar where
      uniplate x = (Zero, \_ -> x)
  
  instance Biplate NExp NVar where
      biplate x =
          case x of
              NEStm x -> (get, \xs -> NEStm (gen xs))
                  where (get,gen) = biplate x
  
              NEAdd x y -> (Two get1 get2, \(Two a b) -> NEAdd (gen1 a) (gen2 b))
                  where
                      (get1,gen1) = biplate x
                      (get2,gen2) = biplate y
  
              NEVar x -> (One x, \(One x') -> NEVar x')
  
              _ -> (Zero, \_ -> x)
  
  instance (Biplate y x, Uniplate x) => Biplate [y] x where
      biplate [] = (Zero, \_ -> [])
      biplate (x:xs) = (Two get1 get2, \(Two a b) -> gen1 a : gen2 b)
          where
              (get1,gen1) = biplate x
              (get2,gen2) = biplate xs
  
  instance Biplate NStm NStm where
      biplate x = (One x, \(One x') -> x')
  
  instance Uniplate NStm where
      uniplate x =
          case x of
              NSAss a b -> (get,\xs -> NSAss a (gen xs))
                  where (get,gen) = biplate b
              NSBlock a -> (get,\xs -> NSBlock (gen xs))
                  where (get,gen) = biplate a
              NSReturn a -> (get,\xs -> NSReturn (gen xs))
                  where (get,gen) = biplate a
              _ -> (Zero, \_ -> x)
  
  instance Biplate NExp NStm where
      biplate x =
          case x of
              NEStm a -> (One a, \(One a') -> NEStm a')
              NEAdd a b -> (Two get1 get2, \(Two a b) -> NEAdd (gen1 a) (gen2 b))
                  where
                      (get1,gen1) = biplate a
                      (get2,gen2) = biplate b
              _ -> (Zero, \_ -> x)
  
  instance Biplate NStm NExp where
      biplate x =
          case x of
              NSAss a b -> (One b, \(One b') -> NSAss a b')
              NSReturn a -> (One a, \(One a') -> NSReturn a')
              NSBlock a -> (get,\xs -> NSBlock (gen xs))
                  where (get,gen) = biplate a
              _ -> (Zero, \_ -> x)
  
  instance Uniplate NExp where
      uniplate x =
          case x of
              NEStm a -> (get, \xs -> NEStm (gen xs))
                  where (get,gen) = biplate a
              NEAdd a b -> (Two (One a) (One b), \(Two (One a') (One b')) -> NEAdd a' b')
              _ -> (Zero, \_ -> x)
  
  
  instance Biplate NCompany NSalary where
      biplate (NC xs) = (get, \xs -> NC (gen xs))
          where (get,gen) = biplate xs
  
  instance Biplate NDept NSalary where
      biplate (ND a (NE b c) d) = (Two (One c) get, \(Two (One x) xs) -> ND a (NE b x) (gen xs))
          where (get,gen) = biplate d
  
  instance Biplate NUnt NSalary where
      biplate (NPU (NE a b)) = (One b, \(One x) -> NPU (NE a x))
      biplate (NDU x) = (get, \xs -> NDU (gen xs))
          where (get,gen) = biplate x
  
  instance Uniplate NSalary where
      uniplate x = (Zero, \_ -> x)
  
  instance Biplate NCompany NDept where
      biplate (NC x) = (listStr x, NC . strList)
  
  instance Biplate NUnt NDept where
      biplate (NDU x) = (One x, \(One x') -> NDU x')
      biplate x = (Zero, \_ -> x)
  
  instance Uniplate NDept where
      uniplate (ND a b c) = (get, \xs -> ND a b (gen xs))
          where (get,gen) = biplate c
  
  {-
  data NCompany = NC [NDept] deriving Show
  data NDept = ND String NEmployee [NUnt] deriving Show
  data NUnt = NPU NEmployee | NDU NDept deriving Show
  data NEmployee = NE NPerson NSalary deriving Show
  data NPerson = NP String String deriving Show
  data NSalary = NS Float deriving Show
  -}
  