Amida Generator

amida.hs

import System.Environment
import System.Random
import Control.Monad
import Data.List
import Data.List.Split

data Amida = Amida { amidaRow :: Int, amidaCol :: Int, amidaMap :: [[Bool]] } deriving (Show)

main :: IO ()
main = do (r:c:[]) <- getArgs
          putAmida (read r) (read c)

putAmida :: Int -> Int -> IO ()
putAmida r c = do g <- newStdGen
                  let amida = mkAmida g r c
                  putStr $ render amida


renderLine :: Bool -> String
renderLine True = "|-----"
renderLine False = "|     "

renderLineRight :: String
renderLineRight = "|"

renderRow :: [Bool] -> String
renderRow bs = foldr (\a b -> renderLine a ++ b) renderLineRight bs

renderCol :: [[Bool]] -> String
renderCol bss = foldr (\bs s -> renderRow bs ++ "\n" ++ s) "" bss

render :: Amida -> String
render a = (renderAlphabets $ amidaCol a + 1) ++ "\n" ++ (renderCol $ amidaMap a)
            where renderAlphabets = join . (intersperse "     ") . (flip take $ [[a] | a <- ['A'..'Z']])


mkAmida :: (RandomGen g) => g -> Int -> Int -> Amida
mkAmida g r c = let amap = map transMap $ take r $ splitEvery c $ mkAmidaMap g
                in Amida {amidaRow = r, amidaCol = c, amidaMap = amap}
                where mkAmidaMap g' = randoms g'

pairs :: [a] -> [(a, a)]
pairs [] = []
pairs (x:[]) = []
pairs xs = let (xs',_) = splitAt (length xs - 1) xs
               (_,xs'') = splitAt 1 xs
           in zip xs' xs''

transPairs :: [(Bool, Bool)] -> [(Bool, Bool)]
transPairs = map (\p -> if p == (True, True) then (True, False) else p)

pairsToList :: [(Bool, Bool)] -> [Bool]
pairsToList ps = (fst $ head ps) : foldr (\(a, b) n -> b:n) [] ps

transMap = pairsToList. transPairs . pairs