{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
module Math.OEIS.Internal where
import Control.Lens ((^?!), (^?))
import Control.Monad (when)
import Data.Aeson (decodeStrict)
import Data.Aeson.Key (fromText)
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
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 -> Text -> Text
(+.+) = Text -> Text -> Text
T.append
.+ :: Char -> Text -> Text
(.+) = Char -> Text -> Text
T.cons
+. :: Text -> Char -> Text
(+.) = Text -> Char -> Text
T.snoc
showSeqData :: SeqData -> T.Text
showSeqData :: SeqData -> Text
showSeqData = [Char] -> Text
T.pack ([Char] -> Text) -> (SeqData -> [Char]) -> SeqData -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
tail ([Char] -> [Char]) -> (SeqData -> [Char]) -> SeqData -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
init ([Char] -> [Char]) -> (SeqData -> [Char]) -> SeqData -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeqData -> [Char]
forall a. Show a => a -> [Char]
show
readSeqData :: String -> SeqData
readSeqData :: [Char] -> SeqData
readSeqData [Char]
str = case ReadS SeqData
forall a. Read a => ReadS a
reads ([Char]
"[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]") of
[(SeqData
sd, [Char]
"")] -> SeqData
sd
[(SeqData, [Char])]
_ -> []
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) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
" " (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ SearchStatus -> [Char]
forall a. Show a => a -> [Char]
show SearchStatus
ss
pref :: Text
pref = Text -> Text
T.toLower Text
cst Text -> Text -> Text
+.+ Text
":"
txt' :: Text
txt' = HasCallStack => Text -> Text
Text -> Text
T.init (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text
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
=<< [Char] -> IO Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest (Text -> [Char]
T.unpack Text
x))
getJSON :: SearchStatus -> Int -> IO T.Text
getJSON :: SearchStatus -> Int -> IO Text
getJSON (Others Text
txt) Int
_ = Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
txt
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
+.+ [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n)
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
$ [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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' = ByteString -> Maybe (Vector Value)
forall a. FromJSON a => ByteString -> Maybe a
decodeStrict (ByteString -> Maybe (Vector Value))
-> ByteString -> Maybe (Vector Value)
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
jsn :: Maybe Array
results :: IO (Vector Value)
results = case Maybe (Vector Value)
results' of
Maybe (Vector Value)
Nothing -> Vector Value -> IO (Vector Value)
forall a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Value
vs'
Others Text
_ -> Vector Value -> IO (Vector Value)
forall a. a -> IO a
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 a. a -> IO a
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
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Value
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 a. Eq a => a -> [a] -> 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 a. Eq a => a -> [a] -> 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 a. Eq a => a -> [a] -> 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
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key (Text -> Key
fromText 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
Prism' Value 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' = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> [Char]) -> Integer -> [Char]
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
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key (Text -> Key
fromText 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. AsValue t => Prism' t Text
Prism' Value 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
. HasCallStack => Text -> Text -> [Text]
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' :: [Char]
d' = Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
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 ([Char] -> SeqData
forall a. Read a => [Char] -> a
read [Char]
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
. HasCallStack => Text -> Text -> [Text]
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
. [Char] -> Integer
forall a. Read a => [Char] -> a
read ([Char] -> Integer) -> (Text -> [Char]) -> Text -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack (Text -> [Char]) -> (Text -> Text) -> Text -> [Char]
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
-> Getting (First (Vector Value)) Value (Vector Value)
-> Maybe (Vector Value)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key (Text -> Key
fromText Text
k) ((Value -> Const (First (Vector Value)) Value)
-> Value -> Const (First (Vector Value)) Value)
-> Getting (First (Vector Value)) Value (Vector Value)
-> Getting (First (Vector Value)) Value (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First (Vector Value)) Value (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
Prism' Value (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
^?! Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key (Text -> Key
fromText 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. AsValue t => Prism' t Text
Prism' Value 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 a. a -> IO a
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
^? Key -> Traversal' Text Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"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
Prism' Value 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 = t}
Text
"name" -> OEISSeq
seq {name = t}
Text
"author" -> OEISSeq
seq {author = t}
Text
"time" -> OEISSeq
seq {time = t}
Text
"created" -> OEISSeq
seq {created = t}
Text
_ -> OEISSeq
seq
addElement OEISSeq
seq (Text
k, Just (TXTS [Text]
ts))
= case Text
k of
Text
"id" -> OEISSeq
seq {ids = ts}
Text
"comment" -> OEISSeq
seq {comment = ts}
Text
"reference" -> OEISSeq
seq {reference = ts}
Text
"link" -> OEISSeq
seq {link = ts}
Text
"formula" -> OEISSeq
seq {formula = ts}
Text
"example" -> OEISSeq
seq {example = ts}
Text
"maple" -> OEISSeq
seq {maple = ts}
Text
"mathematica" -> OEISSeq
seq {mathematica = ts}
Text
"xref" -> OEISSeq
seq {xref = ts}
Text
"ext" -> OEISSeq
seq {ext = ts}
Text
_ -> OEISSeq
seq
addElement OEISSeq
seq (Text
k, Just (INT Integer
n))
= case Text
k of
Text
"offset" -> OEISSeq
seq {offset = n}
Text
"references" -> OEISSeq
seq {references = n}
Text
"revision" -> OEISSeq
seq {revision = n}
Text
_ -> OEISSeq
seq
addElement OEISSeq
seq (Text
"data" , Just (SEQ SeqData
s)) = OEISSeq
seq {seqData = s}
addElement OEISSeq
seq (Text
"keyword", Just (KEYS [Keyword]
ks)) = OEISSeq
seq {keyword = ks}
addElement OEISSeq
seq (Text
"program", Just (PRGS [Program]
ps)) = OEISSeq
seq {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 b a. (b -> a -> b) -> b -> [a] -> b
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
readKeyword :: T.Text -> Keyword
readKeyword :: Text -> Keyword
readKeyword Text
txt =
let str :: [Char]
str = Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> Text
capitalize Text
txt
in case ReadS Keyword
forall a. Read a => ReadS a
reads [Char]
str of
[(Keyword
kw, [Char]
"")] -> Keyword
kw
[(Keyword, [Char])]
_ -> Keyword
Other
capitalize :: T.Text -> T.Text
capitalize :: Text -> Text
capitalize Text
"" = Text
""
capitalize Text
cs = Char -> Char
toUpper (HasCallStack => Text -> Char
Text -> Char
T.head Text
cs) Char -> Text -> Text
.+ (Char -> Char) -> Text -> Text
T.map Char -> Char
toLower (HasCallStack => Text -> Text
Text -> Text
T.tail Text
cs)
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)
| HasCallStack => Text -> Char
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 a. [a] -> 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. HasCallStack => [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') = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
")" Text
t
lang :: Text
lang = HasCallStack => Text -> Text
Text -> Text
T.tail Text
lang'
func :: Text
func = Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text
Text -> Text
T.tail Text
func'