{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}
-- | Encoding of tabular NCBI BLAST+ output

module Biobase.BLAST.Types where

import Prelude hiding (takeWhile)
import Data.Attoparsec.ByteString.Char8 hiding (isSpace)
import qualified Data.Attoparsec.ByteString.Lazy as L
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Builder as S
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.Vector as V
import qualified Data.Text as T
import System.Directory
import Data.Char
import Control.Monad
import Text.Printf
import GHC.Generics
import Data.Aeson
import Data.Aeson.TH
import Data.Aeson.Types
import qualified Data.HashMap.Strict as HM
import qualified Data.Sequence as DS
import Control.Lens(makeLenses)
import Data.HashMap.Strict (elems)

-- | Turn all keys in a JSON object to lowercase.
jsonLower :: Value -> Value
jsonLower :: Value -> Value
jsonLower (Object Object
o) = Object -> Value
Object (Object -> Value) -> (Object -> Object) -> Object -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, Value)] -> Object)
-> (Object -> [(Text, Value)]) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Value) -> (Text, Value))
-> [(Text, Value)] -> [(Text, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Value) -> (Text, Value)
forall b. (Text, b) -> (Text, b)
lowerPair ([(Text, Value)] -> [(Text, Value)])
-> (Object -> [(Text, Value)]) -> Object -> [(Text, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Object
o
  where lowerPair :: (Text, b) -> (Text, b)
lowerPair (Text
key, b
val) = (Text -> Text
T.toLower Text
key, b
val)
jsonLower Value
x = Value
x

newtype BlastJSON2 = BlastJSON2
  {
    BlastJSON2 -> BlastOutput2
_blastoutput2 :: BlastOutput2
  }
  deriving (Int -> BlastJSON2 -> ShowS
[BlastJSON2] -> ShowS
BlastJSON2 -> String
(Int -> BlastJSON2 -> ShowS)
-> (BlastJSON2 -> String)
-> ([BlastJSON2] -> ShowS)
-> Show BlastJSON2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlastJSON2] -> ShowS
$cshowList :: [BlastJSON2] -> ShowS
show :: BlastJSON2 -> String
$cshow :: BlastJSON2 -> String
showsPrec :: Int -> BlastJSON2 -> ShowS
$cshowsPrec :: Int -> BlastJSON2 -> ShowS
Show, BlastJSON2 -> BlastJSON2 -> Bool
(BlastJSON2 -> BlastJSON2 -> Bool)
-> (BlastJSON2 -> BlastJSON2 -> Bool) -> Eq BlastJSON2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlastJSON2 -> BlastJSON2 -> Bool
$c/= :: BlastJSON2 -> BlastJSON2 -> Bool
== :: BlastJSON2 -> BlastJSON2 -> Bool
$c== :: BlastJSON2 -> BlastJSON2 -> Bool
Eq, (forall x. BlastJSON2 -> Rep BlastJSON2 x)
-> (forall x. Rep BlastJSON2 x -> BlastJSON2) -> Generic BlastJSON2
forall x. Rep BlastJSON2 x -> BlastJSON2
forall x. BlastJSON2 -> Rep BlastJSON2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlastJSON2 x -> BlastJSON2
$cfrom :: forall x. BlastJSON2 -> Rep BlastJSON2 x
Generic)

newtype BlastCmdJSON2 = BlastCmdJSON2
  {
    BlastCmdJSON2 -> [BlastOutput2]
_blastcmdoutput2 :: [BlastOutput2]
  }
  deriving (Int -> BlastCmdJSON2 -> ShowS
[BlastCmdJSON2] -> ShowS
BlastCmdJSON2 -> String
(Int -> BlastCmdJSON2 -> ShowS)
-> (BlastCmdJSON2 -> String)
-> ([BlastCmdJSON2] -> ShowS)
-> Show BlastCmdJSON2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlastCmdJSON2] -> ShowS
$cshowList :: [BlastCmdJSON2] -> ShowS
show :: BlastCmdJSON2 -> String
$cshow :: BlastCmdJSON2 -> String
showsPrec :: Int -> BlastCmdJSON2 -> ShowS
$cshowsPrec :: Int -> BlastCmdJSON2 -> ShowS
Show, BlastCmdJSON2 -> BlastCmdJSON2 -> Bool
(BlastCmdJSON2 -> BlastCmdJSON2 -> Bool)
-> (BlastCmdJSON2 -> BlastCmdJSON2 -> Bool) -> Eq BlastCmdJSON2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlastCmdJSON2 -> BlastCmdJSON2 -> Bool
$c/= :: BlastCmdJSON2 -> BlastCmdJSON2 -> Bool
== :: BlastCmdJSON2 -> BlastCmdJSON2 -> Bool
$c== :: BlastCmdJSON2 -> BlastCmdJSON2 -> Bool
Eq, (forall x. BlastCmdJSON2 -> Rep BlastCmdJSON2 x)
-> (forall x. Rep BlastCmdJSON2 x -> BlastCmdJSON2)
-> Generic BlastCmdJSON2
forall x. Rep BlastCmdJSON2 x -> BlastCmdJSON2
forall x. BlastCmdJSON2 -> Rep BlastCmdJSON2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlastCmdJSON2 x -> BlastCmdJSON2
$cfrom :: forall x. BlastCmdJSON2 -> Rep BlastCmdJSON2 x
Generic)

--instance FromJSON BlastJSON2 where
--  parseJSON = genericParseJSON opts . jsonLower
--    where
--      opts = defaultOptions { fieldLabelModifier = map toLower }

newtype BlastOutput2 = BlastOutput2
  {
    BlastOutput2 -> BlastReport
_report :: BlastReport
  }
  deriving (Int -> BlastOutput2 -> ShowS
[BlastOutput2] -> ShowS
BlastOutput2 -> String
(Int -> BlastOutput2 -> ShowS)
-> (BlastOutput2 -> String)
-> ([BlastOutput2] -> ShowS)
-> Show BlastOutput2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlastOutput2] -> ShowS
$cshowList :: [BlastOutput2] -> ShowS
show :: BlastOutput2 -> String
$cshow :: BlastOutput2 -> String
showsPrec :: Int -> BlastOutput2 -> ShowS
$cshowsPrec :: Int -> BlastOutput2 -> ShowS
Show, BlastOutput2 -> BlastOutput2 -> Bool
(BlastOutput2 -> BlastOutput2 -> Bool)
-> (BlastOutput2 -> BlastOutput2 -> Bool) -> Eq BlastOutput2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlastOutput2 -> BlastOutput2 -> Bool
$c/= :: BlastOutput2 -> BlastOutput2 -> Bool
== :: BlastOutput2 -> BlastOutput2 -> Bool
$c== :: BlastOutput2 -> BlastOutput2 -> Bool
Eq, (forall x. BlastOutput2 -> Rep BlastOutput2 x)
-> (forall x. Rep BlastOutput2 x -> BlastOutput2)
-> Generic BlastOutput2
forall x. Rep BlastOutput2 x -> BlastOutput2
forall x. BlastOutput2 -> Rep BlastOutput2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlastOutput2 x -> BlastOutput2
$cfrom :: forall x. BlastOutput2 -> Rep BlastOutput2 x
Generic)

data BlastReport = BlastReport
  { BlastReport -> Text
_program :: !T.Text,
    BlastReport -> Text
_version :: !T.Text,
    BlastReport -> Text
_reference :: !T.Text,
    BlastReport -> SearchTarget
_search_target :: !SearchTarget,
    BlastReport -> Params
_params :: !Params,
    BlastReport -> BlastJSONResult
_results :: !BlastJSONResult
  }
  deriving (Int -> BlastReport -> ShowS
[BlastReport] -> ShowS
BlastReport -> String
(Int -> BlastReport -> ShowS)
-> (BlastReport -> String)
-> ([BlastReport] -> ShowS)
-> Show BlastReport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlastReport] -> ShowS
$cshowList :: [BlastReport] -> ShowS
show :: BlastReport -> String
$cshow :: BlastReport -> String
showsPrec :: Int -> BlastReport -> ShowS
$cshowsPrec :: Int -> BlastReport -> ShowS
Show, BlastReport -> BlastReport -> Bool
(BlastReport -> BlastReport -> Bool)
-> (BlastReport -> BlastReport -> Bool) -> Eq BlastReport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlastReport -> BlastReport -> Bool
$c/= :: BlastReport -> BlastReport -> Bool
== :: BlastReport -> BlastReport -> Bool
$c== :: BlastReport -> BlastReport -> Bool
Eq, (forall x. BlastReport -> Rep BlastReport x)
-> (forall x. Rep BlastReport x -> BlastReport)
-> Generic BlastReport
forall x. Rep BlastReport x -> BlastReport
forall x. BlastReport -> Rep BlastReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlastReport x -> BlastReport
$cfrom :: forall x. BlastReport -> Rep BlastReport x
Generic)

newtype SearchTarget =  SearchTarget
  {
    SearchTarget -> Text
_db :: T.Text
  }
  deriving (Int -> SearchTarget -> ShowS
[SearchTarget] -> ShowS
SearchTarget -> String
(Int -> SearchTarget -> ShowS)
-> (SearchTarget -> String)
-> ([SearchTarget] -> ShowS)
-> Show SearchTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchTarget] -> ShowS
$cshowList :: [SearchTarget] -> ShowS
show :: SearchTarget -> String
$cshow :: SearchTarget -> String
showsPrec :: Int -> SearchTarget -> ShowS
$cshowsPrec :: Int -> SearchTarget -> ShowS
Show, SearchTarget -> SearchTarget -> Bool
(SearchTarget -> SearchTarget -> Bool)
-> (SearchTarget -> SearchTarget -> Bool) -> Eq SearchTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchTarget -> SearchTarget -> Bool
$c/= :: SearchTarget -> SearchTarget -> Bool
== :: SearchTarget -> SearchTarget -> Bool
$c== :: SearchTarget -> SearchTarget -> Bool
Eq, (forall x. SearchTarget -> Rep SearchTarget x)
-> (forall x. Rep SearchTarget x -> SearchTarget)
-> Generic SearchTarget
forall x. Rep SearchTarget x -> SearchTarget
forall x. SearchTarget -> Rep SearchTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SearchTarget x -> SearchTarget
$cfrom :: forall x. SearchTarget -> Rep SearchTarget x
Generic)

data Params = Params
  {
    Params -> Double
_expect :: !Double,
    Params -> Int
_sc_match :: !Int,
    Params -> Int
_sc_mismatch :: !Int,
    Params -> Int
_gap_open :: !Int,
    Params -> Int
_gap_extend :: !Int,
    Params -> Text
_filter :: !T.Text
  }
  deriving (Int -> Params -> ShowS
[Params] -> ShowS
Params -> String
(Int -> Params -> ShowS)
-> (Params -> String) -> ([Params] -> ShowS) -> Show Params
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Params] -> ShowS
$cshowList :: [Params] -> ShowS
show :: Params -> String
$cshow :: Params -> String
showsPrec :: Int -> Params -> ShowS
$cshowsPrec :: Int -> Params -> ShowS
Show, Params -> Params -> Bool
(Params -> Params -> Bool)
-> (Params -> Params -> Bool) -> Eq Params
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Params -> Params -> Bool
$c/= :: Params -> Params -> Bool
== :: Params -> Params -> Bool
$c== :: Params -> Params -> Bool
Eq, (forall x. Params -> Rep Params x)
-> (forall x. Rep Params x -> Params) -> Generic Params
forall x. Rep Params x -> Params
forall x. Params -> Rep Params x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Params x -> Params
$cfrom :: forall x. Params -> Rep Params x
Generic)

data BlastJSONResult = BlastJSONResult
  {
    BlastJSONResult -> Search
_search :: !Search
  }
  deriving (Int -> BlastJSONResult -> ShowS
[BlastJSONResult] -> ShowS
BlastJSONResult -> String
(Int -> BlastJSONResult -> ShowS)
-> (BlastJSONResult -> String)
-> ([BlastJSONResult] -> ShowS)
-> Show BlastJSONResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlastJSONResult] -> ShowS
$cshowList :: [BlastJSONResult] -> ShowS
show :: BlastJSONResult -> String
$cshow :: BlastJSONResult -> String
showsPrec :: Int -> BlastJSONResult -> ShowS
$cshowsPrec :: Int -> BlastJSONResult -> ShowS
Show, BlastJSONResult -> BlastJSONResult -> Bool
(BlastJSONResult -> BlastJSONResult -> Bool)
-> (BlastJSONResult -> BlastJSONResult -> Bool)
-> Eq BlastJSONResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlastJSONResult -> BlastJSONResult -> Bool
$c/= :: BlastJSONResult -> BlastJSONResult -> Bool
== :: BlastJSONResult -> BlastJSONResult -> Bool
$c== :: BlastJSONResult -> BlastJSONResult -> Bool
Eq, (forall x. BlastJSONResult -> Rep BlastJSONResult x)
-> (forall x. Rep BlastJSONResult x -> BlastJSONResult)
-> Generic BlastJSONResult
forall x. Rep BlastJSONResult x -> BlastJSONResult
forall x. BlastJSONResult -> Rep BlastJSONResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlastJSONResult x -> BlastJSONResult
$cfrom :: forall x. BlastJSONResult -> Rep BlastJSONResult x
Generic)

data Search = Search
  {
    Search -> Text
_query_id :: !T.Text,
    Search -> Text
_query_title :: !T.Text,
    Search -> Int
_query_len :: !Int,
    Search -> Seq Hit
_hits :: DS.Seq Hit,
    Search -> SearchStat
_stat :: !SearchStat
  }
  deriving (Int -> Search -> ShowS
[Search] -> ShowS
Search -> String
(Int -> Search -> ShowS)
-> (Search -> String) -> ([Search] -> ShowS) -> Show Search
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Search] -> ShowS
$cshowList :: [Search] -> ShowS
show :: Search -> String
$cshow :: Search -> String
showsPrec :: Int -> Search -> ShowS
$cshowsPrec :: Int -> Search -> ShowS
Show, Search -> Search -> Bool
(Search -> Search -> Bool)
-> (Search -> Search -> Bool) -> Eq Search
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Search -> Search -> Bool
$c/= :: Search -> Search -> Bool
== :: Search -> Search -> Bool
$c== :: Search -> Search -> Bool
Eq, (forall x. Search -> Rep Search x)
-> (forall x. Rep Search x -> Search) -> Generic Search
forall x. Rep Search x -> Search
forall x. Search -> Rep Search x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Search x -> Search
$cfrom :: forall x. Search -> Rep Search x
Generic)

data Hit = Hit
  {
    Hit -> Int
_num :: !Int,
    Hit -> [HitDescription]
_description :: ![HitDescription],
    Hit -> Int
_len :: !Int,
    Hit -> [Hsp]
_hsps :: ![Hsp]
  }
  deriving (Int -> Hit -> ShowS
[Hit] -> ShowS
Hit -> String
(Int -> Hit -> ShowS)
-> (Hit -> String) -> ([Hit] -> ShowS) -> Show Hit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hit] -> ShowS
$cshowList :: [Hit] -> ShowS
show :: Hit -> String
$cshow :: Hit -> String
showsPrec :: Int -> Hit -> ShowS
$cshowsPrec :: Int -> Hit -> ShowS
Show, Hit -> Hit -> Bool
(Hit -> Hit -> Bool) -> (Hit -> Hit -> Bool) -> Eq Hit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hit -> Hit -> Bool
$c/= :: Hit -> Hit -> Bool
== :: Hit -> Hit -> Bool
$c== :: Hit -> Hit -> Bool
Eq, (forall x. Hit -> Rep Hit x)
-> (forall x. Rep Hit x -> Hit) -> Generic Hit
forall x. Rep Hit x -> Hit
forall x. Hit -> Rep Hit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Hit x -> Hit
$cfrom :: forall x. Hit -> Rep Hit x
Generic)

data Hsp = Hsp
  {
    Hsp -> Int
_hsp_num :: !Int, --actually just num in the output, but duplicate field exits in Hit
    Hsp -> Double
_bit_score :: !Double,
    Hsp -> Int
_score :: !Int,
    Hsp -> Double
_evalue :: !Double,
    Hsp -> Int
_identity :: !Int,
    Hsp -> Int
_query_from :: !Int,
    Hsp -> Int
_query_to :: !Int,
    Hsp -> Text
_query_strand :: !T.Text,
    Hsp -> Int
_hit_from :: !Int,
    Hsp -> Int
_hit_to :: !Int,
    Hsp -> Text
_hit_strand :: !T.Text,
    Hsp -> Int
_align_len :: !Int,
    Hsp -> Int
_gaps :: !Int,
    Hsp -> Text
_qseq :: !T.Text,
    Hsp -> Text
_hseq :: !T.Text,
    Hsp -> Text
_midline :: !T.Text
  }
  deriving (Int -> Hsp -> ShowS
[Hsp] -> ShowS
Hsp -> String
(Int -> Hsp -> ShowS)
-> (Hsp -> String) -> ([Hsp] -> ShowS) -> Show Hsp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hsp] -> ShowS
$cshowList :: [Hsp] -> ShowS
show :: Hsp -> String
$cshow :: Hsp -> String
showsPrec :: Int -> Hsp -> ShowS
$cshowsPrec :: Int -> Hsp -> ShowS
Show, Hsp -> Hsp -> Bool
(Hsp -> Hsp -> Bool) -> (Hsp -> Hsp -> Bool) -> Eq Hsp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hsp -> Hsp -> Bool
$c/= :: Hsp -> Hsp -> Bool
== :: Hsp -> Hsp -> Bool
$c== :: Hsp -> Hsp -> Bool
Eq, (forall x. Hsp -> Rep Hsp x)
-> (forall x. Rep Hsp x -> Hsp) -> Generic Hsp
forall x. Rep Hsp x -> Hsp
forall x. Hsp -> Rep Hsp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Hsp x -> Hsp
$cfrom :: forall x. Hsp -> Rep Hsp x
Generic, [Hsp] -> Encoding
[Hsp] -> Value
Hsp -> Encoding
Hsp -> Value
(Hsp -> Value)
-> (Hsp -> Encoding)
-> ([Hsp] -> Value)
-> ([Hsp] -> Encoding)
-> ToJSON Hsp
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Hsp] -> Encoding
$ctoEncodingList :: [Hsp] -> Encoding
toJSONList :: [Hsp] -> Value
$ctoJSONList :: [Hsp] -> Value
toEncoding :: Hsp -> Encoding
$ctoEncoding :: Hsp -> Encoding
toJSON :: Hsp -> Value
$ctoJSON :: Hsp -> Value
ToJSON)

instance FromJSON Hsp where
 parseJSON :: Value -> Parser Hsp
parseJSON (Object Object
v) =
    Int
-> Double
-> Int
-> Double
-> Int
-> Int
-> Int
-> Text
-> Int
-> Int
-> Text
-> Int
-> Int
-> Text
-> Text
-> Text
-> Hsp
Hsp (Int
 -> Double
 -> Int
 -> Double
 -> Int
 -> Int
 -> Int
 -> Text
 -> Int
 -> Int
 -> Text
 -> Int
 -> Int
 -> Text
 -> Text
 -> Text
 -> Hsp)
-> Parser Int
-> Parser
     (Double
      -> Int
      -> Double
      -> Int
      -> Int
      -> Int
      -> Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> Text
      -> Hsp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"num"
        Parser
  (Double
   -> Int
   -> Double
   -> Int
   -> Int
   -> Int
   -> Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> Text
   -> Hsp)
-> Parser Double
-> Parser
     (Int
      -> Double
      -> Int
      -> Int
      -> Int
      -> Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> Text
      -> Hsp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"bit_score"
        Parser
  (Int
   -> Double
   -> Int
   -> Int
   -> Int
   -> Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> Text
   -> Hsp)
-> Parser Int
-> Parser
     (Double
      -> Int
      -> Int
      -> Int
      -> Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> Text
      -> Hsp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"score"
        Parser
  (Double
   -> Int
   -> Int
   -> Int
   -> Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> Text
   -> Hsp)
-> Parser Double
-> Parser
     (Int
      -> Int
      -> Int
      -> Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> Text
      -> Hsp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"evalue"
        Parser
  (Int
   -> Int
   -> Int
   -> Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> Text
   -> Hsp)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> Text
      -> Hsp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"identity"
        Parser
  (Int
   -> Int
   -> Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> Text
   -> Hsp)
-> Parser Int
-> Parser
     (Int
      -> Text
      -> Int
      -> Int
      -> Text
      -> Int
      -> Int
      -> Text
      -> Text
      -> Text
      -> Hsp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"query_from"
        Parser
  (Int
   -> Text
   -> Int
   -> Int
   -> Text
   -> Int
   -> Int
   -> Text
   -> Text
   -> Text
   -> Hsp)
-> Parser Int
-> Parser
     (Text
      -> Int -> Int -> Text -> Int -> Int -> Text -> Text -> Text -> Hsp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"query_to"
        Parser
  (Text
   -> Int -> Int -> Text -> Int -> Int -> Text -> Text -> Text -> Hsp)
-> Parser Text
-> Parser
     (Int -> Int -> Text -> Int -> Int -> Text -> Text -> Text -> Hsp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"query_strand"
        Parser
  (Int -> Int -> Text -> Int -> Int -> Text -> Text -> Text -> Hsp)
-> Parser Int
-> Parser
     (Int -> Text -> Int -> Int -> Text -> Text -> Text -> Hsp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"hit_from"
        Parser (Int -> Text -> Int -> Int -> Text -> Text -> Text -> Hsp)
-> Parser Int
-> Parser (Text -> Int -> Int -> Text -> Text -> Text -> Hsp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"hit_to"
        Parser (Text -> Int -> Int -> Text -> Text -> Text -> Hsp)
-> Parser Text
-> Parser (Int -> Int -> Text -> Text -> Text -> Hsp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"hit_strand"
        Parser (Int -> Int -> Text -> Text -> Text -> Hsp)
-> Parser Int -> Parser (Int -> Text -> Text -> Text -> Hsp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"align_len"
        Parser (Int -> Text -> Text -> Text -> Hsp)
-> Parser Int -> Parser (Text -> Text -> Text -> Hsp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"gaps"
        Parser (Text -> Text -> Text -> Hsp)
-> Parser Text -> Parser (Text -> Text -> Hsp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"qseq"
        Parser (Text -> Text -> Hsp) -> Parser Text -> Parser (Text -> Hsp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"hseq"
        Parser (Text -> Hsp) -> Parser Text -> Parser Hsp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"midline"
 parseJSON Value
_ = Parser Hsp
forall (m :: * -> *) a. MonadPlus m => m a
mzero


data HitDescription = HitDescription
  {
    HitDescription -> Text
_id :: !T.Text,
    HitDescription -> Text
_accession :: !T.Text,
    HitDescription -> Text
_title :: !T.Text,
    HitDescription -> Maybe Int
_taxid :: Maybe Int
    --_sciname :: !T.Text
  }
  deriving (Int -> HitDescription -> ShowS
[HitDescription] -> ShowS
HitDescription -> String
(Int -> HitDescription -> ShowS)
-> (HitDescription -> String)
-> ([HitDescription] -> ShowS)
-> Show HitDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HitDescription] -> ShowS
$cshowList :: [HitDescription] -> ShowS
show :: HitDescription -> String
$cshow :: HitDescription -> String
showsPrec :: Int -> HitDescription -> ShowS
$cshowsPrec :: Int -> HitDescription -> ShowS
Show, HitDescription -> HitDescription -> Bool
(HitDescription -> HitDescription -> Bool)
-> (HitDescription -> HitDescription -> Bool) -> Eq HitDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HitDescription -> HitDescription -> Bool
$c/= :: HitDescription -> HitDescription -> Bool
== :: HitDescription -> HitDescription -> Bool
$c== :: HitDescription -> HitDescription -> Bool
Eq, (forall x. HitDescription -> Rep HitDescription x)
-> (forall x. Rep HitDescription x -> HitDescription)
-> Generic HitDescription
forall x. Rep HitDescription x -> HitDescription
forall x. HitDescription -> Rep HitDescription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HitDescription x -> HitDescription
$cfrom :: forall x. HitDescription -> Rep HitDescription x
Generic)

data SearchStat = SearchStat {
    SearchStat -> Int
_db_num :: !Int,
    SearchStat -> Int
_db_len :: !Int,
    SearchStat -> Int
_hsp_len :: !Int,
    SearchStat -> Int
_eff_space :: !Int,
    SearchStat -> Double
_kappa :: !Double,
    SearchStat -> Double
_lambda :: !Double,
    SearchStat -> Double
_entropy :: !Double
  }
  deriving (Int -> SearchStat -> ShowS
[SearchStat] -> ShowS
SearchStat -> String
(Int -> SearchStat -> ShowS)
-> (SearchStat -> String)
-> ([SearchStat] -> ShowS)
-> Show SearchStat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchStat] -> ShowS
$cshowList :: [SearchStat] -> ShowS
show :: SearchStat -> String
$cshow :: SearchStat -> String
showsPrec :: Int -> SearchStat -> ShowS
$cshowsPrec :: Int -> SearchStat -> ShowS
Show, SearchStat -> SearchStat -> Bool
(SearchStat -> SearchStat -> Bool)
-> (SearchStat -> SearchStat -> Bool) -> Eq SearchStat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchStat -> SearchStat -> Bool
$c/= :: SearchStat -> SearchStat -> Bool
== :: SearchStat -> SearchStat -> Bool
$c== :: SearchStat -> SearchStat -> Bool
Eq, (forall x. SearchStat -> Rep SearchStat x)
-> (forall x. Rep SearchStat x -> SearchStat) -> Generic SearchStat
forall x. Rep SearchStat x -> SearchStat
forall x. SearchStat -> Rep SearchStat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SearchStat x -> SearchStat
$cfrom :: forall x. SearchStat -> Rep SearchStat x
Generic)

data BlastTabularResult = BlastTabularResult
  { BlastTabularResult -> BlastProgram
_blastProgram :: !BlastProgram,
    BlastTabularResult -> ByteString
_blastQueryId :: !B.ByteString,
--    blastQueryName :: !B.ByteString,
    BlastTabularResult -> ByteString
_blastDatabase :: !B.ByteString,
    BlastTabularResult -> Int
_blastHitNumber :: !Int,
    BlastTabularResult -> Vector BlastTabularHit
_hitLines :: !(V.Vector BlastTabularHit)
  }
  deriving (Int -> BlastTabularResult -> ShowS
[BlastTabularResult] -> ShowS
BlastTabularResult -> String
(Int -> BlastTabularResult -> ShowS)
-> (BlastTabularResult -> String)
-> ([BlastTabularResult] -> ShowS)
-> Show BlastTabularResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlastTabularResult] -> ShowS
$cshowList :: [BlastTabularResult] -> ShowS
show :: BlastTabularResult -> String
$cshow :: BlastTabularResult -> String
showsPrec :: Int -> BlastTabularResult -> ShowS
$cshowsPrec :: Int -> BlastTabularResult -> ShowS
Show, BlastTabularResult -> BlastTabularResult -> Bool
(BlastTabularResult -> BlastTabularResult -> Bool)
-> (BlastTabularResult -> BlastTabularResult -> Bool)
-> Eq BlastTabularResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlastTabularResult -> BlastTabularResult -> Bool
$c/= :: BlastTabularResult -> BlastTabularResult -> Bool
== :: BlastTabularResult -> BlastTabularResult -> Bool
$c== :: BlastTabularResult -> BlastTabularResult -> Bool
Eq)

data BlastTabularHit = BlastTabularHit
  { BlastTabularHit -> ByteString
_queryId :: !B.ByteString,
    BlastTabularHit -> ByteString
_subjectId ::  !B.ByteString,
    BlastTabularHit -> Double
_seqIdentity :: !Double,
    BlastTabularHit -> Int
_alignmentLength :: !Int,
    BlastTabularHit -> Int
_misMatches :: !Int,
    BlastTabularHit -> Int
_gapOpenScore :: !Int,
    BlastTabularHit -> Int
_queryStart :: !Int,
    BlastTabularHit -> Int
_queryEnd :: !Int,
    BlastTabularHit -> Int
_hitSeqStart :: !Int,
    BlastTabularHit -> Int
_hitSeqEnd :: !Int,
    BlastTabularHit -> Double
_eValue :: !Double,
    BlastTabularHit -> Double
_bitScore :: !Double,
    BlastTabularHit -> Int
_subjectFrame :: !Int,
    BlastTabularHit -> ByteString
_querySeq  :: !B.ByteString,
    BlastTabularHit -> ByteString
_subjectSeq  :: !B.ByteString
  }
  deriving (Int -> BlastTabularHit -> ShowS
[BlastTabularHit] -> ShowS
BlastTabularHit -> String
(Int -> BlastTabularHit -> ShowS)
-> (BlastTabularHit -> String)
-> ([BlastTabularHit] -> ShowS)
-> Show BlastTabularHit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlastTabularHit] -> ShowS
$cshowList :: [BlastTabularHit] -> ShowS
show :: BlastTabularHit -> String
$cshow :: BlastTabularHit -> String
showsPrec :: Int -> BlastTabularHit -> ShowS
$cshowsPrec :: Int -> BlastTabularHit -> ShowS
Show, BlastTabularHit -> BlastTabularHit -> Bool
(BlastTabularHit -> BlastTabularHit -> Bool)
-> (BlastTabularHit -> BlastTabularHit -> Bool)
-> Eq BlastTabularHit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlastTabularHit -> BlastTabularHit -> Bool
$c/= :: BlastTabularHit -> BlastTabularHit -> Bool
== :: BlastTabularHit -> BlastTabularHit -> Bool
$c== :: BlastTabularHit -> BlastTabularHit -> Bool
Eq)

data BlastProgram = BlastX | BlastP | BlastN
  deriving (Int -> BlastProgram -> ShowS
[BlastProgram] -> ShowS
BlastProgram -> String
(Int -> BlastProgram -> ShowS)
-> (BlastProgram -> String)
-> ([BlastProgram] -> ShowS)
-> Show BlastProgram
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlastProgram] -> ShowS
$cshowList :: [BlastProgram] -> ShowS
show :: BlastProgram -> String
$cshow :: BlastProgram -> String
showsPrec :: Int -> BlastProgram -> ShowS
$cshowsPrec :: Int -> BlastProgram -> ShowS
Show, BlastProgram -> BlastProgram -> Bool
(BlastProgram -> BlastProgram -> Bool)
-> (BlastProgram -> BlastProgram -> Bool) -> Eq BlastProgram
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlastProgram -> BlastProgram -> Bool
$c/= :: BlastProgram -> BlastProgram -> Bool
== :: BlastProgram -> BlastProgram -> Bool
$c== :: BlastProgram -> BlastProgram -> Bool
Eq)

makeLenses ''BlastTabularResult
makeLenses ''BlastTabularHit
makeLenses ''SearchTarget
deriveJSON defaultOptions{fieldLabelModifier = drop 1} ''SearchTarget
makeLenses ''BlastProgram
deriveJSON defaultOptions{fieldLabelModifier = drop 1} ''BlastProgram
makeLenses ''SearchStat
deriveJSON defaultOptions{fieldLabelModifier = drop 1} ''SearchStat
makeLenses ''HitDescription
deriveJSON defaultOptions{fieldLabelModifier = drop 1} ''HitDescription
makeLenses ''Hit
deriveJSON defaultOptions{fieldLabelModifier = drop 1} ''Hit
makeLenses ''Hsp
makeLenses ''Search
deriveJSON defaultOptions{fieldLabelModifier = drop 1} ''Search
makeLenses ''BlastJSONResult
deriveJSON defaultOptions{fieldLabelModifier = drop 1} ''BlastJSONResult
makeLenses ''Params
deriveJSON defaultOptions{fieldLabelModifier = drop 1} ''Params
makeLenses ''BlastReport
deriveJSON defaultOptions{fieldLabelModifier = drop 1} ''BlastReport
makeLenses ''BlastOutput2
deriveJSON defaultOptions{fieldLabelModifier = drop 1} ''BlastOutput2
makeLenses ''BlastCmdJSON2
--deriveJSON defaultOptions{fieldLabelModifier = (map toLower) . drop 1} ''BlastJSON2
instance FromJSON BlastCmdJSON2 where
  parseJSON :: Value -> Parser BlastCmdJSON2
parseJSON (Object Object
v) = [BlastOutput2] -> BlastCmdJSON2
BlastCmdJSON2 ([BlastOutput2] -> BlastCmdJSON2)
-> Parser [BlastOutput2] -> Parser BlastCmdJSON2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser [BlastOutput2]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"BlastOutput2")
  parseJSON Value
_ = Parser BlastCmdJSON2
forall (m :: * -> *) a. MonadPlus m => m a
mzero
instance ToJSON BlastCmdJSON2 where
  toJSON :: BlastCmdJSON2 -> Value
toJSON (BlastCmdJSON2 [BlastOutput2]
_blastoutput2) =
        [(Text, Value)] -> Value
object [ Text
"BlastOutput2" Text -> [BlastOutput2] -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [BlastOutput2]
_blastoutput2 ]

makeLenses ''BlastJSON2
--deriveJSON defaultOptions{fieldLabelModifier = (map toLower) . drop 1} ''BlastJSON2
instance FromJSON BlastJSON2 where
  parseJSON :: Value -> Parser BlastJSON2
parseJSON (Object Object
v) = BlastOutput2 -> BlastJSON2
BlastJSON2 (BlastOutput2 -> BlastJSON2)
-> Parser BlastOutput2 -> Parser BlastJSON2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser BlastOutput2
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"BlastOutput2")
  parseJSON Value
_ = Parser BlastJSON2
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance ToJSON BlastJSON2 where
  toJSON :: BlastJSON2 -> Value
toJSON (BlastJSON2 BlastOutput2
_blastoutput2) = [(Text, Value)] -> Value
object [ Text
"BlastOutput2"  Text -> BlastOutput2 -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlastOutput2
_blastoutput2 ]