Compute the twenty-one typical vertices

typicalVertices.hs

import Data.List
import Data.Ratio
import Data.Maybe
import qualified Data.Map as Map

internalAngle :: Integer -> Rational
internalAngle sides = ((sides - 2) * 180) % sides

rotate1 :: [a] -> [a]
rotate1 list = last list : init list

canonicalPermutation :: (Ord a) => [a] -> [a]
canonicalPermutation list = maximum permutations
    where rotations = take (length list) . iterate rotate1 $ list
          permutations = rotations ++ map reverse rotations

compositions :: [Rational] -> Rational -> [[Rational]]
compositions summands n =
    let maxDifference = n - minimum summands
        ss = filter (<= maxDifference) summands
        cs = concatMap (\s -> map (s :) (compositions summands (n - s))) ss
    in  if elem n summands then cs ++ [[n]] else cs

sides = [3..42]
angles = map internalAngle sides
sidesFromAngle = Map.fromList $ zip angles sides

typicalVertices =
    sort . map (mapMaybe (flip Map.lookup $ sidesFromAngle)) $
    nub . map canonicalPermutation $
    compositions angles 360