{-# LANGUAGE OverloadedStrings #-}
-- | The rendered version of the web-scraped articles
-- is available at <https://budueba.com/lessons.html>
module Main (main) where

import           Control.Lens                            -- lens
import qualified Data.ByteString.Lazy as ByteString.Lazy -- bytestring
import           Data.List.Lens (prefixed)               -- lens
import           Data.Monoid ((<>), Endo)                -- base
import           Data.Text (Text)                        -- text
import           Data.Text.Lens (unpacked)               -- lens
import qualified Data.Text as Text                       -- text
import qualified Data.Text.IO as Text                    -- text
import           Data.Traversable (for)                  -- base
import qualified Network.HTTP.Conduit as Http            -- http-conduit
import           Text.Printf (printf)                    -- base
import           Text.Xml.Lens                           -- xml-html-conduit-lens


-- | Scrap "Уроки державної мови" articles from the Web
--
-- Minor spacing issues are possible.  The pages aren't structured properly
-- level-1 headings are misinterpreted as level-2 headings.
--
-- The output is a compilation of the articles in the Github Flavored Markdown format
main :: IO ()
main = do
  man <- Http.newManager Http.tlsManagerSettings
  as <- for [2002, 2003, 2004] $ \roka -> do
    req <- Http.parseUrl (url roka)
    res <- Http.httpLbs req man
    pure (articles (toListOf atoms (roundtrip (Http.responseBody res))))
  (mapM_.mapM_) (Text.putStrLn . renderArticle) as
 where
  -- Concatenate chunks of the "lazy" bytestring to work around a html-conduit bug
  roundtrip = ByteString.Lazy.fromStrict . ByteString.Lazy.toStrict

-- | Construct the page URL for the given year
url :: Int -> String
url =
  printf "https://sites.google.com/site/mandrivnyjvolhv/ridna-vira/ridna-mova/boris-rogoza/%d"

data Article = Article
  { heading :: Text
  , content :: [Text]
  , table :: Table
  } deriving (Show)

type Table = [(Text, Text)]

renderArticle :: Article -> Text
renderArticle Article { heading = h, content = c, table = t } = Text.intercalate "\n" $
  [h, Text.replicate (Text.length h) "-"] ++ map (<> "\n") c ++ [renderTable t | not (null t)]

renderTable :: Table -> Text
renderTable xs = Text.unlines $
  ["Неправильно | Правильно", " :--------: |  :-----: "] ++ map (uncurry (\a b -> a <> " | " <> b)) xs

-- | Convert a stream of data (headings and paragraphs) to well-formed articles
articles :: [Atom] -> [Article]
articles = go Nothing
 where
  go mh xs = case span (isn't _Heading) xs of
    (ys, Heading h' : zs) -> case mh of
      Nothing -> go (Just h') zs
      Just h  -> Article {
          heading = h
        , content = toListOf (folded._Paragraph) ys
        , table = view (folded._Table) ys
        } : go (Just h') zs
    (ys, []) -> case mh of
      Nothing -> []
      Just h  -> pure Article {
          heading = h
        , content = toListOf (folded._Paragraph) ys
        , table = view (folded._Table) ys
        }
    (_, _) -> error "Impossible!"


data Atom = Heading Text | Paragraph Text | Table Table

_Heading, _Paragraph :: Prism' Atom Text
_Table               :: Prism' Atom Table
_Heading    = prism' Heading (\x -> case x of Heading h -> Just h; _ -> Nothing)
_Paragraph  = prism' Paragraph (\x -> case x of Paragraph t -> Just t; _ -> Nothing)
_Table      = prism' Table (\x -> case x of Table l -> Just l; _ -> Nothing)

-- | Combine headings, contents, and tables into the single 'Fold'
atoms :: AsHtmlDocument x => Getting (Endo [Atom]) x Atom
atoms = html.folding universe.(headings <> paragraphs <> tables)

-- | Parse articles' headings
headings :: Fold Element Atom
headings = named (only "h2").filtered (has (node "a".attributed (ix "name".unpacked.prefixed "__RefHeading"))).accText Heading

-- | Parse articles' contents
paragraphs :: Fold Element Atom
paragraphs = named (only "p").with "style" "margin-top:0.49cm;margin-bottom:0.49cm".accText Paragraph

-- | Parse articles' tables
tables :: Fold Element Atom
tables = named (only "table").with "cellpadding" "0".with "cellspacing" "1".with "width" "564".plate.plate.partsOf (runFold ((,) <$> Fold (ix 0.node "p".text.to reassemble) <*> Fold (ix 1.node "p".text.to reassemble))).to Table

with :: Applicative f => Name -> Text -> (Element -> f Element) -> Element -> f Element
with k v = attributed (ix k.only v)

-- | Sanitize the HTML node text content
accText :: (Functor f, Contravariant f) => (Text -> a) -> (a -> f a) -> Element -> f Element
accText c = partsOf texts.to (c . Text.strip . Text.replace "\n" " " . mconcat)

-- | Remove superfluous whitespace from the table rows
reassemble :: Text -> Text
reassemble = Text.unwords . Text.words