import qualified Data.List as L
import Data.Maybe
import Data.Ord
import Text.Printf



perfectSqrt :: Integral a => a -> Maybe a
perfectSqrt n
  | n == 1    = Just 1
  | n < 4     = Nothing
  | otherwise =
  let search low high =
        let guess = (low + high) `div` 2
            square = guess ^ 2
            next
              | square == n  = Just guess
              | low == guess = Nothing
              | square < n   = search guess high
              | otherwise    = search low guess
        in next
  in search 0 n


heronTri :: Integral a => a -> a -> a -> Maybe a
heronTri a b c =
  let 
    areaSq16    = (a + b + c) * (b + c - a) * (a + c - b) * (a + b - c)
    (areaSq, r) = areaSq16 `divMod` 16
  in if r == 0
     then perfectSqrt areaSq
     else Nothing

isPrimitive :: Integral a => a -> a -> a -> a
isPrimitive a b c = gcd a (gcd b c)

third (_, _, x, _, _) = x
fourth (_, _, _, x, _) = x
fifth (_, _, _, _, x) = x

orders :: Ord b => [(a -> b)] -> a -> a -> Ordering
orders [f] a b = comparing f a b
orders (f:fx) a b =
  case comparing f a b of
    EQ -> orders fx a b
    n  -> n

main :: IO ()
main = do
  let range = [1 .. 200]
      tris :: [(Integer, Integer, Integer, Integer, Integer)]
      tris = L.sortBy (orders [fifth, fourth, third])
             $ map (\(a, b, c, d, e) -> (a, b, c, d, fromJust e))
             $ filter (isJust . fifth)
             [(a, b, c, a + b + c, heronTri a b c)
             | a <- range, b <- range, c <- range
             , a <= b, b <= c, isPrimitive a b c == 1]
      printTri (a, b, c, d, e) = printf "%3d%3d%3d%9d%4d\n" a b c d e
  printf "Heronian triangles found:%d\n\n" $ length tris
  putStrLn "   Sides    Perimeter Area"
  mapM_ printTri $ take 10 tris
  putStrLn ""
  mapM_ printTri $ filter ((== 210) . fifth) tris