Mixed types

poly.hs

import Data.Map.Strict as Map
import Data.List as List
import Control.Monad

data Transform = StringToInt (String -> Int)
               | IntToString (Int -> String)
               | IntToInt (Int -> Int)
               | StringToString (String -> String)


instance Show Transform where
    show (StringToInt _) = "(String -> Int)"
    show (IntToString _) = "(Int -> String)"
    show (IntToInt _) = "(Int -> Int)"
    show (StringToString _) = "(String -> String)"


compose :: Transform -> Transform -> Maybe Transform
compose (IntToString a) (StringToInt b) = Just $ StringToString (a . b)
compose (StringToInt a) (IntToString b) = Just $ IntToInt (a . b)
compose (StringToString a) (StringToString b) = Just $ StringToString (a . b)
compose (IntToInt a) (IntToInt b) = Just $ IntToInt (a . b)
compose (StringToInt a) (StringToString b) = Just $ StringToInt (a . b)
compose (IntToString a) (IntToInt b) = Just $ IntToString (a . b)
compose (StringToString a) (IntToString b) = Just $ IntToString (a . b)
compose _ _ = Nothing

funcs :: Map.Map String Transform
funcs = Map.fromList [ ("strToInt", StringToInt read)
                     , ("intToStr", IntToString show)
                     , ("plusOne", IntToInt (+ 1))
                     , ("reverse", StringToString reverse)
                     ]

getTransform :: String -> Maybe Transform
getTransform name = Map.lookup name funcs


composeFunctions :: [String] -> Maybe Transform
composeFunctions l =
    let functions = List.map getTransform l
        head:tail = functions
    in do
        h <- head
        foldM go h tail
            where go a (Just b) = compose b a
                  go _ _ = Nothing


getIntToString :: Transform -> Maybe (Int -> String)
getIntToString f =
    case f of
        IntToString f -> Just f
        _ -> Nothing


main :: IO ()
main =
    let chain = ["plusOne", "intToStr", "reverse", "strToInt", "plusOne", "intToStr"]
    in putStrLn $ case getIntToString =<< composeFunctions chain of
            Just f -> f 500
            Nothing -> "Failed"