{-# 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
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
[] -> 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="",targetPackage=Nothing, targetModule=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
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
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]
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
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
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
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
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]
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
extractName :: String -> String
[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
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 -> test"
[Char]
"new west" [Char] -> [Char] -> IO ()
=== [Char]
"<s0>{newest}_{new}</s0> :: Int"
[Char]
"+*" [Char] -> [Char] -> IO ()
=== [Char]
"(<s0>{+*}&</s0>) :: Int"
[Char]
"+<" [Char] -> [Char] -> IO ()
=== [Char]
"(<s0>>{+<}</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><></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"
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]
"}"