type Name = Text

-- | Predicates of the refinement logic
data Predicate =
    BoolLit Bool
  | IntLit Int
  | Var Name
  | Unknown Name
  | Relation BinOp Predicate Predicate

  -- if p1 is true then p2 must also be true
  | Implies Predicate Predicate 
  | Not Predicate

data BinOp =
    Equal
  | And
  | Or
  | LEqual
  | Lesser
  | GEqual
  | Greater

-- | To Z3 AST
toZ3 :: Predicate -> Z3 Z3.AST
toZ3 predicate = case predicate of
  BoolLit True  -> Z3.mkTrue
  BoolLit False -> Z3.mkFalse
  IntLit i      -> Z3.mkIntNum i
  Var nm        -> do
    sort <- intSort
    s    <- Z3.mkStringSymbol $ toS nm
    Z3.mkConst s sort
  Not  p -> toZ3 p >>= Z3.mkNot

  Implies p1 p2 -> join $ Z3.mkImplies <$> toZ3 p1 <*> toZ3 p2

  Relation op p1 p2 -> join $ binOp <$> toZ3 p1 <*> toZ3 p2
   where
    binOp = case op of
      Equal   -> Z3.mkEq
      And     -> \x y -> Z3.mkAnd [x, y]
      Or      -> \x y -> Z3.mkOr [x, y]
      LEqual  -> Z3.mkLe
      GEqual  -> Z3.mkGe
      Greater -> Z3.mkGt
      Lesser  -> Z3.mkLt

-- | Search space for a single unknown
type PredicateSpace = [Predicate]
type PredicateMap = Map.Map Name PredicateSpace

-- | Valuation of a predicate unknown as a set of predicates
type Valuation = Set Predicate
-- | (Candidate) solutions for predicate unknowns
type Solution = Map.Map Name Valuation

-- | Top of the solutions 
-- (maps every unknown in unknowns to the empty set of qualifiers)
topSolution :: PredicateMap -> Solution
topSolution quals = 
  Map.fromSet (const Set.empty) (Map.keysSet quals)

-- | Substitute solutions from sol 
--   for all unknowns in predicate
substitute :: Solution -> Predicate -> Predicate
substitute sol predicate = case predicate of
  Unknown ident -> case Map.lookup ident sol of
    Just quals -> conjunction quals
    Nothing    -> predicate
  Not p             -> Not (substitute sol p)
  Implies f1 f2     -> 
    Implies (substitute sol f1) (substitute sol f2)
  Relation op f1 f2 -> 
    Relation op (substitute sol f1) (substitute sol f2)
  otherwise         -> predicate

conjunction predicates = if Set.null predicates
  then BoolLit True
  else foldr1 (Relation And) (Set.toList predicates)

solve :: [Solution] -> [Predicate] -> Z3 (Maybe Solution)
solve (sol:sols) predicates = do
  valid <- validSolution
  case valid of
    Just s  -> return $ Just s -- Solution found
    Nothing -> do
        new   <- newSolutions
        solve (new ++ sols) predicates
 where
  newSolutions = do
    modifiedCS <- modifiedConstraint
    strengthen quals modifiedCS sol

  validSolution = do
    new       <- newSolutions
    invalidCS <- invalidConstraint
    findM 
      (\s -> and <$> mapM (isValid . substitute s) 
      (delete invalidCS predicates)) new

  invalidConstraint, modifiedConstraint :: Z3 Predicate
  invalidConstraint = do
    fromJust <$> 
      findM
        (\predicate -> liftM not . isValid . substitute sol$  predicate) 
        predicates

  modifiedConstraint = do
    cs <- invalidConstraint
    case cs of
      Implies lhs rhs ->
        return $ Implies lhs (substitute sol rhs)
      _ -> panic $ toS $ "encountered ill-formed constraint " ++ (show cs)

solve :: [Solution] -> [Predicate] -> Z3 (Maybe Solution)
solve (sol:sols) predicates = do
  valid <- validSolution
  case valid of
    Just s  -> return $ Just s -- Solution found
    Nothing -> do
        new   <- newSolutions
        solve (new ++ sols) predicates
 where
  newSolutions = do
    modifiedCS <- modifiedConstraint
    strengthen quals modifiedCS sol

  validSolution = do
    new       <- newSolutions
    invalidCS <- invalidConstraint
    findM 
      (\s -> and <$> mapM (isValid . substitute s) 
      (delete invalidCS predicates)) new

  invalidConstraint, modifiedConstraint :: Z3 Predicate
  invalidConstraint = do
    fromJust <$> 
      findM
        (\predicate -> liftM not . isValid . substitute sol$  predicate) 
        predicates

  modifiedConstraint = do
    cs <- invalidConstraint
    case cs of
      Implies lhs rhs ->
        return $ Implies lhs (substitute sol rhs)
      _ -> panic $ toS $ "encountered ill-formed constraint " ++ (show cs)

-- | 'strengthen' @quals predicate sol@: all minimal strengthenings of 
-- @sol@ using predicates from @quals@ that make @predicate@ valid
strengthen :: PredicateMap -> Predicate -> Solution -> Z3 [Solution]
strengthen quals (Implies lhs rhs) sol = ...