Consider the following type constructor:
newtype Mapnad k v = Mapnad { runMapnad :: Map [k] v }
Since Ord k => Ord [k] (lexicographical order), we can reuse the functor instance for maps for this type in an obvious way:
deriving instance Ord k => Functor (Mapnad k)
Furthermore, it seems as though Ord k => Monad (Mapnad k), according to the following scheme:
-- For readability
type (×) = (,)
infixr ×
toList' :: Ord k => Mapnad k v -> [[k] × v]
fromList' :: Ord k => [[k] × v] -> Mapnad k v
return' :: Ord k => a -> Mapnad k a
return' = fromList' . return . return
join' :: Ord k => Mapnad k (Mapnad k v) -> Mapnad k v
join' =
fmap toList' -- Mapnad k [[k] × v]
>>> toList' -- [[k] × [[k] × v]]
>>> (=<<) sequenceA -- [[k] × [k] × v]
>>> fmap join -- [[k] × v]
>>> fromList' -- Mapnad k v
-- Note: we are using the writer monad for tuples above
instance Ord k => Applicative (Mapnad k)
where
pure = return
(<*>) = ap
instance Ord k => Monad (Mapnad k)
where
return = return'
ma >>= amb = join' $ fmap amb ma
Is this a legal monad instance? QuickCheck seems to suggest so, but it'd be good to know for sure one way or the other.
Bonus question: Assuming this is indeed a monad, are there any monoids k besides the free [a] monoid for which Map k is a monad? There are certainly counterexamples: i.e. monoids k for which Map k is not a monad. For instance, with the same monad instance for Map (Sum Int), QuickCheck finds a counterexample to the associativity law.
-- m >>= (\x -> k x >>= h) == m >>= k >>= h
m :: { 0 -> 0; 3 -> 7 }
k :: \x -> if (odd x) then { -3 -> 1 } else { 0 -> 0 }
h :: \x -> if (odd x) then { } else { 0 -> 0 }
It is not a monad. We can adapt your counterexample for Sum; the key property is that 3 <> -3 = 0 = 0 <> 0, which introduces a choice point for the value that 0 maps to in m >>= k. We can choose, e.g., "" <> "a" = "a" <> "" to set up the same choice. So:
m = { "" -> 0; "a" -> 7 }
k x = if odd x then { "" -> 1 } else { "a" -> 0 }
h x = if odd x then { } else { "" -> 0 }
Then I observe:
m >>= k >>= h = { }
m >>= (\x -> k x >>= h) = { "a" -> 0 }
Every non-trivial monoid has such choice points. The associativity property of monoids says:
a <> (b <> c) = (a <> b) <> c
So you are in trouble if there are any a and b for which a /= a <> b.
(It is a monad if you choose the trivial monoid: specifically, it is (monad-isomorphic to) Maybe.)
Related
I want to build a Hilbert matrix using the linear package and convert it to a list of lists. While this seems an easy task the type level constraints come into my way:
import Linear
import Linear.V
import Data.Vector qualified as V
-- | Outer (tensor) product of two vectors
outerWith :: (Functor f, Functor g, Num a) => (a -> a -> a) -> f a -> g a -> f (g a)
{-# INLINABLE outerWith #-}
outerWith f a b = fmap (\x -> fmap (f x) b) a
hilbertV :: forall a n. (Fractional a, Dim n) => Integer -> V n (V n a)
hilbertV n =
let v = V $ V.fromList $ fromIntegral <$> [1..n]
w = V $ V.fromList $ fromIntegral <$> [0..n-1]
in luInv $ outerWith (+) w v
listsFromM :: V n (V n a) -> [[a]]
listsFromM m = vToList (vToList <$> m)
vToList :: V n a -> [a]
vToList = V.toList . toVector
hilbertL :: forall a. (Fractional a) => Integer -> [[a]]
hilbertL n = listsFromM (hilbertV n)
When doing this the following error arises in the last line hilbertL n = listsFromM (hilbertV n):
bench/Solve.hs:28:26: error:
• Could not deduce (Dim n0) arising from a use of ‘hilbertV’
from the context: Fractional a
bound by the type signature for:
hilbertL :: forall a. Fractional a => Integer -> [[a]]
at bench/Solve.hs:27:1-56
The type variable ‘n0’ is ambiguous
These potential instances exist:
three instances involving out-of-scope types
instance GHC.TypeNats.KnownNat n => Dim n -- Defined in ‘Linear.V’
instance Data.Reflection.Reifies s Int =>
Dim (Linear.V.ReifiedDim s)
-- Defined in ‘Linear.V’
instance forall k (n :: k) a. Dim n => Dim (V n a)
-- Defined in ‘Linear.V’
• In the first argument of ‘listsFromM’, namely ‘(hilbertV n)’
In the expression: listsFromM (hilbertV n)
In an equation for ‘hilbertL’: hilbertL n = listsFromM (hilbertV n)
How can i get this to compile?
First, the type of HilbertV is unsafe. You shouldn't pass in an Integer size if size should be determined from the type! I think you want this:
{-# LANGUAGE TypeApplications, UnicodeSyntax #-}
hilbertV :: ∀ a n. (Fractional a, Dim n) => V n (V n a)
hilbertV = luInv $ outerWith (+) w v
where v = V $ V.fromList $ fromIntegral <$> [1..n]
w = V $ V.fromList $ fromIntegral <$> [0..n-1]
n = reflectDim #n []
(The [] just fills the proxy argument with the most concise way to generate a value-less functor input, since it is easier to pass in the type information with -XTypeApplications.)
In fact, I'd avoid even passing around n twice at all. Instead, why not factor out the marginal generation:
hilbertV :: ∀ a n. (Fractional a, Dim n) => V n (V n a)
hilbertV = luInv $ outerWith (+) w v
where v = fromIntegral <$> enumFinFrom 1
w = fromIntegral <$> enumFinFrom 0
enumFinFrom :: ∀ n a . (Enum a, Dim n) => a -> V n a
enumFinFrom ini = V . V.fromList $ take (reflectDim #n []) [ini..]
Now, for hilbertL the problem is that you have a dependent type size. The trick to deal with that are Rank2-quantified functions; linear offers reifyDim/reifyVector etc. for the purpose.
hilbertL :: ∀ a . Fractional a => Int -> [[a]]
hilbertL n = reifyDim n hilbertL'
where hilbertL' :: ∀ n p . Dim n => p n -> [[a]]
hilbertL' _ = listsFromM $ hilbertV #n
Alternatively, you could also change hilbertV to take a proxy argument for the size and then just hand that in. I've always found this a bit ugly, but it's actually more compact in this case:
hilbertV :: ∀ a n p . (Fractional a, Dim n) => p n -> V n (V n a)
hilbertV np = luInv $ outerWith (+) w v
where v = V $ V.fromList $ fromIntegral <$> [1..n]
w = V $ V.fromList $ fromIntegral <$> [0..n-1]
n = reflectDim np
hilbertL :: ∀ a . Fractional a => Int -> [[a]]
hilbertL n = reifyDim n (\np -> listsFromM $ hilbertV np)
I have the following structure:
y = [
fromList([("c", 1 ::Int)]),
fromList([("c", 5)]),
fromList([("d", 20)])
]
I can use this to update every "c":
y & mapped . at "c" . mapped %~ (+ 1)
-- [fromList [("c",2)], fromList [("c",6)], fromList [("d",20)]]
So the third entry is basically just ignored. But I want is for the operation to fail.
Only update, iff all the maps contain the key "c".
So I want:
y & mysteryOp
-- [fromList [("c",1)], fromList [("c",5)], fromList [("d",20)]]
-- fail because third entry does not contain "c" as key
I think I know which functions to use here:
over
-- I want to map the content of the list
mapped
-- map over the structure and transform to [(Maybe Int)]
traverse
-- I need to apply the operation, which will avoid
at "c"
-- I need to index into the key "c"
I just don't know how to combine them
Here's a couple of alternative approaches seeing as you like lenses;
Using laziness to delay deciding whether or not to make the changes,
f y = res
where (All c, res) = y
& each %%~ (at "c" %%~ (Wrapped . is _Just &&& fmap (applyWhen c succ)))
Or deciding upfront whether to make the changes,
f' y = under (anon y $ anyOf each (nullOf $ ix "c")) (mapped . mapped . ix "c" +~ 1) y
I don't see a way to write it as a simple composition of lens combinators, but this is a traversal that you can write from scratch. It should either traverse all values of "c" keys if every map contains such a key or else traverse no values.
We can start with a helper function to "maybe" update a map with a new key value, failing in the Maybe monad if the key doesn't exist. For reasons that will become apparent, we want to allow the update to occur in an arbitrary functor. That is, we want a function:
maybeUpdate :: (Functor f, Ord k) => k -> (v -> f v) -> Map k v -> Maybe (f (Map k v))
Is that signature clear? We check for the key k. If the key is found, we'll return Just an updated map with the key's corresponding value v updated in the f functor. Otherwise, if the key is not found, we return Nothing. We can write this pretty clearly in monad notation, though we need the ApplicativeDo extension if we only want to use Functor f constraint:
maybeUpdate :: (Functor f, Ord k) => k -> (v -> f v) -> Map k v -> Maybe (f (Map k v))
maybeUpdate k f m = do -- in Maybe monad
v <- m ^. at k
return $ do -- in "f" functor
a <- f v
return $ m & at k .~ Just a
Alternatively, these "monadic actions" are really just functor actions, so this definition can be used:
maybeUpdate' k f m =
m ^. at k <&> \v -> f v <&> \a -> m & at k .~ Just a
That's the hard part. Now, the traversal is pretty straightforward. We start with the signature:
traverseAll :: (Ord k) => k -> Traversal' [Map k v] v
traverseAll k f maps =
The idea is that this traversal starts by traversing the list of maps over the Maybe applicative using the maybeUpdate helper:
traverse (maybeUpdate k f) maps :: Maybe [f (Map k v)]
If this traversal succeeds (returns Just a list), then all keys were found, and we can sequence the f applicative actions:
sequenceA <$> traverse (maybeUpdate k f) maps :: Maybe (f [Map k v])
Now, we just use maybe to return the original list if the traversal fails:
traverseAll k f maps = maybe (pure maps) id (sequenceA <$> traverse (maybeUpdate k f) maps)
Now, with:
y :: [Map String Int]
y = [
fromList([("c", 1 ::Int)]),
fromList([("c", 5)]),
fromList([("d", 20)])
]
y2 :: [Map String Int]
y2 = [
fromList([("c", 1 ::Int)]),
fromList([("c", 5)]),
fromList([("d", 20),("c",6)])
]
we have:
> y & traverseAll "c" %~ (1000*)
[fromList [("c",1)],fromList [("c",5)],fromList [("d",20)]]
> y2 & traverseAll "c" %~ (1000*)
[fromList [("c",1000)],fromList [("c",5000)],fromList [("c",6000),("d",20)]]
Full disclosure: I was not able to construct traverseAll like that from scratch. I started with the much stupider "traversal" in the implicit identity applicative:
traverseAllC' :: (Int -> Int) -> [Map String Int] -> [Map String Int]
traverseAllC' f xall = maybe xall id (go xall)
where go :: [Map String Int] -> Maybe [Map String Int]
go (x:xs) = case x !? "c" of
Just a -> (Map.insert "c" (f a) x:) <$> go xs
Nothing -> Nothing
go [] = Just []
and once I got that up and running, I simplified it, made the Identity explicit:
traverseAllC_ :: (Int -> Identity Int) -> [Map String Int] -> Identity [Map String Int]
and converted it to a general applicative.
Anyway, here's the code:
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE RankNTypes #-}
import Data.Map (Map, fromList)
import Control.Lens
y :: [Map [Char] Int]
y = [
fromList([("c", 1 ::Int)]),
fromList([("c", 5)]),
fromList([("d", 20)])
]
y2 :: [Map [Char] Int]
y2 = [
fromList([("c", 1 ::Int)]),
fromList([("c", 5)]),
fromList([("d", 20),("c",6)])
]
traverseAll :: (Ord k) => k -> Traversal' [Map k v] v
traverseAll k f maps = maybe (pure maps) id (sequenceA <$> traverse (maybeUpdate k f) maps)
maybeUpdate :: (Functor f, Ord k) => k -> (v -> f v) -> Map k v -> Maybe (f (Map k v))
maybeUpdate k f m = do
v <- m ^. at k
return $ do
a <- f v
return $ m & at k .~ Just a
maybeUpdate' :: (Functor f, Ord k) => k -> (v -> f v) -> Map k v -> Maybe (f (Map k v))
maybeUpdate' k f m =
m ^. at k <&> \v -> f v <&> \a -> m & at k .~ Just a
main = do
print $ y & traverseAll "c" %~ (1000*)
print $ y2 & traverseAll "c" %~ (1000*)
Today I found this post on Quora, which claimed that
factorial(n) = def $ do
assert (n<=0) "Negative factorial"
ret <- var 1
i <- var n
while i $ do
ret *= i
i -= 1
return ret
could be correct Haskell code. I got curious, and ended up with
factorial :: Integer -> Integer
factorial n = def $ do
assert (n >= 0) "Negative factorial"
ret <- var 1
i <- var n
while i $ do
ret *= i
i -= 1
return ret
using var = newSTRef, canonical definitions for def, assert and while, and
a *= b = readSTRef b >>= \b -> modifySTRef a ((*) b)
a -= b = modifySTRef a ((+) (negate b))
However, (*=) and (-=) have different types:
(-=) :: Num a => STRef s a -> a -> ST s ()
(*=) :: Num a => STRef s a -> STRef s a -> ST s ()
So ret -= i wouldn't work. I've tried to create a fitting type class for this:
class (Monad m) => NumMod l r m where
(+=) :: l -> r -> m ()
(-=) :: l -> r -> m ()
(*=) :: l -> r -> m ()
instance Num a => NumMod (STRef s a) (STRef s a) (ST s) where
a += b = readSTRef b >>= \b -> modifySTRef a ((+) b)
a -= b = readSTRef b >>= \b -> modifySTRef a ((+) (negate b))
a *= b = readSTRef b >>= \b -> modifySTRef a ((*) b)
instance (Num a) => NumMod (STRef s a) a (ST s) where
a += b = modifySTRef a ((+) (b))
a -= b = modifySTRef a ((+) (negate b))
a *= b = modifySTRef a ((*) (b))
That actually works, but only as long as factorial returns an Integer. As soon as I change the return type to something else it fails. I've tried to create another instance
instance (Num a, Integral b) => NumMod (STRef s a) b (ST s) where
a += b = modifySTRef a ((+) (fromIntegral $ b))
a -= b = modifySTRef a ((+) (negate . fromIntegral $ b))
a *= b = modifySTRef a ((*) (fromIntegral b))
which fails due to overlapping instances.
Is it actually possible to create a fitting typeclass and instances to get the factorial running for any Integral a? Or will this problem always occur?
The idea
Idea is simple: wrap STRef s a in a new data type and make it an instance of Num.
Solution
First, we'll need only one pragma:
{-# LANGUAGE RankNTypes #-}
import Data.STRef (STRef, newSTRef, readSTRef, modifySTRef)
import Control.Monad (when)
import Control.Monad.ST (ST, runST)
Wrapper for STRef:
data MyRef s a
= MySTRef (STRef s a) -- reference (can modify)
| MyVal a -- pure value (modifications are ignored)
instance Num a => Num (MyRef s a) where
fromInteger = MyVal . fromInteger
A few helpers for MyRef to resemble STRef functions:
newMyRef :: a -> ST s (MyRef s a)
newMyRef x = do
ref <- newSTRef x
return (MySTRef ref)
readMyRef :: MyRef s a -> ST s a
readMyRef (MySTRef x) = readSTRef x
readMyRef (MyVal x) = return x
I'd like to implement -= and *= using a bit more general alter helper:
alter :: (a -> a -> a) -> MyRef s a -> MyRef s a -> ST s ()
alter f (MySTRef x) (MySTRef y) = readSTRef y >>= modifySTRef x . flip f
alter f (MySTRef x) (MyVal y) = modifySTRef x (flip f y)
alter _ _ _ = return ()
(-=) :: Num a => MyRef s a -> MyRef s a -> ST s ()
(-=) = alter (-)
(*=) :: Num a => MyRef s a -> MyRef s a -> ST s ()
(*=) = alter (*)
Other functions are almost unchanged:
var :: a -> ST s (MyRef s a)
var = newMyRef
def :: (forall s. ST s (MyRef s a)) -> a
def m = runST $ m >>= readMyRef
while :: (Num a, Ord a) => MyRef s a -> ST s () -> ST s ()
while i m = go
where
go = do
n <- readMyRef i
when (n > 0) $ m >> go
assert :: Monad m => Bool -> String -> m ()
assert b str = when (not b) $ error str
factorial :: Integral a => a -> a
factorial n = def $ do
assert (n >= 0) "Negative factorial"
ret <- var 1
i <- var n
while i $ do
ret *= i
i -= 1
return ret
main :: IO ()
main = print . factorial $ 1000
Discussion
Making Num instances like this feels a bit hacky, but we don't have FromInteger type class in Haskell, so I guess it's OK.
Another itchy thing is 3 *= 10 which is return (). I think it is possible to use phantom type to indicate whether MyRef is ST or pure and allow only ST on the LHS of alter.
So, here is my clumsy code implementing chained HashTable in Haskell.
{-# LANGUAGE FlexibleInstances #-}
import Data.Array(Array(..), array, bounds, elems, (//), (!))
import Data.List(foldl')
import Data.Char
import Control.Monad.State
class HashTranform a where
hashPrepare :: a -> Integer
instance HashTranform Integer where
hashPrepare = id
instance HashTranform String where
hashPrepare cs = fromIntegral (foldl' (flip ((+) . ord)) 0 cs)
divHashForSize :: (HashTranform a) => Integer -> a -> Integer
divHashForSize sz k = 1 + (hashPrepare k) `mod` sz
type Chain k v = [(k, v)]
chainWith :: (Eq k) => Chain k v -> (k, v) -> Chain k v
chainWith cs p#(k, v) = if (null after) then p:cs else before ++ p:(tail after)
where (before, after) = break ((== k) . fst) cs
chainWithout :: (Eq k) => Chain k v -> k -> Chain k v
chainWithout cs k = filter ((/= k) . fst) cs
data Hash k v = Hash {
hashFunc :: (k -> Integer)
, chainTable :: Array Integer (Chain k v)
}
--type HState k v = State (Hash k v)
instance (Show k, Show v) => Show (Hash k v) where
show = show . concat . elems . chainTable
type HashFuncForSize k = Integer -> k -> Integer
createHash :: HashFuncForSize k -> Integer -> Hash k v
createHash hs sz = Hash (hs sz) (array (1, sz) [(i, []) | i <- [1..sz]])
withSlot :: Hash k v -> k -> (Chain k v -> Chain k v) -> Hash k v
withSlot h k op
| rows < hashed = h
| otherwise = Hash hf (ht // [(hashed, op (ht!hashed))])
where hf = hashFunc h
ht = chainTable h
rows = snd (bounds ht)
hashed = hf k
insert' :: (Eq k) => Hash k v -> (k, v) -> Hash k v
insert' h p#(k, v) = withSlot h k (flip chainWith p)
delete' :: (Eq k) => Hash k v -> k -> Hash k v
delete' h k = withSlot h k (flip chainWithout k)
insert :: (Eq k) => Hash k v -> Chain k v -> Hash k v
insert src pairs = foldl' insert' src pairs
delete :: (Eq k) => Hash k v -> [k] -> Hash k v
delete src keys = foldl' delete' src keys
search :: (Eq k) => k -> Hash k v -> Maybe v
search k h
| rows < hashed = Nothing
| otherwise = k `lookup` (ht!hashed)
where hf = hashFunc h
ht = chainTable h
rows = snd (bounds ht)
hashed = hf k
The problem is I don't want to have to code like this:
new = intHash `insert` [(1112, "uygfd"), (211, "catdied")]
new' = new `delete` [(1112, "uygfd")]
I believe it's modified with State Monad somehow, but having read online tutorials I couldn't quite grasp how exactly it's done.
So could you show me how to implement at least insert, delete, search or any one of them to give exposition.
At the end of the day your "state" will be a Hash k v. Let's break the interface functions into two groups. First are "state dependent" functions like search k which has a type like Hash k v -> _ (where _ just means "something"). Second are the "state updating" functions like flip insert (k, v) and flip delete ks which have types like Hash k v -> Hash k v.
As you've noted, you can already simulate "state" by manually passing around the Hash k v argument. The State monad is nothing more than type magic to make that easier.
If you look at Control.Monad.State you'll see modify :: (s -> s) -> State s () and gets :: (s -> a) -> State s a. These functions transform your "state updating" and "state dependent" functions into "State monad actions". So now we can write a combined State monad action like so
deleteIf :: (v -> Bool) -> k -> State (Hash k v) ()
deleteIf predicate k = do
v <- gets $ search k
case fmap predicate v of
Nothing -> return ()
Just False -> return ()
Just True -> modify $ flip delete [k]
and then we can sequence together larger computations
computation = deleteIf (>0) 'a' >> deleteIf (>0) 'b'
and then execute them by "running" the State monad
runState computation (createHash f 100)
How can I check if a BST is a valid one, given its definition and using a generalized version of fold for BST?
data(Ord a, Show a, Read a) => BST a = Void | Node {
val :: a,
left, right :: BST a
} deriving (Eq, Ord, Read, Show)
fold :: (Read a, Show a, Ord a) => (a -> b -> b -> b) -> b -> BST a -> b
fold _ z Void = z
fold f z (Node x l r) = f x (fold f z l) (fold f z r)
The idea is to check that a node value is greater then all values in left-subtree and smaller than all values in its right-subtree. This must be True for all nodes in the tree. A function bstList simply output the list of (ordered) values in the BST.
Of course something like this won't work:
--isBST :: (Read a, Show a, Ord a) => BST a -> Bool
isBST t = fold (\x l r -> all (<x) (bstList l) && all (>x) (bstList r)) (True) t
because, for example, applying the fold function to the node 19 ends up all (<19) (bstList True) && all (>19) (bstList True).
Your problem seems to be that you lose information because your function only returns a boolean when it examines the left and right subtrees. So change it to also return the minimum and maximum values of the subtrees. (This is probably more efficient as well, since you don't need to used bslist to check all elements anymore)
And make a wrapper function to ignore these "auxiliary" values after you are done, of course.
(Please don't put typeclass constraints on the data type.)
A BST is valid iff an in-order traversal is monotonically increasing.
flatten tree = fold (\a l r -> l . (a:) . r) id tree []
ordered list#(_:rest) = and $ zipWith (<) list rest
ordered _ = True
isBST = ordered . flatten
A nice way of encoding this is to lean on the traversal provided by Data.Foldable.
{-# LANGUAGE DeriveFunctor, DeriveFoldable #-}
import Data.Foldable
import Data.Monoid
We can derive an instance of it automatically using an extension, but we need to reorder the fields of the Node constructor to provide us an in-order traversal.
While we're at it, we should eliminate the constraints on the data type itself. They actually provide no benefit, and has been removed from the language as of Haskell 2011. (When you want to use such constraints you should put them on instances of classes, not on the data type.)
data BST a
= Void
| Node
{ left :: BST a
, val :: a
, right :: BST a
} deriving (Eq, Ord, Read, Show, Foldable)
First we define what it means for a list to be strictly sorted.
sorted :: Ord a => [a] -> Bool
sorted [] = True
sorted [x] = True
sorted (x:xs) = x < head xs && sorted xs
-- head is safe because of the preceeding match.
Then we can use the toList method provided by Data.Foldable and the above helper.
isBST :: Ord a => BST a -> Bool
isBST = sorted . toList
We can also implement this more directly, like you asked. Since we removed the spurious constraints on the data type, we can simplify the definition of your fold.
cata :: (b -> a -> b -> b) -> b -> BST a -> b
cata _ z Void = z
cata f z (Node l x r) = f (cata f z l) x (cata f z r)
Now we need a data type to model the result of our catamorphism, which is that we either have no nodes (Z), or a range of strictly increasing nodes (T) or have failed (X)
data T a = Z | T a a | X deriving Eq
And we can then implement isBST directly
isBST' :: Ord a => BST a -> Bool
isBST' b = cata phi Z b /= X where
phi X _ _ = X
phi _ _ X = X
phi Z a Z = T a a
phi Z a (T b c) = if a < b then T a c else X
phi (T a b) c Z = if b < c then T a c else X
phi (T a b) c (T d e) = if b < c && c < d then T a e else X
This is a bit tedious, so perhaps it would be better to decompose the way we compose the interim states a bit:
cons :: Ord a => a -> T a -> T a
cons _ X = X
cons a Z = T a a
cons a (T b c) = if a < b then T a c else X
instance Ord a => Monoid (T a) where
mempty = Z
Z `mappend` a = a
a `mappend` Z = a
X `mappend` _ = X
_ `mappend` X = X
T a b `mappend` T c d = if b < c then T a d else X
isBST'' :: Ord a => BST a -> Bool
isBST'' b = cata phi Z b /= X where
phi l a r = l `mappend` cons a r
Personally, I'd probably just use the Foldable instance.
If you don't insist on using a fold you can do it like this:
ord Void = True
ord (Node v l r) = every (< v) l && every (> v) r && ord l && ord r where
every p Void = True
every p (Node v l r) = p v && every p l && every p r