{-| Module : Acme.StringlyTyped Description : All the benefits of stringly typed programming at all the costs. Copyright : (c) Sven Struett, 2014 License : BSD3 Maintainer : Sven.Struett@gmx.de Stability : experimental This module provides everything one ever needs to reap the benefits of stringly typed programming: - Flexibility: Stringly typed functions work together very well. In fact they provide such an improvement in flexibility that type errors will finally be the least of your problems! - Safety: The value-checking semantics you gain through repeated parsing mean that every value your code handles is verified. This is a must have for safety-critical applications and promoting your functions to work in a stringly typed environment gives it to you basically for free. Not to mention that Haskells type system is still in place to help you against critical oversights like applying a function to too many arguments. - Predictability: Reasoning about performance is hard. With stringly typed programming this luckily is a thing of the past since the repeated parsing causes everything to be predictably slow. - Quality: While the typechecking process rules out many errors, a well-typed program can of course still have run-time errors. Here the value-checking semantics come into play again by letting you know exactly when an error that was missed during typechecking happens at runtime. -} module Acme.StringlyTyped ( -- * Full Promotions -- $full promote, promote2, promote3, promote4, promote5, promote6, promote7, promote8, promote9, promote10, -- * Single Argument Promotions -- $single promoteFst, promoteSnd, promote3rd, promote4th, promote5th, promote6th, promote7th, promote8th, promote9th, promote10th, -- * Return Type Promotions -- $return promoteLast, promote2Last, promote3Last, promote4Last, promote5Last, promote6Last, promote7Last, promote8Last, promote9Last, promote10Last ) where -- |promote a normally typed function taking 1 argument to a stringly typed function promote :: (Read a, Show b) => (a -> b) -> String -> String promote = promoteFst . promoteLast -- |promote a normally typed function taking 2 arguments to a stringly typed function promote2 :: (Read a, Read b, Show c) => (a -> b -> c) -> String -> String -> String promote2 = promoteFst . promoteSnd . promote2Last -- |promote a normally typed function taking 3 arguments to a stringly typed function promote3 :: (Read a, Read b, Read c, Show d) => (a -> b -> c -> d) -> String -> String -> String -> String promote3 = promoteFst . promoteSnd . promote3rd . promote3Last -- |promote a normally typed function taking 4 arguments to a stringly typed function promote4 :: (Read a, Read b, Read c, Read d, Show e) => (a -> b -> c -> d -> e) -> String -> String -> String -> String -> String promote4 = promoteFst . promoteSnd . promote3rd . promote4th . promote4Last -- |promote a normally typed function taking 5 arguments to a stringly typed function promote5 :: (Read a, Read b, Read c, Read d, Read e, Show f) => (a -> b -> c -> d -> e -> f) -> String -> String -> String -> String -> String -> String promote5 = promoteFst . promoteSnd . promote3rd . promote4th . promote5th . promote5Last -- |promote a normally typed function taking 6 arguments to a stringly typed function promote6 :: (Read a, Read b, Read c, Read d, Read e, Read f, Show g) => (a -> b -> c -> d -> e -> f -> g) -> String -> String -> String -> String -> String -> String -> String promote6 = promoteFst . promoteSnd . promote3rd . promote4th . promote5th . promote6th . promote6Last -- |promote a normally typed function taking 7 arguments to a stringly typed function promote7 :: (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Show h) => (a -> b -> c -> d -> e -> f -> g -> h) -> String -> String -> String -> String -> String -> String -> String -> String promote7 = promoteFst . promoteSnd . promote3rd . promote4th . promote5th . promote6th . promote7th . promote7Last -- |promote a normally typed function taking 8 arguments to a stringly typed function promote8 :: (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Show i) => (a -> b -> c -> d -> e -> f -> g -> h -> i) -> String -> String -> String -> String -> String -> String -> String -> String -> String promote8 = promoteFst . promoteSnd . promote3rd . promote4th . promote5th . promote6th . promote7th . promote8th . promote8Last -- |promote a normally typed function taking 9 arguments to a stringly typed function promote9 :: (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Show j) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> String -> String -> String -> String -> String -> String -> String -> String -> String -> String promote9 = promoteFst . promoteSnd . promote3rd . promote4th . promote5th . promote6th . promote7th . promote8th . promote9th . promote9Last -- |promote a normally typed function taking 10 arguments to a stringly typed function promote10 :: (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, Read i, Read j, Show k) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> String -> String -> String -> String -> String -> String -> String -> String -> String -> String -> String promote10 = promoteFst . promoteSnd . promote3rd . promote4th . promote5th . promote6th . promote7th . promote8th . promote9th . promote10th . promote10Last -- |promote the first argument of a normally typed function promoteFst :: (Read a) => (a -> b) -> String -> b promoteFst f = fmap f read -- |promote the second argument of a normally typed function promoteSnd :: (Read b) => (a -> b -> c) -> a -> String -> c promoteSnd = fmap promoteFst -- |promote the third argument of a normally typed function promote3rd :: (Read c) => (a -> b -> c -> d) -> a -> b -> String -> d promote3rd = (fmap . fmap) promoteFst -- |promote the fourth argument of a normally typed function promote4th :: (Read d) => (a -> b -> c -> d -> e) -> a -> b -> c -> String -> e promote4th = (fmap . fmap . fmap) promoteFst -- |promote the fifth argument of a normally typed function promote5th :: (Read e) => (a -> b -> c -> d -> e -> f) -> a -> b -> c -> d -> String -> f promote5th = (fmap . fmap . fmap . fmap) promoteFst -- |promote the sixth argument of a normally typed function promote6th :: (Read f) => (a -> b -> c -> d -> e -> f -> g) -> a -> b -> c -> d -> e -> String -> g promote6th = (fmap . fmap . fmap . fmap . fmap) promoteFst -- |promote the seventh argument of a normally typed function promote7th :: (Read g) => (a -> b -> c -> d -> e -> f -> g -> h) -> a -> b -> c -> d -> e -> f -> String -> h promote7th = (fmap . fmap . fmap . fmap . fmap . fmap) promoteFst -- |promote the eighth argument of a normally typed function promote8th :: (Read h) => (a -> b -> c -> d -> e -> f -> g -> h -> i) -> a -> b -> c -> d -> e -> f -> g -> String -> i promote8th = (fmap . fmap . fmap . fmap . fmap . fmap . fmap) promoteFst -- |promote the ninth argument of a normally typed function promote9th :: (Read i) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> a -> b -> c -> d -> e -> f -> g -> h -> String -> j promote9th = (fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap) promoteFst -- |promote the tenth argument of a normally typed function promote10th :: (Read j) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> String -> k promote10th = (fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap) promoteFst -- |promote a normally typed function taking one argument to a function with a stringly typed result promoteLast :: (Show b) => (a -> b) -> a -> String promoteLast f = show . f -- |promote a normally typed function taking two arguments to a function with a stringly typed result promote2Last :: (Show c) => (a -> b -> c) -> a -> b -> String promote2Last = fmap promoteLast -- |promote a normally typed function taking three arguments to a function with a stringly typed result promote3Last :: (Show d) => (a -> b -> c -> d) -> a -> b -> c -> String promote3Last = (fmap . fmap) promoteLast -- |promote a normally typed function taking four arguments to a function with a stringly typed result promote4Last :: (Show e) => (a -> b -> c -> d -> e) -> a -> b -> c -> d -> String promote4Last = (fmap . fmap . fmap) promoteLast -- |promote a normally typed function taking five arguments to a function with a stringly typed result promote5Last :: (Show f) => (a -> b -> c -> d -> e -> f) -> a -> b -> c -> d -> e -> String promote5Last = (fmap . fmap . fmap . fmap) promoteLast -- |promote a normally typed function taking six arguments to a function with a stringly typed result promote6Last :: (Show g) => (a -> b -> c -> d -> e -> f -> g) -> a -> b -> c -> d -> e -> f -> String promote6Last = (fmap . fmap . fmap . fmap . fmap) promoteLast -- |promote a normally typed function taking seven arguments to a function with a stringly typed result promote7Last :: (Show h) => (a -> b -> c -> d -> e -> f -> g -> h) -> a -> b -> c -> d -> e -> f -> g -> String promote7Last = (fmap . fmap . fmap . fmap . fmap . fmap) promoteLast -- |promote a normally typed function taking eight arguments to a function with a stringly typed result promote8Last :: (Show i) => (a -> b -> c -> d -> e -> f -> g -> h -> i) -> a -> b -> c -> d -> e -> f -> g -> h -> String promote8Last = (fmap . fmap . fmap . fmap . fmap . fmap . fmap) promoteLast -- |promote a normally typed function taking nine arguments to a function with a stringly typed result promote9Last :: (Show j) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> String promote9Last = (fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap) promoteLast -- |promote a normally typed function taking ten arguments to a function with a stringly typed result promote10Last :: (Show k) => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> String promote10Last = (fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap . fmap) promoteLast {- $full These functions promote all arguments and the return type of the given function -} {- $single These functions promote a single argument of a function. If one needs to promote multiple but not all arguments, all that is needed is to compose the corresponding single argument promotions in order to obtain the desired promotion. This method extends to promoting the return type as well. -} {- $return These functions promote the return type of normally typed functions. -}