Internal.hs

-- | This module exists just to facilitate testing.
-- /Nothing here is part of the OEIS API./

module Math.OEIS.Internal where

--------------------------------------------------------------------------------

import Control.Arrow (second, (***))
import Data.Char     (isSpace, toUpper, toLower)
import Data.List     (intercalate, isPrefixOf, foldl')
import Network.URI   (parseURI, URI)

import qualified Network.HTTP.Client       as HTTP
import qualified Network.HTTP.Client.TLS   as HTTP
import qualified Network.HTTP.Types        as HTTP
import qualified Data.ByteString.Lazy.UTF8 as U

import Math.OEIS.Types

--------------------------------------------------------------------------------

baseSearchURI :: String
baseSearchURI = "https://oeis.org/search?fmt=text&q="

idSearchURI :: String -> String
idSearchURI n = baseSearchURI ++ "id:" ++ n

seqSearchURI :: SequenceData -> String
seqSearchURI xs = baseSearchURI ++ intercalate "," (map show xs)

getOEIS :: (a -> String) -> a -> IO [OEISSequence]
getOEIS toURI key =
    case parseURI (toURI key) of
      Nothing  -> return []
      Just uri -> do
          mbody <- get uri
          return $ maybe [] parseOEIS mbody

get :: URI -> IO (Maybe String)
get uri = do
    httpman <- HTTP.newManager HTTP.tlsManagerSettings
    let request = HTTP.requestFromURI_ uri
    response <- HTTP.httpLbs request httpman
    return $ case HTTP.statusIsSuccessful (HTTP.responseStatus response) of
        False -> Nothing
        True -> Just (U.toString (HTTP.responseBody response))

readKeyword :: String -> Keyword
readKeyword = read . capitalize

capitalize :: String -> String
capitalize ""     = ""
capitalize (c:cs) = toUpper c : map toLower cs

emptyOEIS :: OEISSequence
emptyOEIS = OEIS [] [] [] "" [] [] [] [] "" 0 0 [] [] [] [] []

addElement :: (Char, String) -> OEISSequence -> OEISSequence
addElement ('I', x) c = c { catalogNums = words x }
addElement (t, x)   c | t `elem` "STU" = c { sequenceData = nums ++ sequenceData c }
    where nums = map read $ csvItems x
addElement (t, x)   c | t `elem` "VWX" = c { signedData = nums ++ signedData c }
    where nums = map read $ csvItems x
addElement ('N', x) c = c { description = x                  }
addElement ('D', x) c = c { references  = x : references c }
addElement ('H', x) c = c { links       = x : links c      }
addElement ('F', x) c = c { formulas    = x : formulas c   }
addElement ('Y', x) c = c { xrefs       = x : xrefs c      }
addElement ('A', x) c = c { author      = x                  }
addElement ('O', x) c = c { offset      = read o
                          , firstGT1    = read f }
  where (o,f) = second tail . span (/=',') $ x
addElement ('p', x) c = c { programs    = (Maple, x) :
                                            programs c     }
addElement ('t', x) c = c { programs    = (Mathematica, x) :
                                            programs c     }
addElement ('o', x) c = c { programs    = (Other, x) :
                                            programs c     }
addElement ('E', x) c = c { extensions  = x : extensions c }
addElement ('e', x) c = c { examples    = x : examples c   }
addElement ('K', x) c = c { keywords    = parseKeywords x    }
addElement ('C', x) c = c { comments    = x : comments c   }
addElement _ c = c

parseOEIS :: String -> [OEISSequence]
parseOEIS x = if "No results." `isPrefixOf` (ls!!3)
                then []
                else go . dropWhile ((/= 'I') . fst) . parseRawOEIS $ ls'
    where ls = lines x
          ls' = init . drop 5 $ ls
          go [] = []
          go (i:xs) = foldl' (flip addElement) emptyOEIS (reverse (i:ys)) : go zs
              where (ys, zs) = break ((== 'I') . fst) xs

parseRawOEIS :: [String] -> [(Char, String)]
parseRawOEIS = map parseItem . combineConts

parseKeywords :: String -> [Keyword]
parseKeywords = map readKeyword . csvItems

csvItems :: String -> [String]
csvItems "" = []
csvItems x = item : others
    where (item, rest) = span (/=',') x
          others = csvItems $ del ',' rest

del :: Char -> String -> String
del _ ""     = ""
del c (x:xs) | c==x      = xs
             | otherwise = x:xs

parseItem :: String -> (Char, String)
parseItem s = (c, str)
    where ( '%':c:_ , rest) = splitWord s
          (_, str )    = if c == 'I' then ("", rest)
                                     else splitWord rest

combineConts :: [String] -> [String]
combineConts (s@('%':_:_) : ss) =
  uncurry (:) . (joinConts s *** combineConts) . break isItem $ ss
combineConts ss = ss

splitWord :: String -> (String, String)
splitWord = second trimLeft . break isSpace

isItem :: String -> Bool
isItem x = not (null x) && '%' == head x

joinConts :: String -> [String] -> String
joinConts s conts = s ++ concatMap trimLeft conts

trimLeft :: String -> String
trimLeft = dropWhile isSpace