Parse a substructure from json

ParseFoo.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}

module ParseFoo where

import qualified Data.Text.Lazy.IO as T
import qualified Data.Text.Lazy.Encoding as T
import qualified Data.ByteString.Lazy.Internal as B
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Encode.Pretty as JSON
import qualified Data.HashMap.Strict as HM
import qualified Data.Vector as V
import GHC.Generics
import Data.Aeson.Types

newtype Foo = MkFoo
  { _data :: (String, String)
  } deriving (Eq, Show, Generic, ToJSON)

instance FromJSON Foo where
  parseJSON = withObject "foo" $ \o -> do
    _data <- head . HM.toList . V.head <$> o .: "results"
    return MkFoo{..}

run :: IO ()
run = do
  bs <- T.encodeUtf8 <$> T.getLine
  case parseFoo bs of
    Just foo -> T.putStrLn $ T.decodeUtf8 $ JSON.encodePretty foo
    _ -> T.putStrLn "{\"error\": \"bad input\"}"
  where
    parseFoo :: B.ByteString -> Maybe Foo
    parseFoo bs = case JSON.decode bs of
      Just v -> parseMaybe parseJSON v
      _ -> Nothing

{-
usage:

λ> run
{"status":"ok","results":[{"k1":"v1"},{"k2":"v2"},{"k3":"v3"}]}
{
    "_data": [
        "k1",
        "v1"
    ]
}
(12.23 secs, 488,000 bytes)
-}