{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

module Blagda.Equations where

import           Data.Maybe
import           Data.Text (Text)
import qualified Data.Text as Text
import           Text.HTML.TagSoup


hideSteps :: Bool -> [Tag Text] -> [Tag Text]
hideSteps :: Bool -> [Tag Text] -> [Tag Text]
hideSteps Bool
_ (to :: Tag Text
to@(TagOpen Text
"a" [Attribute Text]
attrs):tt :: Tag Text
tt@(TagText Text
t):tc :: Tag Text
tc@(TagClose Text
"a"):[Tag Text]
rest)
  | Text -> Int
Text.length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1, Text -> Char
Text.last Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'⟨', Just Text
href <- Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"href" [Attribute Text]
attrs
  = [ Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"span" [(Text
"class", Text
"reasoning-step")]
    , Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"span" [(Text
"class", Text
"as-written " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attrs))]
    , Tag Text
to, Tag Text
tt, Tag Text
tc
    ] [Tag Text] -> [Tag Text] -> [Tag Text]
forall a. [a] -> [a] -> [a]
++ Text -> [Tag Text] -> [Tag Text]
go Text
href [Tag Text]
rest
  where
    alternate :: Text
alternate = Text -> Text
Text.init Text
t
    go :: Text -> [Tag Text] -> [Tag Text]
go Text
href (to :: Tag Text
to@(TagOpen Text
"a" [Attribute Text]
attrs):tt :: Tag Text
tt@(TagText Text
t):tc :: Tag Text
tc@(TagClose Text
"a"):[Tag Text]
cs)
      | Text -> Int
Text.length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1
      , Text -> Char
Text.head Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'⟩'
      , Just Text
href' <- Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"href" [Attribute Text]
attrs
      , Text
href' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
href
      = [ Tag Text
to, Tag Text
tt, Tag Text
tc, Text -> Tag Text
forall str. str -> Tag str
TagClose Text
"span"
        , Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"span" [(Text
"class", Text
"alternate " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"class" [Attribute Text]
attrs))]
        , Text -> Tag Text
forall str. str -> Tag str
TagText Text
alternate
        , Text -> Tag Text
forall str. str -> Tag str
TagClose Text
"span"
        , Text -> Tag Text
forall str. str -> Tag str
TagClose Text
"span"
        ] [Tag Text] -> [Tag Text] -> [Tag Text]
forall a. [a] -> [a] -> [a]
++ Bool -> [Tag Text] -> [Tag Text]
hideSteps Bool
True [Tag Text]
cs
    go Text
href (Tag Text
c : [Tag Text]
cs) = Tag Text
c Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: Text -> [Tag Text] -> [Tag Text]
go Text
href [Tag Text]
cs
    go Text
_ [] = []
hideSteps Bool
False (TagClose Text
"html":[Tag Text]
cs) =
  [ Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"style" []
  , Text -> Tag Text
forall str. str -> Tag str
TagText Text
".equations { display: none !important; }"
  , Text -> Tag Text
forall str. str -> Tag str
TagClose Text
"style"
  , Text -> Tag Text
forall str. str -> Tag str
TagClose Text
"html"
  ] [Tag Text] -> [Tag Text] -> [Tag Text]
forall a. [a] -> [a] -> [a]
++ Bool -> [Tag Text] -> [Tag Text]
hideSteps Bool
True [Tag Text]
cs
hideSteps Bool
has_eqn (Tag Text
c : [Tag Text]
cs) = Tag Text
c Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: Bool -> [Tag Text] -> [Tag Text]
hideSteps Bool
has_eqn [Tag Text]
cs
hideSteps Bool
_ [] = []