-- This file is part of Diohsc -- Copyright (C) 2020-23 Martin Bays -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of version 3 of the GNU General Public License as -- published by the Free Software Foundation, or any later version. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see http://www.gnu.org/licenses/. {-# LANGUAGE OverloadedStrings #-} module History where import Data.List (find) import Time.Types (ElapsedP) import qualified Codec.MIME.Type as MIME import qualified Data.Text.Encoding.Error as T import qualified Data.Text.Lazy.Encoding as T import GeminiProtocol import Request import TextGemini import URI data HistoryChild = HistoryChild { childItem :: HistoryItem , childLink :: Maybe Int } data HistoryOrigin = HistoryOrigin { originItem :: HistoryItem , originLink :: Maybe Int } data HistoryItem = HistoryItem { historyRequest :: Request , historyRequestTime :: ElapsedP , historyMimedData :: MimedData , historyGeminatedMimedData :: MimedData -- ^generated with lazy IO , historyParent :: Maybe HistoryItem , historyChild :: Maybe HistoryChild } historyUri :: HistoryItem -> URI historyUri = requestUri . historyRequest historyAncestors :: HistoryItem -> [HistoryItem] historyAncestors i = case historyParent i of Nothing -> [] Just i' -> i' : historyAncestors i' historyDescendants :: HistoryItem -> [HistoryItem] historyDescendants i = case historyChild i of Nothing -> [] Just (HistoryChild i' _) -> i' : historyDescendants i' pathItemByUri :: HistoryItem -> URI -> Maybe HistoryItem pathItemByUri i uri = find ((uri ==) . historyUri) $ historyAncestors i ++ [i] ++ historyDescendants i historyLinks :: HistoryItem -> [Link] historyLinks item = case historyGeminatedMimedData item of MimedData (MIME.Type (MIME.Text "gemini") _) body -> extractLinks . parseGemini $ T.decodeUtf8With T.lenientDecode body _ -> []