module Math.OEIS.Types where

type SequenceData = [Integer]

-- | Programming language that some code to generate the sequence is written
-- in. The only languages indicated natively by the OEIS database are
-- Mathematica and Maple; any other languages will be listed (usually in
-- parentheses) at the beginning of the actual code snippet.
data Language = Mathematica | Maple | Other deriving (Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
(Int -> Language -> ShowS)
-> (Language -> String) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Language -> ShowS
showsPrec :: Int -> Language -> ShowS
$cshow :: Language -> String
show :: Language -> String
$cshowList :: [Language] -> ShowS
showList :: [Language] -> ShowS
Show, Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
/= :: Language -> Language -> Bool
Eq)

-- | OEIS keywords. For more information on the meaning of each keyword, see
-- <http://oeis.org/eishelp2.html#RK>.
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
       deriving (Keyword -> Keyword -> Bool
(Keyword -> Keyword -> Bool)
-> (Keyword -> Keyword -> Bool) -> Eq Keyword
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Keyword -> Keyword -> Bool
== :: Keyword -> Keyword -> Bool
$c/= :: Keyword -> Keyword -> Bool
/= :: 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
$cshowsPrec :: Int -> Keyword -> ShowS
showsPrec :: Int -> Keyword -> ShowS
$cshow :: Keyword -> String
show :: Keyword -> String
$cshowList :: [Keyword] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS Keyword
readsPrec :: Int -> ReadS Keyword
$creadList :: ReadS [Keyword]
readList :: ReadS [Keyword]
$creadPrec :: ReadPrec Keyword
readPrec :: ReadPrec Keyword
$creadListPrec :: ReadPrec [Keyword]
readListPrec :: ReadPrec [Keyword]
Read)

-- | Data structure for storing an OEIS entry. For more information on the
-- various components, see <http://oeis.org/eishelp2.html>.
data OEISSequence =
  OEIS { OEISSequence -> [String]
catalogNums  :: [String],
         -- ^ Catalog number(s), e.g. A000040, N1425. (%I)
         OEISSequence -> SequenceData
sequenceData :: SequenceData,
         -- ^ The actual sequence data (or absolute values of the sequence data in the case of signed sequences).  (%S,T,U)
         OEISSequence -> SequenceData
signedData   :: SequenceData,
         -- ^ Signed sequence data (empty for sequences with all positive entries).  (%V,W,X)
         OEISSequence -> String
description  :: String,
         -- ^ Short description of the sequence. (%N)
         OEISSequence -> [String]
references   :: [String],
         -- ^ List of academic references. (%D)
         OEISSequence -> [String]
links        :: [String],
         -- ^ List of links to more information on the web. (%H)
         OEISSequence -> [String]
formulas     :: [String],
         -- ^ Formulas or equations involving the sequence. (%F)
         OEISSequence -> [String]
xrefs        :: [String],
         -- ^ Cross-references to other sequences. (%Y)
         OEISSequence -> String
author       :: String,
         -- ^ Author who input the sequence into the database. (%A)
         OEISSequence -> Int
offset       :: Int,
         -- ^ Subscript\/index of the first term. (%O)
         OEISSequence -> Int
firstGT1     :: Int,
         -- ^ Index of the first term \> 1.  (%O)
         OEISSequence -> [(Language, String)]
programs     :: [(Language,String)],
         -- ^ Code that can be used to generate the sequence. (%p,t,o)
         OEISSequence -> [String]
extensions   :: [String],
         -- ^ Corrections, extensions, or edits. (%E)
         OEISSequence -> [String]
examples     :: [String],
         -- ^ Examples. (%e)
         OEISSequence -> [Keyword]
keywords     :: [Keyword],
         -- ^ Keywords. (%K)
         OEISSequence -> [String]
comments     :: [String]
         -- ^ Comments. (%C)
       } deriving Int -> OEISSequence -> ShowS
[OEISSequence] -> ShowS
OEISSequence -> String
(Int -> OEISSequence -> ShowS)
-> (OEISSequence -> String)
-> ([OEISSequence] -> ShowS)
-> Show OEISSequence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OEISSequence -> ShowS
showsPrec :: Int -> OEISSequence -> ShowS
$cshow :: OEISSequence -> String
show :: OEISSequence -> String
$cshowList :: [OEISSequence] -> ShowS
showList :: [OEISSequence] -> ShowS
Show