{-# OPTIONS -Wall #-}
module GenFunctions (genModule) where

-- import System.IO
import Data.List

genModule :: Int -> IO ()
genModule arity = writeFile "Generated.hs" (genModule' arity)

genModule' :: Int -> String
genModule' n = unlines . map pwc $ [1..n]

pwc :: Int -> String
pwc n = unlines [pwcdoc n, sigTot n,defTot n]

pwcdoc :: Int -> String
pwcdoc n = "-- | " ++ "Pointwise composition of a binary and a " ++ arities n ++ " function."


-- Documentation strings

arities :: Int -> String
arities n | n < 0                    = error "Arities are not defined for negative numbers"
          | n == 0                   = "nullary"
          | (n-1) < length aritystrings  = aritystrings !! (n-1) ++ "nary"
          | otherwise                = show n ++ "-ary"

aritystrings :: [String]
aritystrings = ["u","bi","ter","quater","qui","se","septe","octo","nove","de"]

-- Type signatures and symbol shapes

symbol :: Int -> String
symbol n = "(" ++ (n % 2) × '-' ++ (n ÷ 2) × '¦' ++ "|" ++")"

tSuff :: Int -> Char -> Char -> String
tSuff n a v = n ~× (a:" -> ") ++ [v]

tFunc :: Int -> Char -> Char -> String
tFunc n a v = "(" ++ tSuff n a v ++ ")" 

tTot :: Int -> String
tTot n = tFunc n 'b' 'c' ++ " -> (a -> b) -> " ++ tSuff n 'a' 'c'

sigTot :: Int -> String
sigTot n = symbol n ++ "::" ++ tTot n

-- Function implementations

defTot :: Int -> String
defTot n = symbol n ++ defLhs n ++ " = " ++ defImpl n

defLhs :: Int -> String
defLhs n = " g f " ++ (intercalate " " . map vName $ [1..n])

vName :: Int -> String
vName n = 'a':show n

defImpl :: Int -> String
defImpl n = "g " ++ concatMap defApp [1..n]
  where defApp m = "(f " ++ vName m ++ ")"

-- helpers

(×) :: Int -> a -> [a]
(×) = replicate

(~×) :: Int -> [a] -> [a]
(~×) = ((.).(.)) concat replicate

(÷) :: Int -> Int -> Int
(÷) = div

(%) :: Int -> Int -> Int
(%) = mod
