content: -- Links are the center of interest in our program. Most activities revolve
  -- around them.
  
  module Vocabulink.Link ( Link(..), LinkOutput(..), linkDetails, linkTypeName, compactLinkJSON
                         , languagePairLinks, linksContaining
                         , pronounceable
                         , Story(..), addStory, getStory, editStory, linkStories
                         , linksTable, linkPage, compactLinkPage, linksPage
                         ) where
  
  import Vocabulink.Comment
  import Vocabulink.Env
  import Vocabulink.Html
  import Vocabulink.Member
  import Vocabulink.Member.Html
  import Vocabulink.Page
  import Vocabulink.Utils
  
  import Text.Blaze (unsafeByteString)
  import Text.Blaze.Html5 (audio, source)
  import Text.Blaze.Html5.Attributes (preload)
  
  import System.Environment (getArgs)
  import System.IO.Unsafe (unsafePerformIO)
  
  -- TODO: Get rid of these by just using Aeson directly.
  import Data.Aeson.QQ (aesonQQ)
  import qualified Data.Aeson.Types as AT
  
  import Prelude hiding (span, id, div)
  
  data Link = Link { linkNumber     :: Int32
                   , linkLearn      :: String
                   , linkKnown      :: String
                   , linkLearnLang  :: String
                   , linkKnownLang  :: String
                   , linkSoundalike :: Bool
                   , linkWord       :: Maybe String
                   }
    deriving Eq
  
  data LinkOutput = LinkOutput Link Html
  
  linkTypeName :: Link -> String
  linkTypeName link
    | isJust (linkWord link) = "linkword"
    | linkSoundalike link    = "soundalike"
    | otherwise              = "association"
  
  -- Using unsafePerformIO here to remain compatiable with the ToMarkup type.
  pronounceable :: Link -> Bool
  {-# NOINLINE pronounceable #-}
  pronounceable link = unsafePerformIO $ do
    -- Hack: We already know we nave the necessary arg.
    (staticPath:_) <- getArgs
    isFileReadable $ pronunciationFile staticPath link "ogg"
  
  pronunciationFile :: FilePath -> Link -> String -> FilePath
  pronunciationFile staticPath link filetype = staticPath </> "audio" </> "pronunciation" </> (show $ linkNumber link) <.> filetype
  
  -- Displaying Links
  
  -- <h1 class="link linkword">
  --     <span class="foreign" title="Esperanto">nur</span>
  --     <span class="link" title="linkword">newer</span>
  --     <span class="familiar" title="English">only</span>
  -- </h1>
  
  -- <h2 class="link soundalike">
  --     <span class="foreign" title="Esperanto">lingvo</span>
  --     <span class="link" title="soundalike"></span>
  --     <span class="familiar" title="English">language</span>
  -- </h2>
  
  instance ToMarkup Link where
    toMarkup link = do
      h1 ! class_ (toValue $ "link " ++ linkTypeName link) $ do
        span ! class_ "foreign" ! customAttribute "lang" (toValue $ linkLearnLang link) ! title (toValue (languageName (linkLearnLang link))) $ do
          toMarkup $ linkLearn link
          pronunciation
        span ! class_ "link" ! title (toValue $ linkTypeName link) $ linkExtra
        span ! class_ "familiar" ! customAttribute "lang" (toValue $ linkKnownLang link) ! title (toValue (languageName (linkKnownLang link))) $ toMarkup $ linkKnown link
     where linkExtra = maybe mempty toMarkup $ linkWord link
           pronunciation = if pronounceable link
                             then button ! id "pronounce" ! class_ "button light" $ do
                                    audio ! preload "auto" $ do
                                      source ! src (toValue $ "//s.vocabulink.com/audio/pronunciation/" ++ show (linkNumber link) ++ ".ogg")
                                      source ! src (toValue $ "//s.vocabulink.com/audio/pronunciation/" ++ show (linkNumber link) ++ ".mp3")
                                    sprite "icon" "audio"
                             else mempty
  
  $(deriveToJSON AT.defaultOptions { AT.fieldLabelModifier = (lowercase . drop 4) } ''Link)
  
  compactLinkMarkup :: Link -> Html
  compactLinkMarkup link = div $ do
    h1 $ do
      span ! class_ "learn" $ toMarkup $ linkLearn link
      pronunciation
    h2 $ do
      span ! class_ "mnemonic" $ mnemonic
      span ! class_ "link" $ " → "
      span ! class_ "known" $ (toMarkup $ linkKnown link)
   where pronunciation = if pronounceable link
                         then button ! id "pronounce" ! class_ "button light" $ do
                                audio ! preload "auto" $ do
                                  source ! src (toValue $ "//s.vocabulink.com/audio/pronunciation/" ++ show (linkNumber link) ++ ".ogg")
                                  source ! src (toValue $ "//s.vocabulink.com/audio/pronunciation/" ++ show (linkNumber link) ++ ".mp3")
                                sprite "icon" "audio"
                         else mempty
         mnemonic = case (linkWord link, linkSoundalike link) of
                      (Just word, _) -> mconcat [unsafeByteString "&ldquo;", toMarkup word, unsafeByteString "&rdquo;"]
                      (Nothing, True) -> i $ "soundalike"
                      _ -> mempty
  
  compactLinkJSON :: Link -> Value
  compactLinkJSON link =
    -- I opted for an array representation because it's more compact. We could be
    -- sending a lot of these in a single response.
    -- We don't need to send the language information as the new review process only
    -- operates on 1 set of languages at a time.
    let e = linkExtra link
    in [aesonQQ| [ #{linkNumber link}
                 , #{linkLearn link}
                 , #{linkKnown link}
                 , #{e}
                 ] |]
   where linkExtra l
           | isJust (linkWord l) = [aesonQQ| {"linkword": #{fromJust (linkWord l)}} |]
           | linkSoundalike l    = [aesonQQ| {"soundalike": #{True}} |]
           | otherwise           = Null
  
  linkDetails :: E (Int32 -> IO (Maybe Link))
  linkDetails linkNo =
    uncurryN Link <$$> $(queryTuple
      "SELECT link_no, learn, known, learn_lang, known_lang, soundalike, linkword \
      \FROM link \
      \WHERE link_no = {linkNo} AND NOT deleted") ?db
  
  languagePairLinks :: E (String -> String -> IO [Link])
  languagePairLinks learnLang knownLang =
    map (uncurryN Link) <$> $(queryTuples
      "SELECT link_no, learn, known, learn_lang, known_lang, soundalike, linkword \
      \FROM link \
      \WHERE learn_lang = {learnLang} AND known_lang = {knownLang} \
        \AND NOT deleted") ?db
  
  linksContaining :: E (String -> IO [Link])
  linksContaining q = do
    let fuzzy = "%" ++ q ++ "%"
    exacts <- map (uncurryN Link) <$> $(queryTuples
      "SELECT link_no, learn, known, learn_lang, known_lang, soundalike, linkword \
      \FROM link \
      \WHERE NOT deleted \
        \AND (learn ILIKE {q} OR known ILIKE {q} OR linkword ILIKE {q} \
          \OR unaccent(learn) ILIKE {q} OR unaccent(known) ILIKE {q} OR unaccent(linkword) ILIKE {q})") ?db
    closes <- map (uncurryN Link) <$> $(queryTuples
      "SELECT link_no, learn, known, learn_lang, known_lang, soundalike, linkword \
      \FROM link \
      \WHERE NOT deleted \
        \AND (learn ILIKE {fuzzy} OR known ILIKE {fuzzy} OR linkword ILIKE {fuzzy} \
          \OR unaccent(learn) ILIKE {fuzzy} OR unaccent(known) ILIKE {fuzzy} OR unaccent(linkword) ILIKE {fuzzy}) \
      \ORDER BY char_length(learn)") ?db
    return $ nub $ exacts ++ closes
  
  data Story = Story { storyNumber :: Int32
                     , storyBody :: String
                     , storyAuthor :: Member
                     , storyEdited :: UTCTime
                     }
  
  instance ToMarkup Story where
    toMarkup story =
      div ! class_ "linkword-story-container" $ do
        a ! id (toValue $ storyNumber story) $ mempty
        div ! class_ "linkword-story" $ do
          blockquote $ fromRight "Failed to parse story." (markdownToHtml (storyBody story))
          div ! class_ "signature" $ do
            fromJust $ memberAvatar 32 (storyAuthor story)
            div ! class_ "details" $ do
              a ! class_ "username" ! href (toValue $ "/user/" ++ memberName (storyAuthor story))
                $ toMarkup (memberName $ storyAuthor story)
              br
              span ! class_ "date" $ toMarkup $ prettyPrint $ storyEdited story
  
  $(deriveToJSON AT.defaultOptions { AT.fieldLabelModifier = (drop 5) } ''Story)
  
  compactStoryMarkup :: Story -> Html
  compactStoryMarkup story = blockquote $ fromRight "Failed to parse story." (markdownToHtml (storyBody story))
  
  addStory :: E (Int32 -> String -> IO ())
  addStory linkNo story = withVerifiedMember $ \ m -> do
    $(execute "INSERT INTO linkword_story (link_no, author, story) \
                                  \VALUES ({linkNo}, {memberNumber m}, {story})") ?db
  
  -- Return the unformatted body of the story.
  -- TODO: Why isn't this returning a Story value?
  getStory :: E (Int32 -> IO (Maybe String))
  getStory storyNo = $(queryTuple "SELECT story FROM linkword_story WHERE story_no = {storyNo}") ?db
  
  -- TODO: Throw an error when not authorized.
  editStory :: E (Int32 -> String -> IO ())
  editStory n s = withVerifiedMember $ \m -> do
    $(execute "UPDATE linkword_story \
              \SET story = {s}, edited = NOW() \
              \WHERE story_no = {n} AND (author = {memberNumber m} OR {memberNumber m} = 1)") ?db
  
  linkStories :: E (Int32 -> IO [Story])
  linkStories linkNo = map mkStory <$> $(queryTuples
      "SELECT story_no, story, edited, member_no, username, email \
      \FROM linkword_story s INNER JOIN member m ON (m.member_no = s.author) \
      \WHERE link_no = {linkNo} \
      \ORDER BY story_no ASC") ?db
   where mkStory (n, s, e, n', u, em) = Story n s (Member n' u em) e
  
  linksTable :: [Link] -> Html
  linksTable links = table ! class_ "links" $ do
    thead $ do
      tr $ do
        th "Foreign"
        th "Familiar"
        th "Linkword"
    tbody $ mconcat $ map linkRow links
   where linkRow link = let url = "/link/" ++ show (linkNumber link) in
           tr ! class_ (toValue $ "inline-link " ++ linkTypeName link) $ do
             td $ a ! href (toValue url) $ toMarkup $ linkLearn link
             td $ a ! href (toValue url) $ toMarkup $ linkKnown link
             td $ a ! href (toValue url) $ toMarkup $ fromMaybe "" $ linkWord link
  
  -- Each link gets its own URI and page. Most of the extra code in the following is
  -- for handling the display of link operations (``review'', ``delete'', etc.),
  -- dealing with retrieval exceptions, etc.
  
  -- For the link's owner, we'll send along the source of the link in a hidden
  -- textarea for in-page editing.
  
  linkPage :: E (Link -> IO Html)
  linkPage link = do
    row <- $(queryTuple "SELECT root_comment \
                        \FROM link_comment \
                        \WHERE link_no = {linkNumber link}") ?db
    comments <- maybe (return mempty) renderComments row
    stories <- do ss <- linkStories $ linkNumber link
                  return $ mconcat $ map toMarkup ss
    stdPage (linkLearn link ++ " → " ++ linkKnown link ++ " — " ++ languageName (linkLearnLang link) ++ " to " ++ languageName (linkKnownLang link)) [CSS "link", JS "link"] mempty $ do
      toMarkup link
      div ! id "linkword-stories" $ do
        div ! class_ "header" $ h2 "Linkword Stories:"
        stories
      div ! id "comments" $ do
        h3 "Comments"
        comments
  
  compactLinkPage :: E (Link -> IO Html)
  compactLinkPage link = do
    stories <- do ss <- linkStories $ linkNumber link
                  return $ mconcat $ map compactStoryMarkup ss
    return $ do
      compactLinkMarkup link
      stories
  
  linksPage :: E (String -> [Link] -> IO Html)
  linksPage title' links =
    simplePage title' [JS "link", CSS "link", ReadyJS initJS] $ do
      linksTable links
   where initJS = unlines
                    ["var options = {};"
                    ,"var pageHash = /^#page(\\d+)$/.exec(window.location.hash);"
                    ,"if (pageHash) {"
                    ,"  options.startPage = parseInt(pageHash[1], 10);"
                    ,"}"
                    ,"$('table').longtable(options).bind('longtable.pageChange', function (_, n) {"
                    ,"  window.location.hash = 'page' + n;"
                    ,"});"
                    ]
  