{-# LANGUAGE OverloadedLists   #-}
{-# LANGUAGE OverloadedStrings #-}

module Math.OEIS.Internal where

import           Control.Lens        ((^?), (^?!))
import           Control.Monad       (when)
import           Data.Aeson.Lens
import           Data.Aeson.Types
import           Data.Char
import           Data.Functor
import           Data.List
import           Data.Maybe          (fromJust, fromMaybe, isNothing)
import qualified Data.Text           as T
import qualified Data.Text.Encoding  as T
import qualified Data.Text.IO        as T
import qualified Data.Vector         as V
import           Network.HTTP.Simple (getResponseBody, httpBS, parseRequest)
import           System.IO.Unsafe    (unsafePerformIO)

import           Math.OEIS.Types


---------------
-- JSON Keys --
---------------
intKeys :: [Text]
intKeys = [
  Item [Text]
"number", Item [Text]
"references", Item [Text]
"revision"
  ]
textKeys :: [Text]
textKeys = [
  Item [Text]
"id", Item [Text]
"data", Item [Text]
"name", Item [Text]
"keyword", Item [Text]
"offset", Item [Text]
"author", Item [Text]
"time", Item [Text]
"created"
  ]
textsKeys :: [Text]
textsKeys = [
  Item [Text]
"comment", Item [Text]
"reference", Item [Text]
"link", Item [Text]
"formula", Item [Text]
"example", Item [Text]
"maple", Item [Text]
"mathematica",
  Item [Text]
"program", Item [Text]
"xref", Item [Text]
"ext"
  ]
keys :: [Text]
keys = [Text]
intKeys [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
textKeys [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
textsKeys :: Texts


----------------
-- Text utils --
----------------
+.+ :: Text -> Text -> Text
(+.+) = Text -> Text -> Text
T.append
.+ :: Char -> Text -> Text
(.+)  = Char -> Text -> Text
T.cons
+. :: Text -> Char -> Text
(+.)  = Text -> Char -> Text
T.snoc


----------------------
-- Get JSON of OEIS --
----------------------
showSeqData :: SeqData -> T.Text
showSeqData :: SeqData -> Text
showSeqData = String -> Text
T.pack (String -> Text) -> (SeqData -> String) -> SeqData -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
tail (String -> String) -> (SeqData -> String) -> SeqData -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
init (String -> String) -> (SeqData -> String) -> SeqData -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeqData -> String
forall a. Show a => a -> String
show

readSeqData :: String -> SeqData
readSeqData :: String -> SeqData
readSeqData String
str = case ReadS SeqData
forall a. Read a => ReadS a
reads (String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]") of
                    [(sd, "")] -> SeqData
sd
                    [(SeqData, String)]
_          -> []

baseSearchURI :: T.Text
baseSearchURI :: Text
baseSearchURI = Text
"https://oeis.org/search?fmt=json&q="

addPrefix :: SearchStatus -> T.Text
addPrefix :: SearchStatus -> Text
addPrefix (SubSeq SeqData
ints) = Text
"seq:" Text -> Text -> Text
+.+ SeqData -> Text
showSeqData SeqData
ints
addPrefix SearchStatus
ss            = let (Text
cst, Text
txt) = Text -> Text -> (Text, Text)
T.breakOn Text
" " (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SearchStatus -> String
forall a. Show a => a -> String
show SearchStatus
ss
                              pref :: Text
pref       = Text -> Text
T.toLower Text
cst Text -> Text -> Text
+.+ Text
":"
                              txt' :: Text
txt'       = Text -> Text
T.init (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.tail (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
txt
                          in Text
pref Text -> Text -> Text
+.+ Text
txt'

searchURI :: SearchStatus -> T.Text
searchURI :: SearchStatus -> Text
searchURI SearchStatus
ss = Text
baseSearchURI Text -> Text -> Text
+.+ SearchStatus -> Text
addPrefix SearchStatus
ss

openURL :: T.Text -> IO T.Text
openURL :: Text -> IO Text
openURL Text
x = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (Response ByteString -> ByteString)
-> Response ByteString
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> ByteString
forall a. Response a -> a
getResponseBody (Response ByteString -> Text)
-> IO (Response ByteString) -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpBS (Request -> IO (Response ByteString))
-> IO Request -> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (Text -> String
T.unpack Text
x))

getJSON :: SearchStatus -> Int -> IO T.Text
getJSON :: SearchStatus -> Int -> IO Text
getJSON (Others Text
txt) Int
_ = Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
txt -- for test
getJSON SearchStatus
ss Int
n           = Text -> IO Text
openURL (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ SearchStatus -> Text
searchURI SearchStatus
ss Text -> Text -> Text
+.+ Text
"&start=" Text -> Text -> Text
+.+ String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n)


----------------
-- Parse JSON --
----------------
-- Get all search results --
getResults :: SearchStatus -> Int -> Int -> V.Vector Value -> IO (V.Vector Value)
getResults :: SearchStatus -> Int -> Int -> Vector Value -> IO (Vector Value)
getResults SearchStatus
ss Int
start Int
bound Vector Value
vs = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
bound Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Upper-bound number of search results mast be non-negative."
  Text
jsn <- SearchStatus -> Int -> IO Text
getJSON SearchStatus
ss Int
start
  let results' :: Maybe (Vector Value)
results' = Text
jsn Text
-> Getting (First (Vector Value)) Text (Vector Value)
-> Maybe (Vector Value)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Text Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"results" ((Value -> Const (First (Vector Value)) Value)
 -> Text -> Const (First (Vector Value)) Text)
-> ((Vector Value -> Const (First (Vector Value)) (Vector Value))
    -> Value -> Const (First (Vector Value)) Value)
-> Getting (First (Vector Value)) Text (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (First (Vector Value)) (Vector Value))
-> Value -> Const (First (Vector Value)) Value
forall t. AsValue t => Prism' t (Vector Value)
_Array
      results :: IO (Vector Value)
results = case Maybe (Vector Value)
results' of
        Maybe (Vector Value)
Nothing  -> Vector Value -> IO (Vector Value)
forall (m :: * -> *) a. Monad m => a -> m a
return []
        Just Vector Value
vs' ->
          let len :: Int
len    = Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
vs'
              start' :: Int
start' = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10
              diff :: Int
diff   = case Int
bound of
                         Int
0 -> Int
len
                         Int
_ -> Int
bound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
          in case SearchStatus
ss of
               ID Text
_     -> Vector Value -> IO (Vector Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Value
vs'
               Others Text
_ -> Vector Value -> IO (Vector Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Value
vs'
               SearchStatus
_ ->
                if Int
bound Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
&& Int
diff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
10 Bool -> Bool -> Bool
|| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
10 then
                  Vector Value -> IO (Vector Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Value -> IO (Vector Value))
-> Vector Value -> IO (Vector Value)
forall a b. (a -> b) -> a -> b
$ Vector Value
vs Vector Value -> Vector Value -> Vector Value
forall a. Vector a -> Vector a -> Vector a
V.++ Int -> Vector Value -> Vector Value
forall a. Int -> Vector a -> Vector a
V.take Int
diff Vector Value
vs'
                else
                  SearchStatus -> Int -> Int -> Vector Value -> IO (Vector Value)
getResults SearchStatus
ss Int
start' Int
bound (Vector Value -> IO (Vector Value))
-> Vector Value -> IO (Vector Value)
forall a b. (a -> b) -> a -> b
$ Vector Value
vs Vector Value -> Vector Value -> Vector Value
forall a. Vector a -> Vector a -> Vector a
V.++ Vector Value
vs'
  IO (Vector Value)
results

-- Get nth search result --
getResult :: SearchStatus -> Int -> IO (Maybe Value)
getResult :: SearchStatus -> Int -> IO (Maybe Value)
getResult SearchStatus
ss Int
n = do
  Vector Value
results <- SearchStatus -> Int -> Int -> Vector Value -> IO (Vector Value)
getResults SearchStatus
ss Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) []
  let result :: Maybe Value
result = Vector Value
results Vector Value -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
V.!? Int
n
  Maybe Value -> IO (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Value
result

-- Get each data in result --
getData :: Value -> T.Text -> (T.Text, Maybe OEISData)
getData :: Value -> Text -> (Text, Maybe OEISData)
getData Value
result Text
k
  | Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
intKeys   = Value -> Text -> (Text, Maybe OEISData)
getIntData Value
result Text
k
  | Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
textKeys  = Value -> Text -> (Text, Maybe OEISData)
getTextData Value
result Text
k
  | Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
textsKeys = Value -> Text -> (Text, Maybe OEISData)
getTextsData Value
result Text
k
  | Bool
otherwise          = (Text
k, Maybe OEISData
forall a. Maybe a
Nothing)

getIntData :: Value -> T.Text -> (T.Text, Maybe OEISData)
getIntData :: Value -> Text -> (Text, Maybe OEISData)
getIntData Value
result Text
k
  = let d :: Maybe Integer
d = Value
result Value -> Getting (First Integer) Value Integer -> Maybe Integer
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
k ((Value -> Const (First Integer) Value)
 -> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting (First Integer) Value Integer
forall t. AsNumber t => Prism' t Integer
_Integer
    in case Maybe Integer
d of
      Maybe Integer
Nothing -> (Text
k, Maybe OEISData
forall a. Maybe a
Nothing)
      Maybe Integer
_       ->
        case Text
k of
          Text
"number" -> let d' :: Text
d'  = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ Maybe Integer -> Integer
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Integer
d
                          len :: Int
len = Text -> Int
T.length Text
d'
                      in (Text
k, OEISData -> Maybe OEISData
forall a. a -> Maybe a
Just (OEISData -> Maybe OEISData) -> OEISData -> Maybe OEISData
forall a b. (a -> b) -> a -> b
$ Text -> OEISData
TXT (Text -> OEISData) -> Text -> OEISData
forall a b. (a -> b) -> a -> b
$ Char
'A' Char -> Text -> Text
.+ Int -> Text -> Text
T.replicate (Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Text
"0" Text -> Text -> Text
+.+ Text
d')
          Text
_        -> (Text
k, Integer -> OEISData
INT (Integer -> OEISData) -> Maybe Integer -> Maybe OEISData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
d)

getTextData :: Value -> T.Text -> (T.Text, Maybe OEISData)
getTextData :: Value -> Text -> (Text, Maybe OEISData)
getTextData Value
result Text
k
  = let d :: Maybe Text
d = Value
result Value -> Getting (First Text) Value Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
k ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String
    in case Maybe Text
d of
      Maybe Text
Nothing -> (Text
k, Maybe OEISData
forall a. Maybe a
Nothing)
      Maybe Text
_       ->
        case Text
k of
          Text
"keyword" -> (Text
k, [Keyword] -> OEISData
KEYS ([Keyword] -> OEISData) -> (Text -> [Keyword]) -> Text -> OEISData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Keyword) -> [Text] -> [Keyword]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Keyword
readKeyword ([Text] -> [Keyword]) -> (Text -> [Text]) -> Text -> [Keyword]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"," (Text -> OEISData) -> Maybe Text -> Maybe OEISData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
d)
          Text
"data"    -> let d' :: String
d' = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Char
'[' Char -> Text -> Text
.+ Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Text
d Text -> Char -> Text
+. Char
']'
                       in (Text
k, OEISData -> Maybe OEISData
forall a. a -> Maybe a
Just (OEISData -> Maybe OEISData) -> OEISData -> Maybe OEISData
forall a b. (a -> b) -> a -> b
$ SeqData -> OEISData
SEQ (String -> SeqData
forall a. Read a => String -> a
read String
d' :: SeqData))
          Text
"id"      -> (Text
k, [Text] -> OEISData
TXTS ([Text] -> OEISData) -> (Text -> [Text]) -> Text -> OEISData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
" " (Text -> OEISData) -> Maybe Text -> Maybe OEISData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
d)
          Text
"offset"  -> (Text
k, Integer -> OEISData
INT (Integer -> OEISData) -> (Text -> Integer) -> Text -> OEISData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Integer
forall a. Read a => String -> a
read (String -> Integer) -> (Text -> String) -> Text -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.take Int
1 (Text -> OEISData) -> Maybe Text -> Maybe OEISData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
d)
          Text
_         -> (Text
k, Text -> OEISData
TXT (Text -> OEISData) -> Maybe Text -> Maybe OEISData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
d)

getTextsData :: Value -> T.Text -> (T.Text, Maybe OEISData)
getTextsData :: Value -> Text -> (Text, Maybe OEISData)
getTextsData Value
result Text
k
  = let ds :: Maybe (Vector Value)
ds  = Value
result Value
-> ((Vector Value -> Const (First (Vector Value)) (Vector Value))
    -> Value -> Const (First (Vector Value)) Value)
-> Maybe (Vector Value)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
k ((Value -> Const (First (Vector Value)) Value)
 -> Value -> Const (First (Vector Value)) Value)
-> ((Vector Value -> Const (First (Vector Value)) (Vector Value))
    -> Value -> Const (First (Vector Value)) Value)
-> (Vector Value -> Const (First (Vector Value)) (Vector Value))
-> Value
-> Const (First (Vector Value)) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (First (Vector Value)) (Vector Value))
-> Value -> Const (First (Vector Value)) Value
forall t. AsValue t => Prism' t (Vector Value)
_Array
    in case Maybe (Vector Value)
ds of
      Maybe (Vector Value)
Nothing -> (Text
k, Maybe OEISData
forall a. Maybe a
Nothing)
      Maybe (Vector Value)
_       ->
        let ts :: [Text]
ts  = (\Int
i -> Value
result Value -> Getting (Endo Text) Value Text -> Text
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
k ((Value -> Const (Endo Text) Value)
 -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Traversal' Value Value
forall t. AsValue t => Int -> Traversal' t Value
nth Int
i ((Value -> Const (Endo Text) Value)
 -> Value -> Const (Endo Text) Value)
-> Getting (Endo Text) Value Text -> Getting (Endo Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Item [Int]
0..(Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
            len :: Int
len = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Vector Value -> Int
forall a. Vector a -> Int
V.length (Vector Value -> Int) -> Maybe (Vector Value) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Vector Value)
ds
        in case Text
k of
          Text
"program" -> let prgs :: [Program]
prgs = Program -> [Program] -> [Text] -> [Program]
parsePrograms Program
emptyProgram [] [Text]
ts
                       in (Text
k, OEISData -> Maybe OEISData
forall a. a -> Maybe a
Just (OEISData -> Maybe OEISData) -> OEISData -> Maybe OEISData
forall a b. (a -> b) -> a -> b
$ [Program] -> OEISData
PRGS [Program]
prgs)
          Text
_         -> (Text
k, OEISData -> Maybe OEISData
forall a. a -> Maybe a
Just (OEISData -> Maybe OEISData) -> OEISData -> Maybe OEISData
forall a b. (a -> b) -> a -> b
$ [Text] -> OEISData
TXTS [Text]
ts)


resultLen :: SearchStatus -> IO (Maybe Int)
resultLen :: SearchStatus -> IO (Maybe Int)
resultLen SearchStatus
ss = do
  Text
jsn <- SearchStatus -> Int -> IO Text
getJSON SearchStatus
ss Int
0
  Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Maybe Integer -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
jsn Text -> Getting (First Integer) Text Integer -> Maybe Integer
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Text Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"count" ((Value -> Const (First Integer) Value)
 -> Text -> Const (First Integer) Text)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Text Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Integer) Value Integer
forall t. AsNumber t => Prism' t Integer
_Integer

emptyOEIS :: OEISSeq
emptyOEIS :: OEISSeq
emptyOEIS = Text
-> [Text]
-> SeqData
-> Text
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Program]
-> [Text]
-> [Keyword]
-> Integer
-> Text
-> [Text]
-> Integer
-> Integer
-> Text
-> Text
-> OEISSeq
OEIS Text
"" [] [] Text
"" [] [] [] [] [] [] [] [] [] [] Integer
0 Text
"" [] Integer
0 Integer
0 Text
"" Text
""

addElement :: OEISSeq -> (T.Text, Maybe OEISData) -> OEISSeq
addElement :: OEISSeq -> (Text, Maybe OEISData) -> OEISSeq
addElement OEISSeq
seq (Text
k, Just (TXT Text
t))
  = case Text
k of
      Text
"number"  -> OEISSeq
seq {number :: Text
number = Text
t}
      Text
"name"    -> OEISSeq
seq {name :: Text
name = Text
t}
      Text
"author"  -> OEISSeq
seq {author :: Text
author = Text
t}
      Text
"time"    -> OEISSeq
seq {time :: Text
time = Text
t}
      Text
"created" -> OEISSeq
seq {created :: Text
created = Text
t}
      Text
_         -> OEISSeq
seq
addElement OEISSeq
seq (Text
k, Just (TXTS [Text]
ts))
  = case Text
k of
      Text
"id"          -> OEISSeq
seq {ids :: [Text]
ids = [Text]
ts}
      Text
"comment"     -> OEISSeq
seq {comment :: [Text]
comment = [Text]
ts}
      Text
"reference"   -> OEISSeq
seq {reference :: [Text]
reference = [Text]
ts}
      Text
"link"        -> OEISSeq
seq {link :: [Text]
link = [Text]
ts}
      Text
"formula"     -> OEISSeq
seq {formula :: [Text]
formula = [Text]
ts}
      Text
"example"     -> OEISSeq
seq {example :: [Text]
example = [Text]
ts}
      Text
"maple"       -> OEISSeq
seq {maple :: [Text]
maple = [Text]
ts}
      Text
"mathematica" -> OEISSeq
seq {mathematica :: [Text]
mathematica = [Text]
ts}
      Text
"xref"        -> OEISSeq
seq {xref :: [Text]
xref = [Text]
ts}
      Text
"ext"         -> OEISSeq
seq {ext :: [Text]
ext = [Text]
ts}
      Text
_             -> OEISSeq
seq
addElement OEISSeq
seq (Text
k, Just (INT Integer
n))
  = case Text
k of
      Text
"offset"     -> OEISSeq
seq {offset :: Integer
offset = Integer
n}
      Text
"references" -> OEISSeq
seq {references :: Integer
references = Integer
n}
      Text
"revision"   -> OEISSeq
seq {revision :: Integer
revision = Integer
n}
      Text
_            -> OEISSeq
seq
addElement OEISSeq
seq (Text
"data"   , Just (SEQ SeqData
s))   = OEISSeq
seq {seqData :: SeqData
seqData = SeqData
s}
addElement OEISSeq
seq (Text
"keyword", Just (KEYS [Keyword]
ks)) = OEISSeq
seq {keyword :: [Keyword]
keyword = [Keyword]
ks}
addElement OEISSeq
seq (Text
"program", Just (PRGS [Program]
ps)) = OEISSeq
seq {program :: [Program]
program = [Program]
ps}
addElement OEISSeq
seq (Text
_, Maybe OEISData
_) = OEISSeq
seq

parseOEIS :: Value -> OEISSeq
parseOEIS :: Value -> OEISSeq
parseOEIS Value
result = (OEISSeq -> (Text, Maybe OEISData) -> OEISSeq)
-> OEISSeq -> [(Text, Maybe OEISData)] -> OEISSeq
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OEISSeq -> (Text, Maybe OEISData) -> OEISSeq
addElement OEISSeq
emptyOEIS ([(Text, Maybe OEISData)] -> OEISSeq)
-> [(Text, Maybe OEISData)] -> OEISSeq
forall a b. (a -> b) -> a -> b
$ (Text -> (Text, Maybe OEISData))
-> [Text] -> [(Text, Maybe OEISData)]
forall a b. (a -> b) -> [a] -> [b]
map (Value -> Text -> (Text, Maybe OEISData)
getData Value
result) [Text]
keys


-- Parse Keyword --
readKeyword :: T.Text -> Keyword
readKeyword :: Text -> Keyword
readKeyword Text
txt =
  let str :: String
str = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
capitalize Text
txt
  in case ReadS Keyword
forall a. Read a => ReadS a
reads String
str of
       [(kw, "")] -> Keyword
kw
       [(Keyword, String)]
_          -> Keyword
Other

capitalize :: T.Text -> T.Text
capitalize :: Text -> Text
capitalize Text
"" = Text
""
capitalize Text
cs = Char -> Char
toUpper (Text -> Char
T.head Text
cs) Char -> Text -> Text
.+ (Char -> Char) -> Text -> Text
T.map Char -> Char
toLower (Text -> Text
T.tail Text
cs)


-- Parse Program --
emptyProgram :: Program
emptyProgram = (Text
"", []) :: Program

parsePrograms :: Program -> [Program] -> [T.Text] -> [Program]
parsePrograms :: Program -> [Program] -> [Text] -> [Program]
parsePrograms Program
_ [Program]
prgs [] = [Program]
prgs
parsePrograms (Text
lang0, [Text]
funcs) [Program]
prgs (Text
t : [Text]
ts)
  | Text -> Char
T.head Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(' = let prgs' :: [Program]
prgs' = [Program]
prgs [Program] -> [Program] -> [Program]
forall a. [a] -> [a] -> [a]
++ [(Text
lang, [Text
Item [Text]
func])]
                      in Program -> [Program] -> [Text] -> [Program]
parsePrograms (Text
lang, [Text
Item [Text]
func]) [Program]
prgs' [Text]
ts
  | [Program] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Program]
prgs       = let prgs' :: [Program]
prgs' = [Program]
prgs [Program] -> [Program] -> [Program]
forall a. [a] -> [a] -> [a]
++ [(Text
"", [Text
Item [Text]
t])]
                      in Program -> [Program] -> [Text] -> [Program]
parsePrograms (Text
"", [Text
Item [Text]
t]) [Program]
prgs' [Text]
ts
  | Bool
otherwise       = let funcs' :: [Text]
funcs' = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text]
funcs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
Item [Text]
t]
                          prgs' :: [Program]
prgs'  = [Program] -> [Program]
forall a. [a] -> [a]
init [Program]
prgs [Program] -> [Program] -> [Program]
forall a. [a] -> [a] -> [a]
++ [(Text
lang0, [Text]
funcs')]
                      in Program -> [Program] -> [Text] -> [Program]
parsePrograms (Text
lang0, [Text]
funcs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
Item [Text]
t]) [Program]
prgs' [Text]
ts
  where
    (Text
lang', Text
func') = Text -> Text -> (Text, Text)
T.breakOn Text
")" Text
t
    lang :: Text
lang           = Text -> Text
T.tail Text
lang'
    func :: Text
func           = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.tail Text
func'