zot-0.0.1: src/ZotToSki.hs

module ZotToSki ( main ) where

import Parse

rev = "1111010101001110101010010011010100100100111010101001110101010011010100101010100111010101001101010011010101001101010010101010011101010100111010101001101010010101010011101010100110101001101010100110101001010101001110101010011010100110101010011010100110101010011101010100111010101001110101010011101010100100110101001001101010010011010100100110101001010100111010101001101010011010101001101010011010101001101010010101001110101010011101010100110101001010101001110101010011010100110101010011010100101010100111010101001101010011010101001110101010011010100101010100101010011101010100110101001010100111010101001110101010011010100101010100111010101001101010010101001110101010011010100101010100101010011010100111010101001101010011010101001001010100110101001010100111010101001101010011010101001101010011010101001101010010101001110101010011101010100110101001010101001110101010011010100110101010011010100101010100111010101001101010011010101001110101010011010100101010100101010011101010100110101001010100111010101001110101010011010100101010100111010101001101010010101001110101010011010100101010100101010011010100111010101001101010011010101001001010100110101001010100111010101001101010010101001010100"

test = "11010101001010100"

-- main = putStrLn $ zotToSKI $ ( replicate 1 '1' ++ ) $ concat $ replicate 2 rev
main = interact $ zotToSKI . concat . lines

shortest :: [ [ a ] ] -> [ a ]
shortest [ ] = [ ]
shortest [ l ] = l
shortest ( l : ls )
	| length l < length ( shortest ls )	= l
	| otherwise				= shortest ls

zotToSKI :: String -> String
zotToSKI = head . {- shortest {- head -} . -} map fst . ( parseZot >*> eof `build` fst )

parseZot :: Parse Char String
parseZot = parseApply `alt` parseSKI -- `alt` parse10

parseApply :: Parse Char String
parseApply = token '1' >*> parseZot >*> parseZot `build`
	\( _, ( ski1, ski2 ) ) -> '`' : ski1 ++ ski2

parseSKI, parse10 :: Parse Char String
parseSKI = parseI `alt` parseK `alt` parseS
parse10 = parse1 `alt` parse0
	
parseI, parseK, parseS :: Parse Char String
parseI = tokens "100" `build` const "i"
parseKI = tokens "10100" `build` const "ki"
parseK = tokens "1010100" `build` const "k"
parseS = tokens "101010100" `build` const "s"

parse1, parse0 :: Parse Char String
parse1 = token '1' `build` const "1"
parse0 = token '0' `build` const "0"