{-

Puts accents over some letters using Unicode combining diacritics,
and underlines below some using HTML.

Copyright 2018 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(main) where {
import System.Environment(getArgs);
import Control.Exception(assert);
import Debug.Trace(trace);
import Data.Function((&));
import Control.Category((>>>));
import Prelude hiding((.),(>>));
--import System.IO(hSetBuffering,stdout,BufferMode(LineBuffering));
--import System.IO(stderr,hPutStrLn);
import qualified Data.List as List;
import qualified Control.Monad as Monad;
--import qualified Data.Maybe as Maybe;
--import qualified Data.Map as Map; import Data.Map(Map);
--import qualified Data.Set as Set; import Data.Set(Set);
--import qualified Data.Bifunctor as Bifunctor;
--import qualified System.Random as Random;

import qualified Control.Monad.Random as Random;
import Control.Monad.Random(RandomGen,Rand,getRandomR,evalRand);

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

main :: IO();
main = getArgs >>= \case{
["total"] -> range_try2 & length & print;
["modify"] -> getContents >>= (modify_string >>> evalStdGen) >>= putStr;
["range"] -> range_try2 & List.intersperse "<wbr/>" & concat & putStrLn;
_ -> undefined;
};

evalStdGen :: Rand Random.StdGen a -> IO a;
evalStdGen x = Random.getStdGen >>= (evalRand x >>> return);

ascenders :: String;
ascenders = "bdfhklt";

idotless :: String;
idotless = "&#305;";
--idotless = "i";

jdotless :: String;
jdotless = "&#567;";
--jdotless = "j";

takes_upper :: String;
takes_upper = (['a'..'z'] List.\\ ascenders) List.\\ "ij";

alphabet_upper_and_lower :: String;
alphabet_upper_and_lower = ['a'..'z'] ++ ['A'..'Z'];

-- in the end, i and j are too narrow to take accents well

tohtml :: Int -> String;
tohtml i = "&#" ++ show i ++ ";";

mkStdGen2 :: Int -> Random.StdGen;
mkStdGen2 = Random.mkStdGen >>> Random.next >>> snd;

sample :: RandomGen g => [a] -> Rand g a;
sample l = do {
i <- getRandomR (0,length l & pred);
return $ l!!i;
};

-- 300 301 302 30c 308 30a ; 326 327
-- 1dfe 350


all_upper :: [Int];
all_upper = [0x300, 0x301, 0x306, 0x311, 0x303, 0x304, 0x30b, 0x30f, 0x308, 0x307, 0x30a, 0x309 ];

-- circumflex caron = 302 30c, breves = 306 311, doubles = 30b 30f
-- tilde 303 macron 304


modify_char :: RandomGen g => Char -> Rand g String;
modify_char x = do {
dolower :: Bool <- if List.elem x takes_lower then sample_bool else pure False;
if (not $ List.elem x "ij") then do {
upper :: String <- if List.elem x takes_upper then sample_upper else pure "";
return $ (pure x ++ upper & underline_html dolower);
} else sample_bool >>= (remove_dot x >>> underline_html dolower >>> return)
};

remove_dot :: Char -> Bool -> String;
remove_dot c yes = if not yes then [c] else case c of {
'i' -> idotless;
'j' -> jdotless;
_ -> error "not i or j";
};

underline_html :: Bool -> String -> String;
underline_html dolower y = if not dolower then  y else
-- "<span style=\"text-decoration: underline\">"++y++"</span>"
"<u>" ++ y ++ "</u>"  -- this supposedly does not work in HTML5
;


sample_bool :: RandomGen g => Rand g Bool;
sample_bool = sample [False,True];

-- how to make this point free?
modify_string :: RandomGen g => String -> Rand g String;
modify_string s = mapM modify_char s >>= (concat >>> return);

descenders :: String;
descenders = "gjpqyQJ"; -- some fonts descend for capital Q and J

takes_lower :: String;
takes_lower = alphabet_upper_and_lower List.\\ (descenders);

sample_upper :: RandomGen g => Rand g String;
sample_upper = all_upper & map tohtml & sample;

range_try2 :: [String];
range_try2 = do {
 nucleus :: Char <- alphabet_upper_and_lower;
 do_underline <- [False,True];
 Monad.guard $ not do_underline || List.elem nucleus takes_lower;
 (if List.elem nucleus "ij" then [False,True] >>= (remove_dot nucleus >>> return) else do {
 combining_diacritic :: String <- "":map tohtml all_upper;
 Monad.guard $ null combining_diacritic || List.elem nucleus takes_upper;
 pure nucleus ++ combining_diacritic & return;
 }) >>= (underline_html do_underline >>> return);
};

} --end