Untitled

mail@pastecode.io avatar
unknown
haskell
2 years ago
3.0 kB
4
Indexable
Never
module Main where
import System.Environment
import Data.Char
import Data.Map
import Data.List
import Prelude hiding (lines, (++)) 


traiter :: String -> String
traiter texte = parsedText
    where
        parsedText = getOutput $ lines texte

getOutput :: [String] -> String
getOutput lines = output
    where
        tokens = getTokens lines
        output = loop "" tokens (0, 0, 0, empty)

getTokens :: [String] -> [String]
getTokens [] = []
getTokens (l:ls) =
    if head l == '\\' then
        [l] ++ ["\n"] ++ getTokens ls
    else
        words l ++ ["\n"] ++ getTokens ls

loop :: String -> [String] -> (Int, Int, Int, Map String String) -> String
loop output tokens state = do
    let (str, newState) = processToken (head tokens) state
    let newOutput = if head tokens == "\n" then output ++ str else output ++ " " ++ str
    if length (tail tokens) == 0 then
        newOutput
    else
        loop newOutput (tail tokens) newState

processToken :: String -> (Int, Int, Int, Map String String) -> (String, (Int, Int, Int, Map String String))
processToken token state = do
    if head token == '\\' && isInfixOf "section" token then
        let newState = incrementSec $ resetNb state
        in ("Section " ++ show (get1st newState) ++ " : " ++ (head $ consume token), newState) 
    else if head token == '\\' && isInfixOf "figure" token then
        let newState = incrementFig state
        in ("Figure " ++ show (get1st newState) ++ "." ++ show (get2nd newState) ++ " : " ++ (head $ consume token), newState)
    else if head token == '\\' && isInfixOf "table" token then
        let newState = incrementTab state
        in ("Table " ++ show (get1st newState) ++ "." ++ show (get3rd newState) ++ " : " ++ (head $ consume token), newState)
    else
        (token, state)

-- https://stackoverflow.com/questions/21298098/haskell-extract-substring-within-a-string --
consume :: String -> [String]
consume [] = []
consume ('{':xs) = let (v,rest) = consume' xs in v:consume rest
consume (_:xs) = consume xs

consume' :: String -> (String, String)
consume' [] = ([], [])
consume' ('}':xs) = ([], xs)
consume' (x:xs) = let (v,rest) = consume' xs in (x:v, rest)

resetNb :: (Int, Int, Int, Map String String) -> (Int, Int, Int, Map String String)
resetNb (a, b, c, d) = (a, 0, 0, d)

incrementSec :: (Int, Int, Int, Map String String) -> (Int, Int, Int, Map String String)
incrementSec (a, b, c, d) = (a+1, b, c, d)

incrementFig :: (Int, Int, Int, Map String String) -> (Int, Int, Int, Map String String)
incrementFig (a, b, c, d) = (a, b+1, c, d)

incrementTab :: (Int, Int, Int, Map String String) -> (Int, Int, Int, Map String String)
incrementTab (a, b, c, d) = (a, b, c+1, d)

get1st :: (a, b, c, d) -> a
get1st (a, _, _, _) = a

get2nd :: (a, b, c, d) -> b
get2nd (_, a, _, _) = a

get3rd :: (a, b, c, d) -> c
get3rd (_, _, a, _) = a

main::IO()
main = do 
        argv <- getArgs
        texte <- readFile ( head argv )
        putStr (traiter texte)