-- | -- Module : Main -- Copyright : (c) OleksandrZhabenko 2022 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com -- -- Simple tool to create html presentation for text. The html and css template is taken from different tutorials -- in the Internet (with changes). The idea is to post some text on the background partially transparent image. -- The meaning of the command line parameters by the first modifier is the following: -- -- "f" -> name of the file where the text presented is written; -- -- "i" -> path to the image file to be used; -- -- "h" -> title and the main header; -- -- "a" -> author; -- -- "p" -> width of the textual div in percentage (no % sign needed); -- -- "d" -> width of the header container in percentage (no % sign needed); -- -- "s" -> font-size in percents for text; -- -- "o" -> opacity for the image; -- -- "w" -> width of the main container; -- -- "b" -> background-color; -- -- "c" -> color; module Main where import Data.Lists.FLines (newLineEnding) import System.Environment (getArgs) import CLI.Arguments import CLI.Arguments.Parsing import CLI.Arguments.Get import Data.Monoid (mconcat,mappend) main :: IO () main = do args <- getArgs let argsB = fst . takeBsR bSpecs $ args file = mconcat . getB "f" $ argsB image = mconcat . getB "i" $ argsB header = (\ts -> if null ts then "Заголовок" else ts) . mconcat . getB "h" $ argsB author = (\ts -> if null ts then "Автор" else ts) . mconcat . getB "a" $ argsB fontsize = (\ts -> if null ts then "100" else ts) . mconcat . getB "s" $ argsB opacity = (\ts -> if null ts then "0.5" else ts) . mconcat . getB "o" $ argsB width = (\ts -> if null ts then "1080" else ts) . mconcat . getB "w" $ argsB widthH = (\ts -> if null ts then "10" else ts) . mconcat . getB "d" $ argsB widthP = (\ts -> if null ts then "70" else ts) . mconcat . getB "p" $ argsB backgroundcolor = (\ts -> if null ts then "#025abb" else ts) . mconcat . getB "b" $ argsB color = (\ts -> if null ts then "#fed501" else ts) . mconcat . getB "c" $ argsB text <- readFile file let lineS = concatMap (\xs -> " " `mappend` xs `mappend` "
" `mappend` newLineEnding) . lines $ text appendFile (header ++ ".html") $ mconcat ["", newLineEnding, "", newLineEnding, "", newLineEnding, "", newLineEnding, "", header, "", newLineEnding, "",author,"", newLineEnding, "", newLineEnding, "", newLineEnding, "", newLineEnding, "
", newLineEnding, "
", newLineEnding, "
", newLineEnding, " ", newLineEnding, "
", newLineEnding, "
", newLineEnding, "
", newLineEnding, "
", newLineEnding, "

",header,"

", newLineEnding, "

", newLineEnding] `mappend` lineS `mappend` mconcat ["

", newLineEnding, "
", newLineEnding, "
", newLineEnding, "
", newLineEnding, "", newLineEnding, "", newLineEnding] bSpecs = zip ["f","i","h","a","p","d","s","o","w","b","c"] . cycle $ [1]