module TextThing2 where

-- SPDX-FileCopyrightText: Chris Pressey, the original author of this work, has dedicated it to the public domain.
-- For more information, please refer to <https://unlicense.org/>
-- SPDX-License-Identifier: Unlicense

import System.Environment

data Type = Word | Line | Para
    deriving (Show, Ord, Eq)

data Text = Char String
          | Grp Type Text
          | Seq [Text]
    deriving (Show, Ord, Eq)


whitespace (Char "\n") = True
whitespace (Char "\t") = True
whitespace (Char " ")  = True
whitespace _           = False


notEmptyWord (Grp Word (Seq [])) = False
notEmptyWord _ = True

notChar c (Char d) = not (c == d)
notChar c _ = True


-- could be implemented as the Show...

render (Char s) = s
render (Grp Line t) = (render t) ++ "\n"
render (Grp Para t) = (render t) ++ "\n"
render (Grp Word t) = render t
render (Seq []) = ""
render (Seq (t:ts)) = (render t) ++ render (Seq ts)


main = do
    [fileName] <- getArgs
    run fileName

run fileName = do
    a <- readToChars fileName

    let b = groupCharsToLines a
    let c = groupLinesToWords b
    let d = groupLinesToParas c
    putStr (render d)

    --let d' = filt notEmptyWord d
    --putStr (render d')

    let d' = filt (notChar "a") d
    putStr (render d')


demo fileName = do
    a <- readToChars fileName

    let b = groupCharsToLines a
    print b
    print (replace (Char " ") (Char "!") b)
    putStrLn ""

    let b' = groupCharsToWords a
    print b'
    print (replace (Char " ") (Char "!") b')
    putStrLn ""

    let c = groupLinesToWords b
    print c
    print (replace (Char " ") (Char "!") c)
    putStrLn ""

    let d = groupLinesToParas b
    print d
    print (replace (Char " ") (Char "!") d)
    putStrLn ""

    let d' = groupLinesToParas c
    print d'
    print (replace (Char " ") (Char "!") d')
    putStrLn ""

readToChars fileName = do
    a <- readFile fileName
    return $ Seq $ map (\x -> Char [x]) a

groupCharsToLines (Seq many) =
    Seq $ g many
    where
        g [] = []
        g cs =
            let
                (line, rest) = scanLine cs []
            in
                ((Grp Line $ Seq $ line):(g rest))

scanLine [] acc = (reverse acc, [])
scanLine (Char "\n":cs) acc = (reverse acc, cs)
scanLine (c:cs) acc = scanLine cs (c:acc)


groupCharsToWords (Seq many) =
    Seq $ g many
    where
        g [] = []
        g cs =
            let
                (word, rest) = scanWord cs []
                (spc, rest') = scanSpaces rest []
            in
                ((Grp Word $ Seq $ word):(Grp Word $ Seq $ spc):(g rest'))

scanWord [] acc = (reverse acc, [])
scanWord (c:cs) acc =
    if whitespace c then (reverse acc, (c:cs)) else scanWord cs (c:acc)

scanSpaces [] acc = (reverse acc, [])
scanSpaces (c:cs) acc =
    if not (whitespace c) then (reverse acc, (c:cs)) else scanSpaces cs (c:acc)


groupLinesToWords (Seq many) =
    Seq $ map (\(Grp Line x) -> Grp Line $ groupCharsToWords x) many


groupLinesToParas (Seq many) =
    Seq $ g many
    where
        g [] = []
        g cs =
            let
                (lines, rest) = scanPara cs []
                (spc, rest') = scanBlankLines rest []
            in
                ((Grp Para $ Seq $ lines):(g rest'))

scanPara [] acc = (reverse acc, [])
scanPara (Grp Line (Seq []):ls) acc = (reverse acc, ls)
scanPara (l:ls) acc = scanPara ls (l:acc)

scanBlankLines [] acc = (reverse acc, [])
scanBlankLines (l@(Grp Line (Seq [])):ls) acc = scanBlankLines ls (l:acc)
scanBlankLines (l:ls) acc = (reverse acc, (l:ls))


-- == experimental == --

replace a b (Seq many) =
    Seq $ map (replace a b) many
replace a b t@(Grp typ txt)
    | t == a    = b
    | otherwise = Grp typ $ replace a b txt
replace a b t@(Char c)
    | t == a    = b
    | otherwise = t


concatSeq t (Seq ts) =
   Seq (t:ts)


filt pred (Seq []) = (Seq [])
filt pred (Seq (t:ts)) =
    case pred t of
        True  -> concatSeq (filt pred t) (filt pred (Seq ts))
        False -> filt pred (Seq ts)
filt pred (Grp typ txt) =
    Grp typ $ filt pred txt
filt pred c@(Char _) =
    c