{-|
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.
 -}