{-# LANGUAGE OverloadedStrings #-} module Main where import Paths_hayoo_cli (version) import Data.Version (showVersion) import Data.ByteString.Char8 (pack) import qualified Data.ByteString.Lazy as BSL import Data.Aeson import Network.HTTP.Conduit import Network.HTTP.Types.Header (hUserAgent) import Network.URL (encString, ok_url) import Text.Pandoc (def, readHtml, writeAsciiDoc) import Text.Pandoc.Options (WriterOptions(..)) import CliOptions import HayooTypes jsonData :: Opts -> IO BSL.ByteString jsonData (Opts _ searchQuery) = do req <- parseUrl url let req' = req { requestHeaders = [userAgentHeader] } response <- withManager $ httpLbs req' return $ responseBody response where url = "http://hayoo.fh-wedel.de/json?query=" ++ encQuery encQuery = encString True ok_url searchQuery userAgent = pack $ "hayoo-cli/" ++ showVersion version userAgentHeader = (hUserAgent, userAgent) decodeHayooResponse :: BSL.ByteString -> HayooResponse decodeHayooResponse bs = case eitherDecode bs of (Right res) -> res (Left err) -> error $ show err printDelimiter :: Char -> IO () printDelimiter = putStrLn . replicate 100 htmlToAscii :: String -> String htmlToAscii = (writeAsciiDoc def {writerReferenceLinks = True}) . readHtml def printResultFull :: HayooResult -> IO () printResultFull singleResult@(HayooResult _ _ _ _ _ desc _ _ _ _) = printResultShort singleResult >> putStrLn "" >> (putStrLn $ htmlToAscii desc) printResultShort :: HayooResult -> IO () printResultShort (HayooResult _ _ _ name _ _ signature modules _ _) = putStrLn $ unwords $ modules ++ nameAndSignaruter name signature where nameAndSignaruter n "" = [n] nameAndSignaruter n s = [n, "::", s] printResponse :: Opts -> HayooResponse -> IO () printResponse (Opts _ _) (HayooResponse _ _ _ []) = putStrLn "No results found" printResponse (Opts True _) (HayooResponse _ _ _ (res:_)) = printResultFull res printResponse (Opts False _) (HayooResponse _ _ _ results) = mapM_ printResultShort results run :: Opts -> IO () run opts = (jsonData opts) >>= ((printResponse opts) . decodeHayooResponse) main :: IO () main = parseArguments ver run where ver = showVersion version