data S = S | A S S | B S S | C S S


foldS s _ _ _ S = s
foldS s a b c (A x y) = a (fold x) (fold y)
 where
  fold = foldS s a b c
foldS s a b c (B x y) = b (fold x) (fold y)
 where
  fold = foldS s a b c
foldS s a b c (C x y) = c (fold x) (fold y)
 where
  fold = foldS s a b c


sameABC :: S -> Bool
sameABC s = a==b && b==c
 where
  (a,b,c) = foldS (0,0,0)
                  (\ (a1,b1,c1) (a3,b3,c3) -> (a1+1+a3,b1+b3,c1+c3))
                  (\ (a1,b1,c1) (a3,b3,c3) -> (a1+a3,b1+1+b3,c1+c3))
                  (\ (a1,b1,c1) (a3,b3,c3) -> (a1+a3,b1+b3,c1+1+c3))
                  s


prefixAs :: S -> Bool
prefixAs s = ok
 where
  (ok,_) = foldS (\ab -> (ab>=0,ab))
                 (\f1 f3 ab -> let (ok1,ab1) = f1 ab
                                   (ok3,ab3) = f3 (ab1+1)
                                in (ok1&&ok3,ab3))
                 (\f1 f3 ab -> let (ok1,ab1) = f1 ab
                                   (ok3,ab3) = f3 (ab1-1)
                                in (ok1 && ab1>0 && ok3,ab3))
                 (\f1 f3 ab -> let (ok1,ab1) = f1 ab
                                   (ok3,ab3) = f3 ab1
                                in (ok1&&ok3,ab3))
                 s 0


suffixAs :: S -> Bool
suffixAs s = ok
 where
  (ok,_) = foldS (\ab -> (ab>=0,ab))
                 (\f1 f3 ab -> let (ok3,ab3) = f3 ab
                                   (ok1,ab1) = f1 (ab3+1)
                                in (ok3&&ok1,ab1))
                 (\f1 f3 ab -> let (ok3,ab3) = f3 ab
                                   (ok1,ab1) = f1 (ab3-1)
                                in (ok3 && ab3>0 && ok1,ab1))
                 (\f1 f3 ab -> let (ok3,ab3) = f3 ab
                                   (ok1,ab1) = f1 ab3
                                in (ok3&&ok1,ab1))
                 s 0


testSameABC = sameABC (A (B S S) (C S S))
           && not (sameABC (B (C S S) S))

testPrefixAs = prefixAs (B (A S S) (A (A S S) (B S (B S S))))
            && not (prefixAs (B (A S S) (A (B S S) (B S S))))

testSuffixAs = suffixAs (B (A (B (B S S) S) (A S S)) (A S S))
            && not (suffixAs (B (A (B S S) (B S S)) (A S S)))