.hs

data Predicate = Predicate Pred [Argument]
data Argument = Qualified Qualified | ProperNoun ProperNoun
data Qualified = Qual Quant Var NounClass
data Quant = Exists | All | The | None
data ProperNoun = PN String
data NounClass = Adjective Adj NounClass | NC String (Maybe RelativeClause)
data RelativeClause = Predicate

type O a = NonDetT (Cont Expr) a


bind :: (a -> ((b -> r) -> r)) -> ((a -> r) -> r) -> (b -> r) -> r
bind = \f m -> \k -> m (\a -> f a k)

appLR, appRL :: (((a -> b) -> r ) -> r) -> ((a -> r) -> r) -> (b -> r) -> r
apLR = \f a -> \k -> f (\f' -> a (\a' -> k (f' a'))
apRL = \f a -> \k -> a (\a' -> f (\f' -> k (f' a'))

bothOrders :: O a -> O b -> O (a,b)
bothOrders l r = liftA2 (,) l r <|> liftA2 (flip (,)) r l
allOrders :: [O a] -> O [a]
allOrders ls = do
    ls' <- fromList (permute ls)
    sequence ls'

tPred :: Predicate -> O Expr
tPred (Predicate pred args) = do
    entities <- allOrders $ map tArg args'
    pure (C pred entities)
tArg :: Argument -> O Entity
tArg (ProperNoun p) = PN  p
tArg (Qualified quant var nc) = do
    nc' <- tNC nc
    v <- getVar
    mkCont $ \k -> mkConj quant v nc' k
  where
    mkConj All v lhs rhs = Forall v $ (lhs v) .-> (rhs v)
    -- ...
tNC (Adjective a nc) entity = do
   (a', nc') <- bothOrders (tAdj a entity) (tNC nc entity)
   pure (And a' nc')
tNC (NC s relClause) = do
    relClause' <- maybe (return ()) (shiftT . tSentence) relClause