Parse JSON
This commit is contained in:
parent
b04680e444
commit
e2e40ccacd
3 changed files with 18 additions and 7 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -2,5 +2,6 @@
|
||||||
cabal.sandbox.config
|
cabal.sandbox.config
|
||||||
dist
|
dist
|
||||||
*.swp
|
*.swp
|
||||||
|
*.swo
|
||||||
*~
|
*~
|
||||||
.ghci
|
.ghci
|
||||||
|
|
|
@ -44,7 +44,10 @@ executable holy-project
|
||||||
, process
|
, process
|
||||||
, random
|
, random
|
||||||
, http-conduit
|
, http-conduit
|
||||||
|
, lens
|
||||||
|
, lens-aeson
|
||||||
, aeson
|
, aeson
|
||||||
|
, text
|
||||||
-- from Tasty cabal with ansi-terminal
|
-- from Tasty cabal with ansi-terminal
|
||||||
cpp-options: -DCOLORS
|
cpp-options: -DCOLORS
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
|
|
21
src/Main.hs
21
src/Main.hs
|
@ -31,8 +31,12 @@ import Control.Exception
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import Control.Monad (guard)
|
import Control.Monad (guard)
|
||||||
-- HTTP request and JSON handling
|
-- HTTP request and JSON handling
|
||||||
import qualified Data.ByteString.Char8 as C
|
|
||||||
import Network.HTTP.Conduit
|
import Network.HTTP.Conduit
|
||||||
|
import Control.Lens.Operators ((^?))
|
||||||
|
import Control.Lens.Aeson
|
||||||
|
import Data.Aeson.Encode (fromValue)
|
||||||
|
import qualified Data.Text.Lazy as TLZ
|
||||||
|
import qualified Data.Text.Lazy.Builder as TLB
|
||||||
|
|
||||||
-- Get external file of package
|
-- Get external file of package
|
||||||
import Paths_holy_project
|
import Paths_holy_project
|
||||||
|
@ -278,7 +282,7 @@ getNameAndMail gitConfigContent = (getFirstValueFor splitted "name",
|
||||||
-- Get the first line which start with
|
-- Get the first line which start with
|
||||||
-- 'elem =' and return the third field (value)
|
-- 'elem =' and return the third field (value)
|
||||||
getFirstValueFor :: [[LZ.ByteString]] -> String -> Maybe String
|
getFirstValueFor :: [[LZ.ByteString]] -> String -> Maybe String
|
||||||
getFirstValueFor splitted key = firstJust (map (getValueForKey key) splitted)
|
getFirstValueFor splitted keyname = firstJust (map (getValueForKey keyname) splitted)
|
||||||
|
|
||||||
-- return the first Just value of a list of Maybe
|
-- return the first Just value of a list of Maybe
|
||||||
firstJust :: (Eq a) => [Maybe a] -> Maybe a
|
firstJust :: (Eq a) => [Maybe a] -> Maybe a
|
||||||
|
@ -297,15 +301,14 @@ getValueForKey el (n:e:xs) = if (n == (LZ.pack el)) && (e == (LZ.pack "="))
|
||||||
else Nothing
|
else Nothing
|
||||||
getValueForKey _ _ = Nothing
|
getValueForKey _ _ = Nothing
|
||||||
|
|
||||||
|
simpleHTTPWithUserAgent :: String -> IO LZ.ByteString
|
||||||
simpleHTTPWithUserAgent url = do
|
simpleHTTPWithUserAgent url = do
|
||||||
r <- parseUrl url
|
r <- parseUrl url
|
||||||
let request = r { requestHeaders = [ ("User-Agent","HTTP-Conduit") ] }
|
let request = r { requestHeaders = [ ("User-Agent","HTTP-Conduit") ] }
|
||||||
body <- withManager $ \manager -> do
|
body <- withManager $ \manager -> do
|
||||||
response <- httpLbs request manager
|
response <- httpLbs request manager
|
||||||
return $ responseBody response
|
return $ responseBody response
|
||||||
let str = LZ.unpack body
|
return body
|
||||||
return $ Just str
|
|
||||||
|
|
||||||
|
|
||||||
-- Ask the github API
|
-- Ask the github API
|
||||||
|
@ -313,5 +316,9 @@ simpleHTTPWithUserAgent url = do
|
||||||
-- It took me way too long to get this error
|
-- It took me way too long to get this error
|
||||||
getGHUser :: String -> IO (Maybe String)
|
getGHUser :: String -> IO (Maybe String)
|
||||||
getGHUser email = do
|
getGHUser email = do
|
||||||
body <- simpleHTTPWithUserAgent $ "https://api.github.com/search/users?q=" ++ email
|
url = "https://api.github.com/search/users?q=" ++ email
|
||||||
return body
|
body <- simpleHTTPWithUserAgent url
|
||||||
|
login <- return $ body ^? key "items" . nth 0 . key "login"
|
||||||
|
return $ fmap jsonValueToString login
|
||||||
|
where
|
||||||
|
jsonValueToString = TLZ.unpack . TLB.toLazyText . fromValue
|
||||||
|
|
Loading…
Reference in a new issue