module Math.OEIS.Types where

import qualified Data.Text as T

type SeqData = [Integer]
type Texts = [T.Text]

data SearchStatus = ID          T.Text
                  | SubSeq      SeqData
                  | Signed      T.Text
                  | Name        T.Text
                  | Comment     T.Text
                  | Ref         T.Text
                  | Link        T.Text
                  | Formula     T.Text
                  | Example     T.Text
                  | Maple       T.Text
                  | Mathematica T.Text
                  | Offset      T.Text
                  | Program     T.Text
                  | XRef        T.Text
                  | KeyWord     T.Text
                  | Author      T.Text
                  | Extension   T.Text
                  | Others      T.Text
  deriving (Int -> SearchStatus -> ShowS
[SearchStatus] -> ShowS
SearchStatus -> String
(Int -> SearchStatus -> ShowS)
-> (SearchStatus -> String)
-> ([SearchStatus] -> ShowS)
-> Show SearchStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchStatus] -> ShowS
$cshowList :: [SearchStatus] -> ShowS
show :: SearchStatus -> String
$cshow :: SearchStatus -> String
showsPrec :: Int -> SearchStatus -> ShowS
$cshowsPrec :: Int -> SearchStatus -> ShowS
Show, SearchStatus -> SearchStatus -> Bool
(SearchStatus -> SearchStatus -> Bool)
-> (SearchStatus -> SearchStatus -> Bool) -> Eq SearchStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchStatus -> SearchStatus -> Bool
$c/= :: SearchStatus -> SearchStatus -> Bool
== :: SearchStatus -> SearchStatus -> Bool
$c== :: SearchStatus -> SearchStatus -> Bool
Eq)

--data Language = Haskell | PARI | L T.Text deriving (Show, Eq)
type Language = T.Text
type Program = (Language, [T.Text])

data Keyword = Base | Bref | Changed | Cofr | Cons | Core | Dead | Dumb |
               Dupe | Easy | Eigen   | Fini | Frac | Full | Hard | More |
               Mult | New  | Nice    | Nonn | Obsc | Sign | Tabf | Tabl |
               Uned | Unkn | Walk    | Word | Look | Other
  deriving (Keyword -> Keyword -> Bool
(Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Bool) -> Eq Keyword
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Keyword -> Keyword -> Bool
$c/= :: Keyword -> Keyword -> Bool
== :: Keyword -> Keyword -> Bool
$c== :: Keyword -> Keyword -> Bool
Eq, Int -> Keyword -> ShowS
[Keyword] -> ShowS
Keyword -> String
(Int -> Keyword -> ShowS)
-> (Keyword -> String) -> ([Keyword] -> ShowS) -> Show Keyword
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Keyword] -> ShowS
$cshowList :: [Keyword] -> ShowS
show :: Keyword -> String
$cshow :: Keyword -> String
showsPrec :: Int -> Keyword -> ShowS
$cshowsPrec :: Int -> Keyword -> ShowS
Show, ReadPrec [Keyword]
ReadPrec Keyword
Int -> ReadS Keyword
ReadS [Keyword]
(Int -> ReadS Keyword)
-> ReadS [Keyword]
-> ReadPrec Keyword
-> ReadPrec [Keyword]
-> Read Keyword
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Keyword]
$creadListPrec :: ReadPrec [Keyword]
readPrec :: ReadPrec Keyword
$creadPrec :: ReadPrec Keyword
readList :: ReadS [Keyword]
$creadList :: ReadS [Keyword]
readsPrec :: Int -> ReadS Keyword
$creadsPrec :: Int -> ReadS Keyword
Read)

data OEISData = INT Integer
              | SEQ SeqData
              | TXT T.Text
              | TXTS Texts
              | KEYS [Keyword]
              | PRGS [Program]
  deriving (Int -> OEISData -> ShowS
[OEISData] -> ShowS
OEISData -> String
(Int -> OEISData -> ShowS)
-> (OEISData -> String) -> ([OEISData] -> ShowS) -> Show OEISData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OEISData] -> ShowS
$cshowList :: [OEISData] -> ShowS
show :: OEISData -> String
$cshow :: OEISData -> String
showsPrec :: Int -> OEISData -> ShowS
$cshowsPrec :: Int -> OEISData -> ShowS
Show)

data OEISSeq = OEIS { OEISSeq -> Text
number      :: T.Text,
                      OEISSeq -> Texts
ids         :: Texts,
                      OEISSeq -> SeqData
seqData     :: SeqData,
                      OEISSeq -> Text
name        :: T.Text,
                      OEISSeq -> Texts
comment     :: Texts,
                      OEISSeq -> Texts
reference   :: Texts,
                      OEISSeq -> Texts
link        :: Texts,
                      OEISSeq -> Texts
formula     :: Texts,
                      OEISSeq -> Texts
example     :: Texts,
                      OEISSeq -> Texts
maple       :: Texts,
                      OEISSeq -> Texts
mathematica :: Texts,
                      OEISSeq -> [Program]
program     :: [Program],
                      OEISSeq -> Texts
xref        :: Texts,
                      OEISSeq -> [Keyword]
keyword     :: [Keyword],
                      OEISSeq -> Integer
offset      :: Integer,
                      OEISSeq -> Text
author      :: T.Text,
                      OEISSeq -> Texts
ext         :: Texts,
                      OEISSeq -> Integer
references  :: Integer,
                      OEISSeq -> Integer
revision    :: Integer,
                      OEISSeq -> Text
time        :: T.Text,
                      OEISSeq -> Text
created     :: T.Text
                    }
  deriving (Int -> OEISSeq -> ShowS
[OEISSeq] -> ShowS
OEISSeq -> String
(Int -> OEISSeq -> ShowS)
-> (OEISSeq -> String) -> ([OEISSeq] -> ShowS) -> Show OEISSeq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OEISSeq] -> ShowS
$cshowList :: [OEISSeq] -> ShowS
show :: OEISSeq -> String
$cshow :: OEISSeq -> String
showsPrec :: Int -> OEISSeq -> ShowS
$cshowsPrec :: Int -> OEISSeq -> ShowS
Show, OEISSeq -> OEISSeq -> Bool
(OEISSeq -> OEISSeq -> Bool)
-> (OEISSeq -> OEISSeq -> Bool) -> Eq OEISSeq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OEISSeq -> OEISSeq -> Bool
$c/= :: OEISSeq -> OEISSeq -> Bool
== :: OEISSeq -> OEISSeq -> Bool
$c== :: OEISSeq -> OEISSeq -> Bool
Eq, ReadPrec [OEISSeq]
ReadPrec OEISSeq
Int -> ReadS OEISSeq
ReadS [OEISSeq]
(Int -> ReadS OEISSeq)
-> ReadS [OEISSeq]
-> ReadPrec OEISSeq
-> ReadPrec [OEISSeq]
-> Read OEISSeq
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OEISSeq]
$creadListPrec :: ReadPrec [OEISSeq]
readPrec :: ReadPrec OEISSeq
$creadPrec :: ReadPrec OEISSeq
readList :: ReadS [OEISSeq]
$creadList :: ReadS [OEISSeq]
readsPrec :: Int -> ReadS OEISSeq
$creadsPrec :: Int -> ReadS OEISSeq
Read)