    {-# LANGUAGE ViewPatterns, TupleSections, RecordWildCards, ScopedTypeVariables, PatternGuards #-}
    {-# LANGUAGE OverloadedStrings #-}

    module Action.Server(actionServer, actionReplay, action_server_test_, action_server_test) where

    import Data.List.Extra
    import System.FilePath
    import Control.Exception
    import Control.Exception.Extra
    import Control.DeepSeq
    import System.Directory
    import Text.Blaze
    import Text.Blaze.Renderer.Utf8
    import qualified Text.Blaze.XHtml5 as H
    import qualified Text.Blaze.XHtml5.Attributes as H
    import Data.Tuple.Extra
    import qualified Language.Javascript.JQuery as JQuery
    import qualified Language.Javascript.Flot as Flot
    import Data.Version
    import Paths_hoogle
    import Data.Maybe
    import Control.Monad.Extra
    import Text.Read
    import System.IO.Extra
    import General.Str
    import qualified Data.ByteString.Char8 as BS
    import qualified Data.ByteString.Lazy.Char8 as LBS
    import qualified Data.Map as Map
    import System.Time.Extra
    import Data.Time.Clock
    import Data.Time.Calendar
    import System.IO.Unsafe
    import Numeric.Extra
    import System.Info.Extra

    import Output.Tags
    import Query
    import Input.Item
    import General.Util
    import General.Web
    import General.Store
    import General.Template
    import General.Log
    import Action.Search
    import Action.CmdLine
    import Control.Applicative
    import Data.Monoid
    import Prelude

    import qualified Data.Aeson as JSON

    actionServer :: CmdLine -> IO ()
    actionServer :: CmdLine -> IO ()
    actionServer cmd :: CmdLine
    cmd@Server{..} = do
        -- so I can get good error messages
        Handle -> BufferMode -> IO ()
    hSetBuffering Handle
    stdout BufferMode
    LineBuffering
        Handle -> BufferMode -> IO ()
    hSetBuffering Handle
    stderr BufferMode
    LineBuffering
        FilePath -> IO ()
    putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "Server started on port " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    port
        FilePath -> IO ()
    putStr "Reading log..." IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO ()
    hFlush Handle
    stdout
        IO Seconds
    time <- IO (IO Seconds)
    offsetTime
        Log
    log <- Either Handle FilePath -> (ByteString -> Bool) -> IO Log
    logCreate (if FilePath
    logs FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == "" then Handle -> Either Handle FilePath
    forall a b. a -> Either a b
    Left Handle
    stdout else FilePath -> Either Handle FilePath
    forall a b. b -> Either a b
    Right FilePath
    logs) ((ByteString -> Bool) -> IO Log) -> (ByteString -> Bool) -> IO Log
    forall a b. (a -> b) -> a -> b
    $
            \x :: ByteString
    x -> FilePath -> ByteString
    BS.pack "hoogle=" ByteString -> ByteString -> Bool
    `BS.isInfixOf` ByteString
    x Bool -> Bool -> Bool
    && Bool -> Bool
    not (FilePath -> ByteString
    BS.pack "is:ping" ByteString -> ByteString -> Bool
    `BS.isInfixOf` ByteString
    x)
        FilePath -> IO ()
    putStrLn (FilePath -> IO ()) -> (Seconds -> FilePath) -> Seconds -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Seconds -> FilePath
    showDuration (Seconds -> IO ()) -> IO Seconds -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO Seconds
    time
        UTCTime -> IO UTCTime
    forall a. a -> IO a
    evaluate UTCTime
    spawned
        FilePath
    dataDir <- IO FilePath
    -> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO FilePath
    getDataDir FilePath -> IO FilePath
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe FilePath
    datadir
        Maybe FilePath
    haddock <- IO (Maybe FilePath)
    -> (FilePath -> IO (Maybe FilePath))
    -> Maybe FilePath
    -> IO (Maybe FilePath)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Maybe FilePath -> IO (Maybe FilePath)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe FilePath
    forall a. Maybe a
    Nothing) ((FilePath -> Maybe FilePath) -> IO FilePath -> IO (Maybe FilePath)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just (IO FilePath -> IO (Maybe FilePath))
    -> (FilePath -> IO FilePath) -> FilePath -> IO (Maybe FilePath)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> IO FilePath
    canonicalizePath) Maybe FilePath
    haddock
        FilePath -> (StoreRead -> IO ()) -> IO ()
    forall a. NFData a => FilePath -> (StoreRead -> IO a) -> IO a
    withSearch FilePath
    database ((StoreRead -> IO ()) -> IO ()) -> (StoreRead -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \store :: StoreRead
    store ->
            Log -> CmdLine -> (Input -> IO Output) -> IO ()
    server Log
    log CmdLine
    cmd ((Input -> IO Output) -> IO ()) -> (Input -> IO Output) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Log
    -> Bool
    -> Bool
    -> Maybe FilePath
    -> StoreRead
    -> FilePath
    -> FilePath
    -> FilePath
    -> FilePath
    -> Input
    -> IO Output
    replyServer Log
    log Bool
    local Bool
    links Maybe FilePath
    haddock StoreRead
    store FilePath
    cdn FilePath
    home (FilePath
    dataDir FilePath -> FilePath -> FilePath
    </> "html") FilePath
    scope

    actionReplay :: CmdLine -> IO ()
    actionReplay :: CmdLine -> IO ()
    actionReplay Replay{..} = Handle -> BufferMode -> IO () -> IO ()
    forall a. Handle -> BufferMode -> IO a -> IO a
    withBuffering Handle
    stdout BufferMode
    NoBuffering (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        FilePath
    src <- FilePath -> IO FilePath
    readFile FilePath
    logs
        let qs :: [Input]
    qs = [Maybe Input] -> [Input]
    forall a. [Maybe a] -> [a]
    catMaybes [FilePath -> Maybe Input
    readInput FilePath
    url | _:ip :: FilePath
    ip:_:url :: FilePath
    url:_ <- (FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
    forall a b. (a -> b) -> [a] -> [b]
    map FilePath -> [FilePath]
    words ([FilePath] -> [[FilePath]]) -> [FilePath] -> [[FilePath]]
    forall a b. (a -> b) -> a -> b
    $ FilePath -> [FilePath]
    lines FilePath
    src, FilePath
    ip FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    /= "-"]
        (t :: Seconds
    t,_) <- IO () -> IO (Seconds, ())
    forall (m :: * -> *) a. MonadIO m => m a -> m (Seconds, a)
    duration (IO () -> IO (Seconds, ())) -> IO () -> IO (Seconds, ())
    forall a b. (a -> b) -> a -> b
    $ FilePath -> (StoreRead -> IO ()) -> IO ()
    forall a. NFData a => FilePath -> (StoreRead -> IO a) -> IO a
    withSearch FilePath
    database ((StoreRead -> IO ()) -> IO ()) -> (StoreRead -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \store :: StoreRead
    store -> do
            Log
    log <- IO Log
    logNone
            FilePath
    dataDir <- IO FilePath
    getDataDir
            let op :: Input -> IO Output
    op = Log
    -> Bool
    -> Bool
    -> Maybe FilePath
    -> StoreRead
    -> FilePath
    -> FilePath
    -> FilePath
    -> FilePath
    -> Input
    -> IO Output
    replyServer Log
    log Bool
    False Bool
    False Maybe FilePath
    forall a. Maybe a
    Nothing StoreRead
    store "" "" (FilePath
    dataDir FilePath -> FilePath -> FilePath
    </> "html") FilePath
    scope
            Int -> IO () -> IO ()
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
    replicateM_ Int
    repeat_ (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Input] -> (Input -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Input]
    qs ((Input -> IO ()) -> IO ()) -> (Input -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \x :: Input
    x -> do
                Output
    res <- Input -> IO Output
    op Input
    x
                () -> IO ()
    forall a. a -> IO a
    evaluate (() -> IO ()) -> () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Output -> ()
    forall a. NFData a => a -> ()
    rnf Output
    res
                Char -> IO ()
    putChar '.'
        FilePath -> IO ()
    putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "\nTook " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Seconds -> FilePath
    showDuration Seconds
    t FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " (" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Seconds -> FilePath
    showDuration (Seconds
    t Seconds -> Seconds -> Seconds
    forall a. Fractional a => a -> a -> a
    / Int -> Seconds
    intToDouble (Int
    repeat_ Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * [Input] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Input]
    qs)) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ ")"

    {-# NOINLINE spawned #-}
    spawned :: UTCTime
    spawned :: UTCTime
    spawned = IO UTCTime -> UTCTime
    forall a. IO a -> a
    unsafePerformIO IO UTCTime
    getCurrentTime

    replyServer :: Log -> Bool -> Bool -> Maybe FilePath -> StoreRead -> String -> String -> FilePath -> String -> Input -> IO Output
    replyServer :: Log
    -> Bool
    -> Bool
    -> Maybe FilePath
    -> StoreRead
    -> FilePath
    -> FilePath
    -> FilePath
    -> FilePath
    -> Input
    -> IO Output
    replyServer log :: Log
    log local :: Bool
    local links :: Bool
    links haddock :: Maybe FilePath
    haddock store :: StoreRead
    store cdn :: FilePath
    cdn home :: FilePath
    home htmlDir :: FilePath
    htmlDir scope :: FilePath
    scope Input{..} = case [FilePath]
    inputURL of
        -- without -fno-state-hack things can get folded under this lambda
        [] -> do
            let grabBy :: (FilePath -> Bool) -> [FilePath]
    grabBy name :: FilePath -> Bool
    name = [FilePath
    x | (a :: FilePath
    a,x :: FilePath
    x) <- [(FilePath, FilePath)]
    inputArgs, FilePath -> Bool
    name FilePath
    a, FilePath
    x FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ""]
                grab :: FilePath -> [FilePath]
    grab name :: FilePath
    name = (FilePath -> Bool) -> [FilePath]
    grabBy (FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    name)
                grabInt :: FilePath -> Int -> Int
    grabInt name :: FilePath
    name def :: Int
    def = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    def (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Maybe Int
    forall a. Read a => FilePath -> Maybe a
    readMaybe (FilePath -> Maybe Int) -> Maybe FilePath -> Maybe Int
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [FilePath] -> Maybe FilePath
    forall a. [a] -> Maybe a
    listToMaybe (FilePath -> [FilePath]
    grab FilePath
    name) :: Int

            let qScope :: [FilePath]
    qScope = let xs :: [FilePath]
    xs = FilePath -> [FilePath]
    grab "scope" in [FilePath
    scope | [FilePath] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FilePath]
    xs Bool -> Bool -> Bool
    && FilePath
    scope FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ""] [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ [FilePath]
    xs
            let qSearch :: [FilePath]
    qSearch = (FilePath -> Bool) -> [FilePath]
    grabBy (FilePath -> [FilePath] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["hoogle","q"])
            let qSource :: [FilePath]
    qSource = [FilePath]
    qSearch [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ (FilePath -> Bool) -> [FilePath] -> [FilePath]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    /= "set:stackage") [FilePath]
    qScope
            let q :: [Query]
    q = (FilePath -> [Query]) -> [FilePath] -> [Query]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap FilePath -> [Query]
    parseQuery [FilePath]
    qSource
            let (q2 :: [Query]
    q2, results :: [Target]
    results) = StoreRead -> [Query] -> ([Query], [Target])
    search StoreRead
    store [Query]
    q
            let body :: Markup
    body = Bool
    -> Bool
    -> Maybe FilePath
    -> [(FilePath, FilePath)]
    -> [Query]
    -> [[Target]]
    -> Markup
    showResults Bool
    local Bool
    links Maybe FilePath
    haddock (((FilePath, FilePath) -> Bool)
    -> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    /= "mode") (FilePath -> Bool)
    -> ((FilePath, FilePath) -> FilePath)
    -> (FilePath, FilePath)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FilePath, FilePath) -> FilePath
    forall a b. (a, b) -> a
    fst) [(FilePath, FilePath)]
    inputArgs) [Query]
    q2 ([[Target]] -> Markup) -> [[Target]] -> Markup
    forall a b. (a -> b) -> a -> b
    $
                    Int -> (Target -> Target) -> [Target] -> [[Target]]
    forall k v. Ord k => Int -> (v -> k) -> [v] -> [[v]]
    dedupeTake 25 (\t :: Target
    t -> Target
    t{targetURL :: FilePath
    targetURL="",targetPackage :: Maybe (FilePath, FilePath)
    targetPackage=Maybe (FilePath, FilePath)
    forall a. Maybe a
    Nothing, targetModule :: Maybe (FilePath, FilePath)
    targetModule=Maybe (FilePath, FilePath)
    forall a. Maybe a
    Nothing}) [Target]
    results
            case FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "mode" [(FilePath, FilePath)]
    inputArgs of
                Nothing | [FilePath]
    qSource [FilePath] -> [FilePath] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [] -> (ByteString -> Output) -> IO ByteString -> IO Output
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ByteString -> Output
    OutputHTML (IO ByteString -> IO Output) -> IO ByteString -> IO Output
    forall a b. (a -> b) -> a -> b
    $ Template -> [(FilePath, Template)] -> IO ByteString
    templateRender Template
    templateIndex
                            [("tags", Markup -> Template
    html (Markup -> Template) -> Markup -> Template
    forall a b. (a -> b) -> a -> b
    $ [FilePath] -> Markup
    forall (t :: * -> *). Foldable t => t FilePath -> Markup
    tagOptions [FilePath]
    qScope)
                            ,("body", Markup -> Template
    html Markup
    body)
                            ,("title", FilePath -> Template
    text (FilePath -> Template) -> FilePath -> Template
    forall a b. (a -> b) -> a -> b
    $ [FilePath] -> FilePath
    unwords [FilePath]
    qSource FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " - Hoogle")
                            ,("search", FilePath -> Template
    text (FilePath -> Template) -> FilePath -> Template
    forall a b. (a -> b) -> a -> b
    $ [FilePath] -> FilePath
    unwords [FilePath]
    qSearch)
                            ,("robots", FilePath -> Template
    text (FilePath -> Template) -> FilePath -> Template
    forall a b. (a -> b) -> a -> b
    $ if (Query -> Bool) -> [Query] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Query -> Bool
    isQueryScope [Query]
    q then "none" else "index")]
                        | Bool
    otherwise -> ByteString -> Output
    OutputHTML (ByteString -> Output) -> IO ByteString -> IO Output
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Template -> [(FilePath, Template)] -> IO ByteString
    templateRender Template
    templateHome []
                Just "body" -> ByteString -> Output
    OutputHTML (ByteString -> Output) -> IO ByteString -> IO Output
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> if [FilePath] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FilePath]
    qSource then Template -> [(FilePath, Template)] -> IO ByteString
    templateRender Template
    templateEmpty [] else Template -> [(FilePath, Template)] -> IO ByteString
    templateRender (Markup -> Template
    html Markup
    body) []
                Just "json" ->
                  let -- 1 means don't drop anything, if it's less than 1 ignore it
                      start :: Int
                      start :: Int
    start = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max 0 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Int -> Int
    grabInt "start" 1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1
                      -- by default it returns 100 entries
                      count :: Int
                      count :: Int
    count = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min 500 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Int -> Int
    grabInt "count" 100
                      filteredResults :: [Target]
    filteredResults = Int -> [Target] -> [Target]
    forall a. Int -> [a] -> [a]
    take Int
    count ([Target] -> [Target]) -> [Target] -> [Target]
    forall a b. (a -> b) -> a -> b
    $ Int -> [Target] -> [Target]
    forall a. Int -> [a] -> [a]
    drop Int
    start [Target]
    results
                  in case FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup "format" [(FilePath, FilePath)]
    inputArgs of
                    Just "text" -> Output -> IO Output
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Output -> IO Output) -> Output -> IO Output
    forall a b. (a -> b) -> a -> b
    $ Encoding -> Output
    OutputJSON (Encoding -> Output) -> Encoding -> Output
    forall a b. (a -> b) -> a -> b
    $ [Target] -> Encoding
    forall a. ToJSON a => a -> Encoding
    JSON.toEncoding ([Target] -> Encoding) -> [Target] -> Encoding
    forall a b. (a -> b) -> a -> b
    $ (Target -> Target) -> [Target] -> [Target]
    forall a b. (a -> b) -> [a] -> [b]
    map Target -> Target
    unHTMLTarget [Target]
    filteredResults
                    Just f :: FilePath
    f -> Output -> IO Output
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Output -> IO Output) -> Output -> IO Output
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Output
    OutputFail (ByteString -> Output) -> ByteString -> Output
    forall a b. (a -> b) -> a -> b
    $ FilePath -> ByteString
    lbstrPack (FilePath -> ByteString) -> FilePath -> ByteString
    forall a b. (a -> b) -> a -> b
    $ "Format mode " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    f FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " not (currently) supported"
                    Nothing -> Output -> IO Output
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Output -> IO Output) -> Output -> IO Output
    forall a b. (a -> b) -> a -> b
    $ Encoding -> Output
    OutputJSON (Encoding -> Output) -> Encoding -> Output
    forall a b. (a -> b) -> a -> b
    $ [Target] -> Encoding
    forall a. ToJSON a => a -> Encoding
    JSON.toEncoding [Target]
    filteredResults
                Just m :: FilePath
    m -> Output -> IO Output
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Output -> IO Output) -> Output -> IO Output
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Output
    OutputFail (ByteString -> Output) -> ByteString -> Output
    forall a b. (a -> b) -> a -> b
    $ FilePath -> ByteString
    lbstrPack (FilePath -> ByteString) -> FilePath -> ByteString
    forall a b. (a -> b) -> a -> b
    $ "Mode " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    m FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " not (currently) supported"
        ["plugin","jquery.js"] -> FilePath -> Output
    OutputFile (FilePath -> Output) -> IO FilePath -> IO Output
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO FilePath
    JQuery.file
        ["plugin","jquery.flot.js"] -> FilePath -> Output
    OutputFile (FilePath -> Output) -> IO FilePath -> IO Output
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Flot -> IO FilePath
    Flot.file Flot
    Flot.Flot
        ["plugin","jquery.flot.time.js"] -> FilePath -> Output
    OutputFile (FilePath -> Output) -> IO FilePath -> IO Output
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Flot -> IO FilePath
    Flot.file Flot
    Flot.FlotTime

        ["canary"] -> do
            UTCTime
    now <- IO UTCTime
    getCurrentTime
            [Summary]
    summ <- Log -> IO [Summary]
    logSummary Log
    log
            let errs :: Int
    errs = [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [Int
    summaryErrors | Summary{..} <- [Summary]
    summ, Day
    summaryDate Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Day -> Day
    forall a. Enum a => a -> a
    pred (UTCTime -> Day
    utctDay UTCTime
    now)]
            let alive :: Seconds
    alive = Rational -> Seconds
    forall a. Fractional a => Rational -> a
    fromRational (Rational -> Seconds) -> Rational -> Seconds
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime -> Rational
    forall a. Real a => a -> Rational
    toRational (NominalDiffTime -> Rational) -> NominalDiffTime -> Rational
    forall a b. (a -> b) -> a -> b
    $ (UTCTime
    now UTCTime -> UTCTime -> NominalDiffTime
    `diffUTCTime` UTCTime
    spawned) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Fractional a => a -> a -> a
    / (24 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * 60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * 60)
            Output -> IO Output
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Output -> IO Output) -> Output -> IO Output
    forall a b. (a -> b) -> a -> b
    $ (if Int
    errs Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 Bool -> Bool -> Bool
    && Seconds
    alive Seconds -> Seconds -> Bool
    forall a. Ord a => a -> a -> Bool
    < 1.5 then ByteString -> Output
    OutputText else ByteString -> Output
    OutputFail) (ByteString -> Output) -> ByteString -> Output
    forall a b. (a -> b) -> a -> b
    $ FilePath -> ByteString
    lbstrPack (FilePath -> ByteString) -> FilePath -> ByteString
    forall a b. (a -> b) -> a -> b
    $
                "Errors " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ (if Int
    errs Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 then "good" else "bad") FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ ": " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    errs FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " in the last 24 hours.\n" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
                "Updates " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ (if Seconds
    alive Seconds -> Seconds -> Bool
    forall a. Ord a => a -> a -> Bool
    < 1.5 then "good" else "bad") FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ ": Last updated " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> Seconds -> FilePath
    forall a. RealFloat a => Int -> a -> FilePath
    showDP 2 Seconds
    alive FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " days ago.\n"

        ["log"] -> do
            ByteString -> Output
    OutputHTML (ByteString -> Output) -> IO ByteString -> IO Output
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Template -> [(FilePath, Template)] -> IO ByteString
    templateRender Template
    templateLog []
        ["log.js"] -> do
            FilePath
    log <- [Summary] -> FilePath
    displayLog ([Summary] -> FilePath) -> IO [Summary] -> IO FilePath
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Log -> IO [Summary]
    logSummary Log
    log
            ByteString -> Output
    OutputJavascript (ByteString -> Output) -> IO ByteString -> IO Output
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Template -> [(FilePath, Template)] -> IO ByteString
    templateRender Template
    templateLogJs [("data",Markup -> Template
    html (Markup -> Template) -> Markup -> Template
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Markup
    H.preEscapedString FilePath
    log)]
        ["stats"] -> do
            Maybe FilePath
    stats <- IO (Maybe FilePath)
    getStatsDebug
            Output -> IO Output
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Output -> IO Output) -> Output -> IO Output
    forall a b. (a -> b) -> a -> b
    $ case Maybe FilePath
    stats of
                Nothing -> ByteString -> Output
    OutputFail (ByteString -> Output) -> ByteString -> Output
    forall a b. (a -> b) -> a -> b
    $ FilePath -> ByteString
    lbstrPack "GHC Statistics is not enabled, restart with +RTS -T"
                Just x :: FilePath
    x -> ByteString -> Output
    OutputText (ByteString -> Output) -> ByteString -> Output
    forall a b. (a -> b) -> a -> b
    $ FilePath -> ByteString
    lbstrPack (FilePath -> ByteString) -> FilePath -> ByteString
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath -> FilePath -> FilePath
    forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
    replace ", " "\n" (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> FilePath -> FilePath
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= '}') (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath
    forall a. [a] -> [a]
    drop1 (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> FilePath -> FilePath
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= '{') (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show FilePath
    x
        "haddock":xs :: [FilePath]
    xs | Just x :: FilePath
    x <- Maybe FilePath
    haddock -> do
            let file :: FilePath
    file = FilePath -> [FilePath] -> FilePath
    forall a. [a] -> [[a]] -> [a]
    intercalate "/" ([FilePath] -> FilePath) -> [FilePath] -> FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath
    xFilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    :[FilePath]
    xs
            Output -> IO Output
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Output -> IO Output) -> Output -> IO Output
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Output
    OutputFile (FilePath -> Output) -> FilePath -> Output
    forall a b. (a -> b) -> a -> b
    $ FilePath
    file FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ (if FilePath -> Bool
    hasTrailingPathSeparator FilePath
    file then "index.html" else "")
        "file":xs :: [FilePath]
    xs | Bool
    local -> do
            let x :: FilePath
    x = ['/' | Bool -> Bool
    not Bool
    isWindows] FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> [FilePath] -> FilePath
    forall a. [a] -> [[a]] -> [a]
    intercalate "/" ((FilePath -> Bool) -> [FilePath] -> [FilePath]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile FilePath -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FilePath]
    xs)
            let file :: FilePath
    file = FilePath
    x FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ (if FilePath -> Bool
    hasTrailingPathSeparator FilePath
    x then "index.html" else "")
            if FilePath -> FilePath
    takeExtension FilePath
    file FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ".html" then
                Output -> IO Output
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Output -> IO Output) -> Output -> IO Output
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Output
    OutputFile FilePath
    file
             else do
                FilePath
    src <- FilePath -> IO FilePath
    readFile FilePath
    file
                -- Haddock incorrectly generates file:// on Windows, when it should be file:///
                -- so replace on file:// and drop all leading empty paths above
                Output -> IO Output
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Output -> IO Output) -> Output -> IO Output
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Output
    OutputHTML (ByteString -> Output) -> ByteString -> Output
    forall a b. (a -> b) -> a -> b
    $ FilePath -> ByteString
    lbstrPack (FilePath -> ByteString) -> FilePath -> ByteString
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath -> FilePath -> FilePath
    forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
    replace "file://" "/file/" FilePath
    src
        xs :: [FilePath]
    xs ->
            Output -> IO Output
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Output -> IO Output) -> Output -> IO Output
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Output
    OutputFile (FilePath -> Output) -> FilePath -> Output
    forall a b. (a -> b) -> a -> b
    $ [FilePath] -> FilePath
    joinPath ([FilePath] -> FilePath) -> [FilePath] -> FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath
    htmlDir FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    : [FilePath]
    xs
        where
            html :: Markup -> Template
    html = Markup -> Template
    templateMarkup
            text :: FilePath -> Template
    text = Markup -> Template
    templateMarkup (Markup -> Template)
    -> (FilePath -> Markup) -> FilePath -> Template
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Markup
    H.string

            tagOptions :: t FilePath -> Markup
    tagOptions sel :: t FilePath
    sel = [Markup] -> Markup
    forall a. Monoid a => [a] -> a
    mconcat [Markup -> Markup
    H.option (Markup -> Markup) -> (Bool, Attribute) -> Markup -> Markup
    forall h. Attributable h => h -> (Bool, Attribute) -> h
    !? (FilePath
    x FilePath -> t FilePath -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` t FilePath
    sel, AttributeValue -> Attribute
    H.selected "selected") (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Markup
    H.string FilePath
    x | FilePath
    x <- StoreRead -> [FilePath]
    completionTags StoreRead
    store]
            params :: [(FilePath, Template)]
    params =
                [("cdn", FilePath -> Template
    text FilePath
    cdn)
                ,("home", FilePath -> Template
    text FilePath
    home)
                ,("jquery", FilePath -> Template
    text (FilePath -> Template) -> FilePath -> Template
    forall a b. (a -> b) -> a -> b
    $ if FilePath -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null FilePath
    cdn then "plugin/jquery.js" else "https:" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    JQuery.url)
                ,("version", FilePath -> Template
    text (FilePath -> Template) -> FilePath -> Template
    forall a b. (a -> b) -> a -> b
    $ Version -> FilePath
    showVersion Version
    version FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> UTCTime -> FilePath
    showUTCTime "%Y-%m-%d %H:%M" UTCTime
    spawned)]
            templateIndex :: Template
    templateIndex = FilePath -> Template
    templateFile (FilePath
    htmlDir FilePath -> FilePath -> FilePath
    </> "index.html") Template -> [(FilePath, Template)] -> Template
    `templateApply` [(FilePath, Template)]
    params
            templateEmpty :: Template
    templateEmpty = FilePath -> Template
    templateFile (FilePath
    htmlDir FilePath -> FilePath -> FilePath
    </>  "welcome.html")
            templateHome :: Template
    templateHome = Template
    templateIndex Template -> [(FilePath, Template)] -> Template
    `templateApply` [("tags",Markup -> Template
    html (Markup -> Template) -> Markup -> Template
    forall a b. (a -> b) -> a -> b
    $ [FilePath] -> Markup
    forall (t :: * -> *). Foldable t => t FilePath -> Markup
    tagOptions []),("body",Template
    templateEmpty),("title",FilePath -> Template
    text "Hoogle"),("search",FilePath -> Template
    text ""),("robots",FilePath -> Template
    text "index")]
            templateLog :: Template
    templateLog = FilePath -> Template
    templateFile (FilePath
    htmlDir FilePath -> FilePath -> FilePath
    </> "log.html") Template -> [(FilePath, Template)] -> Template
    `templateApply` [(FilePath, Template)]
    params
            templateLogJs :: Template
    templateLogJs = FilePath -> Template
    templateFile (FilePath
    htmlDir FilePath -> FilePath -> FilePath
    </> "log.js") Template -> [(FilePath, Template)] -> Template
    `templateApply` [(FilePath, Template)]
    params

    dedupeTake :: Ord k => Int -> (v -> k) -> [v] -> [[v]]
    dedupeTake :: Int -> (v -> k) -> [v] -> [[v]]
    dedupeTake n :: Int
    n key :: v -> k
    key = [k] -> Map k [v] -> [v] -> [[v]]
    f [] Map k [v]
    forall k a. Map k a
    Map.empty
        where
            -- map is Map k [v]
            f :: [k] -> Map k [v] -> [v] -> [[v]]
    f res :: [k]
    res mp :: Map k [v]
    mp xs :: [v]
    xs | Map k [v] -> Int
    forall k a. Map k a -> Int
    Map.size Map k [v]
    mp Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    n Bool -> Bool -> Bool
    || [v] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [v]
    xs = (k -> [v]) -> [k] -> [[v]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([v] -> [v]
    forall a. [a] -> [a]
    reverse ([v] -> [v]) -> (k -> [v]) -> k -> [v]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map k [v] -> k -> [v]
    forall k a. Ord k => Map k a -> k -> a
    (Map.!) Map k [v]
    mp) ([k] -> [[v]]) -> [k] -> [[v]]
    forall a b. (a -> b) -> a -> b
    $ [k] -> [k]
    forall a. [a] -> [a]
    reverse [k]
    res
            f res :: [k]
    res mp :: Map k [v]
    mp (x :: v
    x:xs :: [v]
    xs) | Just vs :: [v]
    vs <- k -> Map k [v] -> Maybe [v]
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup k
    k Map k [v]
    mp = [k] -> Map k [v] -> [v] -> [[v]]
    f [k]
    res (k -> [v] -> Map k [v] -> Map k [v]
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert k
    k (v
    xv -> [v] -> [v]
    forall a. a -> [a] -> [a]
    :[v]
    vs) Map k [v]
    mp) [v]
    xs
                            | Bool
    otherwise = [k] -> Map k [v] -> [v] -> [[v]]
    f (k
    kk -> [k] -> [k]
    forall a. a -> [a] -> [a]
    :[k]
    res) (k -> [v] -> Map k [v] -> Map k [v]
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert k
    k [v
    x] Map k [v]
    mp) [v]
    xs
                where k :: k
    k = v -> k
    key v
    x

    showResults :: Bool -> Bool -> Maybe FilePath -> [(String, String)] -> [Query] -> [[Target]] -> Markup
    showResults :: Bool
    -> Bool
    -> Maybe FilePath
    -> [(FilePath, FilePath)]
    -> [Query]
    -> [[Target]]
    -> Markup
    showResults local :: Bool
    local links :: Bool
    links haddock :: Maybe FilePath
    haddock args :: [(FilePath, FilePath)]
    args query :: [Query]
    query results :: [[Target]]
    results = do
        Markup -> Markup
    H.h1 (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ [Query] -> Markup
    renderQuery [Query]
    query
        Markup -> Markup
    H.ul (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.id "left" (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ do
            Markup -> Markup
    H.li (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ Markup -> Markup
    H.b "Packages"
            [Markup] -> Markup
    forall a. Monoid a => [a] -> a
    mconcat [Markup -> Markup
    H.li (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath -> Markup
    f FilePath
    cat FilePath
    val | (cat :: FilePath
    cat,val :: FilePath
    val) <- [Target] -> [(FilePath, FilePath)]
    itemCategories ([Target] -> [(FilePath, FilePath)])
    -> [Target] -> [(FilePath, FilePath)]
    forall a b. (a -> b) -> a -> b
    $ [[Target]] -> [Target]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Target]]
    results, Bool -> FilePath -> FilePath -> Query
    QueryScope Bool
    True FilePath
    cat FilePath
    val Query -> [Query] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Query]
    query]
        Bool -> Markup -> Markup
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([[Target]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Target]]
    results) (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ Markup -> Markup
    H.p "No results found"
        [[Target]] -> ([Target] -> Markup) -> Markup
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [[Target]]
    results (([Target] -> Markup) -> Markup) -> ([Target] -> Markup) -> Markup
    forall a b. (a -> b) -> a -> b
    $ \is :: [Target]
    is@(Target{..}:_) -> do
            Markup -> Markup
    H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.class_ "result" (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ do
                Markup -> Markup
    H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.class_ "ans" (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ do
                    Markup -> Markup
    H.a (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.href (FilePath -> AttributeValue
    H.stringValue (FilePath -> AttributeValue) -> FilePath -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ Bool -> Maybe FilePath -> FilePath -> FilePath
    showURL Bool
    local Maybe FilePath
    haddock FilePath
    targetURL) (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $
                        [Query] -> FilePath -> Markup
    displayItem [Query]
    query FilePath
    targetItem
                    Bool -> Markup -> Markup
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    links (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $
                        Maybe FilePath -> (FilePath -> Markup) -> Markup
    forall (m :: * -> *) a.
    Applicative m =>
    Maybe a -> (a -> m ()) -> m ()
    whenJust ([Target] -> Maybe FilePath
    useLink [Target]
    is) ((FilePath -> Markup) -> Markup) -> (FilePath -> Markup) -> Markup
    forall a b. (a -> b) -> a -> b
    $ \link :: FilePath
    link ->
                            Markup -> Markup
    H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.class_ "links" (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ Markup -> Markup
    H.a (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.href (FilePath -> AttributeValue
    H.stringValue FilePath
    link) (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ "Uses"
                Markup -> Markup
    H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.class_ "from" (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ Bool -> Maybe FilePath -> [Target] -> Markup
    showFroms Bool
    local Maybe FilePath
    haddock [Target]
    is
                Markup -> Markup
    H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.class_ "doc newline shut" (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Markup
    H.preEscapedString FilePath
    targetDocs
        where
            useLink :: [Target] -> Maybe String
            useLink :: [Target] -> Maybe FilePath
    useLink [t :: Target
    t] | Maybe (FilePath, FilePath) -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe (FilePath, FilePath) -> Bool)
    -> Maybe (FilePath, FilePath) -> Bool
    forall a b. (a -> b) -> a -> b
    $ Target -> Maybe (FilePath, FilePath)
    targetPackage Target
    t =
                FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
    forall a b. (a -> b) -> a -> b
    $ "https://packdeps.haskellers.com/reverse/" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    extractName (Target -> FilePath
    targetItem Target
    t)
            useLink _ = Maybe FilePath
    forall a. Maybe a
    Nothing

            add :: FilePath -> FilePath
    add x :: FilePath
    x = ("?" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++) (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> [FilePath] -> FilePath
    forall a. [a] -> [[a]] -> [a]
    intercalate "&" ([FilePath] -> FilePath) -> [FilePath] -> FilePath
    forall a b. (a -> b) -> a -> b
    $ ((FilePath, FilePath) -> FilePath)
    -> [(FilePath, FilePath)] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath -> (FilePath, FilePath) -> FilePath
    forall a. [a] -> ([a], [a]) -> [a]
    joinPair "=") ([(FilePath, FilePath)] -> [FilePath])
    -> [(FilePath, FilePath)] -> [FilePath]
    forall a b. (a -> b) -> a -> b
    $
                case ((FilePath, FilePath) -> Bool)
    -> [(FilePath, FilePath)]
    -> ([(FilePath, FilePath)], [(FilePath, FilePath)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) "hoogle" (FilePath -> Bool)
    -> ((FilePath, FilePath) -> FilePath)
    -> (FilePath, FilePath)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FilePath, FilePath) -> FilePath
    forall a b. (a, b) -> a
    fst) [(FilePath, FilePath)]
    args of
                    (a :: [(FilePath, FilePath)]
    a,[]) -> [(FilePath, FilePath)]
    a [(FilePath, FilePath)]
    -> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
    forall a. [a] -> [a] -> [a]
    ++ [("hoogle", FilePath -> FilePath
    escapeURL FilePath
    x)]
                    (a :: [(FilePath, FilePath)]
    a,(_,x1 :: FilePath
    x1):b :: [(FilePath, FilePath)]
    b) -> [(FilePath, FilePath)]
    a [(FilePath, FilePath)]
    -> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
    forall a. [a] -> [a] -> [a]
    ++ [("hoogle", FilePath -> FilePath
    escapeURL (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath
    x1 FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    x)] [(FilePath, FilePath)]
    -> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
    forall a. [a] -> [a] -> [a]
    ++ [(FilePath, FilePath)]
    b

            f :: FilePath -> FilePath -> Markup
    f cat :: FilePath
    cat val :: FilePath
    val = do
                Markup -> Markup
    H.a (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.class_" minus" (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.href (FilePath -> AttributeValue
    H.stringValue (FilePath -> AttributeValue) -> FilePath -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath
    add (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $ "-" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    cat FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ ":" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    val) (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ ""
                Markup -> Markup
    H.a (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.class_ "plus"  (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.href (FilePath -> AttributeValue
    H.stringValue (FilePath -> AttributeValue) -> FilePath -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath
    add (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $        FilePath
    cat FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ ":" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    val) (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $
                    FilePath -> Markup
    H.string (FilePath -> Markup) -> FilePath -> Markup
    forall a b. (a -> b) -> a -> b
    $ (if FilePath
    cat FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == "package" then "" else FilePath
    cat FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ ":") FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    val

    -- find the <span class=name>X</span> bit
    extractName :: String -> String
    extractName :: FilePath -> FilePath
    extractName x :: FilePath
    x
        | Just (_, x :: FilePath
    x) <- FilePath -> FilePath -> Maybe (FilePath, FilePath)
    forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
    stripInfix "<span class=name>" FilePath
    x
        , Just (x :: FilePath
    x, _) <- FilePath -> FilePath -> Maybe (FilePath, FilePath)
    forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
    stripInfix "</span>" FilePath
    x
        = FilePath -> FilePath
    unHTML FilePath
    x
    extractName x :: FilePath
    x = FilePath
    x

    itemCategories :: [Target] -> [(String,String)]
    itemCategories :: [Target] -> [(FilePath, FilePath)]
    itemCategories xs :: [Target]
    xs =
        [("is","exact")] [(FilePath, FilePath)]
    -> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
    forall a. [a] -> [a] -> [a]
    ++
        [("is","package") | (Target -> Bool) -> [Target] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) "package" (FilePath -> Bool) -> (Target -> FilePath) -> Target -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Target -> FilePath
    targetType) [Target]
    xs] [(FilePath, FilePath)]
    -> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
    forall a. [a] -> [a] -> [a]
    ++
        [("is","module")  | (Target -> Bool) -> [Target] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) "module"  (FilePath -> Bool) -> (Target -> FilePath) -> Target -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Target -> FilePath
    targetType) [Target]
    xs] [(FilePath, FilePath)]
    -> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
    forall a. [a] -> [a] -> [a]
    ++
        [(FilePath, FilePath)] -> [(FilePath, FilePath)]
    forall a. Ord a => [a] -> [a]
    nubOrd [("package",FilePath
    p) | Just (p :: FilePath
    p,_) <- (Target -> Maybe (FilePath, FilePath))
    -> [Target] -> [Maybe (FilePath, FilePath)]
    forall a b. (a -> b) -> [a] -> [b]
    map Target -> Maybe (FilePath, FilePath)
    targetPackage [Target]
    xs]

    showFroms :: Bool -> Maybe FilePath -> [Target] -> Markup
    showFroms :: Bool -> Maybe FilePath -> [Target] -> Markup
    showFroms local :: Bool
    local haddock :: Maybe FilePath
    haddock xs :: [Target]
    xs = [Markup] -> Markup
    forall a. Monoid a => [a] -> a
    mconcat ([Markup] -> Markup) -> [Markup] -> Markup
    forall a b. (a -> b) -> a -> b
    $ Markup -> [Markup] -> [Markup]
    forall a. a -> [a] -> [a]
    intersperse ", " ([Markup] -> [Markup]) -> [Markup] -> [Markup]
    forall a b. (a -> b) -> a -> b
    $ ((Maybe (FilePath, FilePath) -> Markup)
     -> [Maybe (FilePath, FilePath)] -> [Markup])
    -> [Maybe (FilePath, FilePath)]
    -> (Maybe (FilePath, FilePath) -> Markup)
    -> [Markup]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Maybe (FilePath, FilePath) -> Markup)
    -> [Maybe (FilePath, FilePath)] -> [Markup]
    forall a b. (a -> b) -> [a] -> [b]
    map [Maybe (FilePath, FilePath)]
    pkgs ((Maybe (FilePath, FilePath) -> Markup) -> [Markup])
    -> (Maybe (FilePath, FilePath) -> Markup) -> [Markup]
    forall a b. (a -> b) -> a -> b
    $ \p :: Maybe (FilePath, FilePath)
    p ->
        let ms :: [Target]
    ms = (Target -> Bool) -> [Target] -> [Target]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Maybe (FilePath, FilePath) -> Maybe (FilePath, FilePath) -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) Maybe (FilePath, FilePath)
    p (Maybe (FilePath, FilePath) -> Bool)
    -> (Target -> Maybe (FilePath, FilePath)) -> Target -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Target -> Maybe (FilePath, FilePath)
    targetPackage) [Target]
    xs
        in [Markup] -> Markup
    forall a. Monoid a => [a] -> a
    mconcat ([Markup] -> Markup) -> [Markup] -> Markup
    forall a b. (a -> b) -> a -> b
    $ Markup -> [Markup] -> [Markup]
    forall a. a -> [a] -> [a]
    intersperse " " [Markup -> Markup
    H.a (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.href (FilePath -> AttributeValue
    H.stringValue (FilePath -> AttributeValue) -> FilePath -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ Bool -> Maybe FilePath -> FilePath -> FilePath
    showURL Bool
    local Maybe FilePath
    haddock FilePath
    b) (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Markup
    H.string FilePath
    a | (a :: FilePath
    a,b :: FilePath
    b) <- [Maybe (FilePath, FilePath)] -> [(FilePath, FilePath)]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe (FilePath, FilePath)] -> [(FilePath, FilePath)])
    -> [Maybe (FilePath, FilePath)] -> [(FilePath, FilePath)]
    forall a b. (a -> b) -> a -> b
    $ Maybe (FilePath, FilePath)
    p Maybe (FilePath, FilePath)
    -> [Maybe (FilePath, FilePath)] -> [Maybe (FilePath, FilePath)]
    forall a. a -> [a] -> [a]
    : (Target -> Maybe (FilePath, FilePath))
    -> [Target] -> [Maybe (FilePath, FilePath)]
    forall a b. (a -> b) -> [a] -> [b]
    map Target -> Maybe (FilePath, FilePath)
    remod [Target]
    ms]
        where
            remod :: Target -> Maybe (FilePath, FilePath)
    remod Target{..} = do (a :: FilePath
    a,_) <- Maybe (FilePath, FilePath)
    targetModule; (FilePath, FilePath) -> Maybe (FilePath, FilePath)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FilePath
    a,FilePath
    targetURL)
            pkgs :: [Maybe (FilePath, FilePath)]
    pkgs = [Maybe (FilePath, FilePath)] -> [Maybe (FilePath, FilePath)]
    forall a. Ord a => [a] -> [a]
    nubOrd ([Maybe (FilePath, FilePath)] -> [Maybe (FilePath, FilePath)])
    -> [Maybe (FilePath, FilePath)] -> [Maybe (FilePath, FilePath)]
    forall a b. (a -> b) -> a -> b
    $ (Target -> Maybe (FilePath, FilePath))
    -> [Target] -> [Maybe (FilePath, FilePath)]
    forall a b. (a -> b) -> [a] -> [b]
    map Target -> Maybe (FilePath, FilePath)
    targetPackage [Target]
    xs

    showURL :: Bool -> Maybe FilePath -> URL -> String
    showURL :: Bool -> Maybe FilePath -> FilePath -> FilePath
    showURL _ (Just _) x :: FilePath
    x = "haddock/" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath -> FilePath
    forall a. Eq a => [a] -> [a] -> [a]
    dropPrefix "file:///" FilePath
    x
    showURL True _ (FilePath -> FilePath -> Maybe FilePath
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix "file:///" -> Just x :: FilePath
    x) = "file/" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    x
    showURL _ _ x :: FilePath
    x = FilePath
    x

    -------------------------------------------------------------
    -- DISPLAY AN ITEM (bold keywords etc)

    highlightItem :: [Query] -> String -> Markup
    highlightItem :: [Query] -> FilePath -> Markup
    highlightItem qs :: [Query]
    qs x :: FilePath
    x
        | Just (pre :: FilePath
    pre,x :: FilePath
    x) <- FilePath -> FilePath -> Maybe (FilePath, FilePath)
    forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
    stripInfix "<s0>" FilePath
    x, Just (name :: FilePath
    name,post :: FilePath
    post) <- FilePath -> FilePath -> Maybe (FilePath, FilePath)
    forall a. Eq a => [a] -> [a] -> Maybe ([a], [a])
    stripInfix "</s0>" FilePath
    x
            = FilePath -> Markup
    H.preEscapedString FilePath
    pre Markup -> Markup -> Markup
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Markup
    highlight (FilePath -> FilePath
    unescapeHTML FilePath
    name) Markup -> Markup -> Markup
    forall a. Semigroup a => a -> a -> a
    <> FilePath -> Markup
    H.preEscapedString FilePath
    post
        | Bool
    otherwise = FilePath -> Markup
    H.string FilePath
    x
        where
            highlight :: FilePath -> Markup
    highlight = ([(Bool, Char)] -> Markup) -> [[(Bool, Char)]] -> Markup
    forall b a. Monoid b => (a -> b) -> [a] -> b
    mconcatMap (\xs :: [(Bool, Char)]
    xs@((b :: Bool
    b,_):_) -> let s :: Markup
    s = FilePath -> Markup
    H.string (FilePath -> Markup) -> FilePath -> Markup
    forall a b. (a -> b) -> a -> b
    $ ((Bool, Char) -> Char) -> [(Bool, Char)] -> FilePath
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool, Char) -> Char
    forall a b. (a, b) -> b
    snd [(Bool, Char)]
    xs in if Bool
    b then Markup -> Markup
    H.b Markup
    s else Markup
    s) ([[(Bool, Char)]] -> Markup)
    -> (FilePath -> [[(Bool, Char)]]) -> FilePath -> Markup
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                        ((Bool, Char) -> Bool) -> [(Bool, Char)] -> [[(Bool, Char)]]
    forall b a. Eq b => (a -> b) -> [a] -> [[a]]
    groupOn (Bool, Char) -> Bool
    forall a b. (a, b) -> a
    fst ([(Bool, Char)] -> [[(Bool, Char)]])
    -> (FilePath -> [(Bool, Char)]) -> FilePath -> [[(Bool, Char)]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (\x :: FilePath
    x -> [Bool] -> FilePath -> [(Bool, Char)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (FilePath -> [Bool]
    f FilePath
    x) FilePath
    x)
                where
                  f :: FilePath -> [Bool]
    f (x :: Char
    x:xs :: FilePath
    xs) | Int
    m Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0 = Int -> Bool -> [Bool]
    forall a. Int -> a -> [a]
    replicate Int
    m Bool
    True [Bool] -> [Bool] -> [Bool]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Bool] -> [Bool]
    forall a. Int -> [a] -> [a]
    drop (Int
    m Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1) (FilePath -> [Bool]
    f FilePath
    xs)
                      where m :: Int
    m = [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ 0 Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    : [FilePath -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length FilePath
    y | QueryName y :: FilePath
    y <- [Query]
    qs, FilePath -> FilePath
    lower FilePath
    y FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` FilePath -> FilePath
    lower (Char
    xChar -> FilePath -> FilePath
    forall a. a -> [a] -> [a]
    :FilePath
    xs)]
                  f (x :: Char
    x:xs :: FilePath
    xs) = Bool
    False Bool -> [Bool] -> [Bool]
    forall a. a -> [a] -> [a]
    : FilePath -> [Bool]
    f FilePath
    xs
                  f [] = []

    displayItem :: [Query] -> String -> Markup
    displayItem :: [Query] -> FilePath -> Markup
    displayItem = [Query] -> FilePath -> Markup
    highlightItem

    action_server_test_ :: IO ()
    action_server_test_ :: IO ()
    action_server_test_ = do
        FilePath -> IO () -> IO ()
    testing "Action.Server.displayItem" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            let expand :: FilePath -> FilePath
    expand = FilePath -> FilePath -> FilePath -> FilePath
    forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
    replace "{" "<b>" (FilePath -> FilePath)
    -> (FilePath -> FilePath) -> FilePath -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> FilePath -> FilePath -> FilePath
    forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
    replace "}" "</b>" (FilePath -> FilePath)
    -> (FilePath -> FilePath) -> FilePath -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> FilePath -> FilePath -> FilePath
    forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
    replace "<s0>" "" (FilePath -> FilePath)
    -> (FilePath -> FilePath) -> FilePath -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> FilePath -> FilePath -> FilePath
    forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
    replace "</s0>" ""
                contract :: FilePath -> FilePath
    contract = FilePath -> FilePath -> FilePath -> FilePath
    forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
    replace "{" "" (FilePath -> FilePath)
    -> (FilePath -> FilePath) -> FilePath -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> FilePath -> FilePath -> FilePath
    forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
    replace "}" ""
            let q :: FilePath
    q === :: FilePath -> FilePath -> IO ()
    === s :: FilePath
    s | ByteString -> FilePath
    LBS.unpack (Markup -> ByteString
    renderMarkup (Markup -> ByteString) -> Markup -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Query] -> FilePath -> Markup
    displayItem (FilePath -> [Query]
    parseQuery FilePath
    q) (FilePath -> FilePath
    contract FilePath
    s)) FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath -> FilePath
    expand FilePath
    s = Char -> IO ()
    putChar '.'
                        | Bool
    otherwise = FilePath -> IO ()
    forall a. Partial => FilePath -> IO a
    errorIO (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (FilePath, FilePath, ByteString) -> FilePath
    forall a. Show a => a -> FilePath
    show (FilePath
    q,FilePath
    s,Markup -> ByteString
    renderMarkup (Markup -> ByteString) -> Markup -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Query] -> FilePath -> Markup
    displayItem (FilePath -> [Query]
    parseQuery FilePath
    q) (FilePath -> FilePath
    contract FilePath
    s))
            "test" FilePath -> FilePath -> IO ()
    === "<s0>my{Test}</s0> :: Int -&gt; test"
            "new west" FilePath -> FilePath -> IO ()
    === "<s0>{newest}_{new}</s0> :: Int"
            "+*" FilePath -> FilePath -> IO ()
    === "(<s0>{+*}&amp;</s0>) :: Int"
            "+<" FilePath -> FilePath -> IO ()
    === "(<s0>&gt;{+&lt;}</s0>) :: Int"
            "foo" FilePath -> FilePath -> IO ()
    === "<i>data</i> <s0>{Foo}d</s0>"
            "foo" FilePath -> FilePath -> IO ()
    === "<i>type</i> <s0>{Foo}d</s0>"
            "foo" FilePath -> FilePath -> IO ()
    === "<i>type family</i> <s0>{Foo}d</s0>"
            "foo" FilePath -> FilePath -> IO ()
    === "<i>module</i> Foo.Bar.<s0>F{Foo}</s0>"
            "foo" FilePath -> FilePath -> IO ()
    === "<i>module</i> <s0>{Foo}o</s0>"

    action_server_test :: Bool -> FilePath -> IO ()
    action_server_test :: Bool -> FilePath -> IO ()
    action_server_test sample :: Bool
    sample database :: FilePath
    database = do
        FilePath -> IO () -> IO ()
    testing "Action.Server.replyServer" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> (StoreRead -> IO ()) -> IO ()
    forall a. NFData a => FilePath -> (StoreRead -> IO a) -> IO a
    withSearch FilePath
    database ((StoreRead -> IO ()) -> IO ()) -> (StoreRead -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \store :: StoreRead
    store -> do
            Log
    log <- IO Log
    logNone
            FilePath
    dataDir <- IO FilePath
    getDataDir
            let check :: (FilePath -> Bool) -> FilePath -> IO ()
    check p :: FilePath -> Bool
    p q :: FilePath
    q = do
                    OutputHTML (ByteString -> FilePath
    lbstrUnpack -> FilePath
    res) <- Log
    -> Bool
    -> Bool
    -> Maybe FilePath
    -> StoreRead
    -> FilePath
    -> FilePath
    -> FilePath
    -> FilePath
    -> Input
    -> IO Output
    replyServer Log
    log Bool
    False Bool
    False Maybe FilePath
    forall a. Maybe a
    Nothing StoreRead
    store "" "" (FilePath
    dataDir FilePath -> FilePath -> FilePath
    </> "html") "" ([FilePath] -> [(FilePath, FilePath)] -> Input
    Input [] [("hoogle",FilePath
    q)])
                    if FilePath -> Bool
    p FilePath
    res then Char -> IO ()
    putChar '.' else FilePath -> IO ()
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
    fail (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "Bad substring: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    res
            let q :: FilePath
    q === :: FilePath -> FilePath -> IO ()
    === want :: FilePath
    want = (FilePath -> Bool) -> FilePath -> IO ()
    check (FilePath
    want FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf`) FilePath
    q
            let q :: FilePath
    q /== :: FilePath -> FilePath -> IO ()
    /== want :: FilePath
    want = (FilePath -> Bool) -> FilePath -> IO ()
    check (Bool -> Bool
    not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isInfixOf FilePath
    want) FilePath
    q
            "<test" FilePath -> FilePath -> IO ()
    /== "<test"
            "&test" FilePath -> FilePath -> IO ()
    /== "&test"
            if Bool
    sample then
                "Wife" FilePath -> FilePath -> IO ()
    === "<b>type family</b>"
             else do
                "<>" FilePath -> FilePath -> IO ()
    === "<span class=name>(<b>&lt;&gt;</b>)</span>"
                "filt" FilePath -> FilePath -> IO ()
    === "<span class=name><b>filt</b>er</span>"
                "True" FilePath -> FilePath -> IO ()
    === "https://hackage.haskell.org/package/base/docs/Prelude.html#v:True"

    -------------------------------------------------------------
    -- ANALYSE THE LOG

    displayLog :: [Summary] -> String
    displayLog :: [Summary] -> FilePath
    displayLog xs :: [Summary]
    xs = "[" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> [FilePath] -> FilePath
    forall a. [a] -> [[a]] -> [a]
    intercalate "," ((Summary -> FilePath) -> [Summary] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map Summary -> FilePath
    f [Summary]
    xs) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ "]"
        where
            f :: Summary -> FilePath
    f Summary{..} = "{date:" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show (Day -> FilePath
    showGregorian Day
    summaryDate) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
                            ",users:" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    summaryUsers FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ ",uses:" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    summaryUses FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
                            ",slowest:" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Seconds -> FilePath
    forall a. Show a => a -> FilePath
    show Seconds
    summarySlowest FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ ",average:" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Seconds -> FilePath
    forall a. Show a => a -> FilePath
    show (Average Seconds -> Seconds
    forall a. Fractional a => Average a -> a
    fromAverage Average Seconds
    summaryAverage) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
                            ",errors:" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    summaryErrors FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ "}"