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

    actionReplay :: CmdLine -> IO ()
    actionReplay :: CmdLine -> IO ()
    actionReplay Replay{Int
    [Char]
    Language
    database :: CmdLine -> [Char]
    language :: CmdLine -> Language
    logs :: CmdLine -> [Char]
    scope :: CmdLine -> [Char]
    logs :: [Char]
    database :: [Char]
    repeat_ :: Int
    language :: Language
    scope :: [Char]
    repeat_ :: CmdLine -> Int
    ..} = 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
        [Char]
    src <- [Char] -> IO [Char]
    readFile [Char]
    logs
        let qs :: [Input]
    qs = [Maybe Input] -> [Input]
    forall a. [Maybe a] -> [a]
    catMaybes [[Char] -> Maybe Input
    readInput [Char]
    url | [Char]
    _:[Char]
    ip:[Char]
    _:[Char]
    url:[[Char]]
    _ <- ([Char] -> [[Char]]) -> [[Char]] -> [[[Char]]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> [[Char]]
    words ([[Char]] -> [[[Char]]]) -> [[Char]] -> [[[Char]]]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [[Char]]
    lines [Char]
    src, [Char]
    ip [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [Char]
    "-"]
        (Double
    t,()
    _) <- IO () -> IO (Double, ())
    forall (m :: * -> *) a. MonadIO m => m a -> m (Double, a)
    duration (IO () -> IO (Double, ())) -> IO () -> IO (Double, ())
    forall a b. (a -> b) -> a -> b
    $ [Char] -> (StoreRead -> IO ()) -> IO ()
    forall a. NFData a => [Char] -> (StoreRead -> IO a) -> IO a
    withSearch [Char]
    database ((StoreRead -> IO ()) -> IO ()) -> (StoreRead -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \StoreRead
    store -> do
            Log
    log <- IO Log
    logNone
            [Char]
    dataDir <- IO [Char]
    getDataDir
            let op :: Input -> IO Output
    op = Log
    -> Bool
    -> Bool
    -> Maybe [Char]
    -> StoreRead
    -> [Char]
    -> [Char]
    -> [Char]
    -> [Char]
    -> Input
    -> IO Output
    replyServer Log
    log Bool
    False Bool
    False Maybe [Char]
    forall a. Maybe a
    Nothing StoreRead
    store [Char]
    "" [Char]
    "" ([Char]
    dataDir [Char] -> [Char] -> [Char]
    </> [Char]
    "html") [Char]
    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
    $ \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 Char
    '.'
        [Char] -> IO ()
    putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "\nTook " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Double -> [Char]
    showDuration Double
    t [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Double -> [Char]
    showDuration (Double
    t Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Int -> Double
    intToDouble (Int
    repeat_ Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * [Input] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Input]
    qs)) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")"

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

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

        [[Char]
    "canary"] -> do
            UTCTime
    now <- IO UTCTime
    getCurrentTime
            [Summary]
    summ <- Log -> IO [Summary]
    logSummary Log
    log
            let errs :: Int
    errs = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [Int
    summaryErrors | Summary{Double
    Int
    Day
    Average Double
    summaryErrors :: Int
    summaryDate :: Day
    summaryUsers :: Int
    summaryUses :: Int
    summarySlowest :: Double
    summaryAverage :: Average Double
    summaryDate :: Summary -> Day
    summaryUsers :: Summary -> Int
    summaryUses :: Summary -> Int
    summarySlowest :: Summary -> Double
    summaryAverage :: Summary -> Average Double
    summaryErrors :: Summary -> Int
    ..} <- [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 :: Double
    alive = Rational -> Double
    forall a. Fractional a => Rational -> a
    fromRational (Rational -> Double) -> Rational -> Double
    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
    / (NominalDiffTime
    24 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * NominalDiffTime
    60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * NominalDiffTime
    60)
            Output -> IO Output
    forall a. a -> IO a
    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
    == Int
    0 Bool -> Bool -> Bool
    && Double
    alive Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    < Double
    1.5 then LBStr -> Output
    OutputText else LBStr -> Output
    OutputFail) (LBStr -> Output) -> LBStr -> Output
    forall a b. (a -> b) -> a -> b
    $ [Char] -> LBStr
    lbstrPack ([Char] -> LBStr) -> [Char] -> LBStr
    forall a b. (a -> b) -> a -> b
    $
                [Char]
    "Errors " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (if Int
    errs Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then [Char]
    "good" else [Char]
    "bad") [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ": " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    errs [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " in the last 24 hours.\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                [Char]
    "Updates " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (if Double
    alive Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    < Double
    1.5 then [Char]
    "good" else [Char]
    "bad") [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ": Last updated " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> Double -> [Char]
    forall a. RealFloat a => Int -> a -> [Char]
    showDP Int
    2 Double
    alive [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " days ago.\n"

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

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

    dedupeTake :: Ord k => Int -> (v -> k) -> [v] -> [[v]]
    dedupeTake :: forall k v. Ord k => Int -> (v -> k) -> [v] -> [[v]]
    dedupeTake Int
    n 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 [k]
    res Map k [v]
    mp [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 a. [a] -> 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 [k]
    res Map k [v]
    mp (v
    x:[v]
    xs) | Just [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 [Char]
    -> [([Char], [Char])]
    -> [Query]
    -> [[Target]]
    -> Markup
    showResults Bool
    local Bool
    links Maybe [Char]
    haddock [([Char], [Char])]
    args [Query]
    query [[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 AttributeValue
    "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 Markup
    "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
    $ [Char] -> [Char] -> Markup
    f [Char]
    cat [Char]
    val | ([Char]
    cat,[Char]
    val) <- [Target] -> [([Char], [Char])]
    itemCategories ([Target] -> [([Char], [Char])]) -> [Target] -> [([Char], [Char])]
    forall a b. (a -> b) -> a -> b
    $ [[Target]] -> [Target]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Target]]
    results, Bool -> [Char] -> [Char] -> Query
    QueryScope Bool
    True [Char]
    cat [Char]
    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 a. [a] -> 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 Markup
    "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{[Char]
    Maybe ([Char], [Char])
    targetURL :: Target -> [Char]
    targetPackage :: Target -> Maybe ([Char], [Char])
    targetModule :: Target -> Maybe ([Char], [Char])
    targetURL :: [Char]
    targetPackage :: Maybe ([Char], [Char])
    targetModule :: Maybe ([Char], [Char])
    targetType :: [Char]
    targetItem :: [Char]
    targetDocs :: [Char]
    targetType :: Target -> [Char]
    targetItem :: Target -> [Char]
    targetDocs :: Target -> [Char]
    ..}:[Target]
    _) -> do
            Markup -> Markup
    H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.class_ AttributeValue
    "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_ AttributeValue
    "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 ([Char] -> AttributeValue
    H.stringValue ([Char] -> AttributeValue) -> [Char] -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ Bool -> Maybe [Char] -> [Char] -> [Char]
    showURL Bool
    local Maybe [Char]
    haddock [Char]
    targetURL) (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $
                        [Query] -> [Char] -> Markup
    displayItem [Query]
    query [Char]
    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 [Char] -> ([Char] -> Markup) -> Markup
    forall (m :: * -> *) a.
    Applicative m =>
    Maybe a -> (a -> m ()) -> m ()
    whenJust ([Target] -> Maybe [Char]
    useLink [Target]
    is) (([Char] -> Markup) -> Markup) -> ([Char] -> Markup) -> Markup
    forall a b. (a -> b) -> a -> b
    $ \[Char]
    link ->
                            Markup -> Markup
    H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.class_ AttributeValue
    "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 ([Char] -> AttributeValue
    H.stringValue [Char]
    link) (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ Markup
    "Uses"
                Markup -> Markup
    H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.class_ AttributeValue
    "from" (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ Bool -> Maybe [Char] -> [Target] -> Markup
    showFroms Bool
    local Maybe [Char]
    haddock [Target]
    is
                Markup -> Markup
    H.div (Markup -> Markup) -> Attribute -> Markup -> Markup
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    H.class_ AttributeValue
    "doc newline shut" (Markup -> Markup) -> Markup -> Markup
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Markup
    H.preEscapedString [Char]
    targetDocs
        where
            useLink :: [Target] -> Maybe String
            useLink :: [Target] -> Maybe [Char]
    useLink [Target
    t] | Maybe ([Char], [Char]) -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe ([Char], [Char]) -> Bool) -> Maybe ([Char], [Char]) -> Bool
    forall a b. (a -> b) -> a -> b
    $ Target -> Maybe ([Char], [Char])
    targetPackage Target
    t =
                [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "https://packdeps.haskellers.com/reverse/" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    extractName (Target -> [Char]
    targetItem Target
    t)
            useLink [Target]
    _ = Maybe [Char]
    forall a. Maybe a
    Nothing

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

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

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

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

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

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

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

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

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

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

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

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

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