{-

    Several ways of encoding arbitrarily large nonnegative integers in
    binary.

    Copyright 2015 Ken Takusagawa

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.

-}

{-# LANGUAGE ScopedTypeVariables, LambdaCase #-}
module Main where {
import System.Environment(getArgs);
import Control.Exception(assert);
import Debug.Trace(trace);
import Data.Function((&));
import Control.Category((>>>));
import Prelude hiding((.),(>>));
import Data.List;
--import Control.Monad;
--import Data.Maybe;
--import qualified Data.Map as Map;
--import Data.Map(Map);
--import qualified Data.Set as Set;
--import Data.Set(Set);

-- to avoid the redundancy warning
trace_placeholder :: ();
trace_placeholder = (trace,assert) & (id >>> error) "trace_placeholder";

main :: IO();
main = getArgs >>= \case{
["html","omega", numlines] -> omegas_sorted & take (read numlines) & as_html_table;
["html",level, numlines] -> read level & allcounts & take (read numlines) & as_html_table;
["omega",level, numlines] -> read level & omega_partial & take (read numlines) & map byteToChar & print;
_ -> error "need args";
};

zip_map :: (a -> b) -> [a] -> [(a,b)];
zip_map f l = zip l (map f l);

genericReplicateM :: (Monad m, Integral i) => i -> m a -> m [a];
genericReplicateM n = genericReplicate n >>> sequence;

unaries :: [[Bool]];
unaries = [False]:map (True:) unaries;

allcounts :: Integer -> [[Bool]];
allcounts 0 = unaries;
allcounts level = do {
size :: Integer <- enumFrom 0;
p <- genericReplicateM size [False,True];
genericIndex (pred level & allcounts) size ++ p & return;
};

bitToChar :: Bool -> Char;
bitToChar True = '1';
bitToChar False = '0';

byteToChar :: [Bool] -> String;
byteToChar = map bitToChar;

print_line :: (Integer, [Bool]) -> IO();
print_line (i,bs) = "<tr><td>"++show i++"</td><td>"++byteToChar bs++"</td><td>"++(length bs & show)++"</td></tr>" & putStrLn;

omega_partial :: Integer -> [[Bool]];
omega_partial level = do {
p <- allcounts level;
genericIndex unaries (1 + level) ++ p & return;
};

compare_lengths :: Integer -> [Integer];
compare_lengths index = enumFrom 0 & map (allcounts >>> (\l -> genericIndex l index) >>> genericLength);

all_omegas :: [[[Bool]]];
all_omegas = enumFrom 1 & map omega_partial ; -- skipping 0 because encoding 0 as 0 is elegant;

show_omegas :: [[[Bool]]] -> [[String]];
show_omegas = map (map byteToChar >>> take 10) >>> take 4;

{- normally, merge sorting an infinite list of infinite lists is
impossible because the smallest element could be just over the
horizon.  But for this application, we can take advantage of the fact
that there is a lower bound on wordsize of "omega" list of recursion
level n-}

omegas_of_length_or_less :: Integer -> [[[Bool]]];
omegas_of_length_or_less n = n - 3 & enumFromTo 0 & map omega_partial;

get_middle :: Integer -> [[a]] -> [[a]];
get_middle target = dropWhile (\l -> genericLength l < target) >>> takeWhile (\l -> genericLength l == target);

-- we can get away with concat because things are already sorted
omegas_exactly_length :: Integer -> [[Bool]];
omegas_exactly_length n = omegas_of_length_or_less n & concatMap (get_middle n);

-- we can get away with concat because things are already sorted
omegas_sorted :: [[Bool]];
omegas_sorted = [False]:(enumFrom 0 & concatMap omegas_exactly_length);

as_html_table :: [[Bool]] -> IO ();
as_html_table l = do {
putStrLn "<table border=\"1\"><tr><th>x</th><th>Encoding</th><th>Bit length</th></tr>";
zip (enumFrom 0) l & mapM_ print_line;
putStrLn "</table>";
};

} --end