|  | @@ -1,95 +1,9 @@
 | 
	
		
			
				|  |  |  module Main where
 | 
	
		
			
				|  |  | -import Numeric (showHex, showIntAtBase)
 | 
	
		
			
				|  |  | -import Data.List (isInfixOf, genericIndex)
 | 
	
		
			
				|  |  | -import Data.List.Split(splitOn)
 | 
	
		
			
				|  |  | -import Text.Read (readMaybe)
 | 
	
		
			
				|  |  | -import System.IO (hFlush, stdout)
 | 
	
		
			
				|  |  | -import Control.Parallel
 | 
	
		
			
				|  |  |  
 | 
	
		
			
				|  |  |  import Options.Applicative
 | 
	
		
			
				|  |  |  import Data.Semigroup ((<>))
 | 
	
		
			
				|  |  |  
 | 
	
		
			
				|  |  | --- Get the hex digit of Pi at place n.
 | 
	
		
			
				|  |  | -hexPi :: Integer -> Integer
 | 
	
		
			
				|  |  | -hexPi n =
 | 
	
		
			
				|  |  | -  let
 | 
	
		
			
				|  |  | -    summation = let
 | 
	
		
			
				|  |  | -      sone = (4 * sumPi n 1)
 | 
	
		
			
				|  |  | -      sfour = (2 * sumPi n 4)
 | 
	
		
			
				|  |  | -      sfive = (sumPi n 5)
 | 
	
		
			
				|  |  | -      ssix = (sumPi n 6)
 | 
	
		
			
				|  |  | -      in
 | 
	
		
			
				|  |  | -      sone `par` sfour `par` sfive `par` ssix `par` sone - sfour - sfive - ssix
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -    skimmedSum = summation - (fromIntegral (floor summation :: Integer)) -- Take only the decimal portion
 | 
	
		
			
				|  |  | -  in
 | 
	
		
			
				|  |  | -    floor (16 * skimmedSum) :: Integer
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | --- Calculate the summation.
 | 
	
		
			
				|  |  | --- 5000 is used in place of Infinity. This value drops off quickly, so no need to go too far.
 | 
	
		
			
				|  |  | -sumPi :: Integer -> Integer -> Double
 | 
	
		
			
				|  |  | -sumPi n x =
 | 
	
		
			
				|  |  | -  let
 | 
	
		
			
				|  |  | -    summation1 = sum [(fromIntegral ((16^(n-k) `mod` ((8*k)+x)))) / (fromIntegral ((8*k)+x)) | k <- [0..n]]
 | 
	
		
			
				|  |  | -    summation2 = sum [16^^(n-k) / (fromIntegral ((8*k)+x)) | k <- [(n+1)..5000]]
 | 
	
		
			
				|  |  | -  in
 | 
	
		
			
				|  |  | -    summation1 + summation2
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | --- Get a range of digits.
 | 
	
		
			
				|  |  | -rangePi :: (Integer -> String) -> String -> Maybe Integer -> Maybe Integer -> String
 | 
	
		
			
				|  |  | -rangePi printFun delim (Just low) (Just high) =
 | 
	
		
			
				|  |  | -  if low >= high then
 | 
	
		
			
				|  |  | -    "Error: Please give a proper range."
 | 
	
		
			
				|  |  | -  else
 | 
	
		
			
				|  |  | -    init $ foldr (++) [] $ separate (map printFun (drop (fromIntegral low) . take (fromIntegral high) $ hexDigits)) delim
 | 
	
		
			
				|  |  | -    -- foldl (.) id (map (showString . printFun) (drop (fromIntegral low) . take (fromIntegral high) $ hexDigits)) ""  -- Alternative implementation: not sure about speed
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -rangePi _ _ _ _ = printErr
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | --- Separate a list with some delimiter.
 | 
	
		
			
				|  |  | -separate :: [a] -> a -> [a]
 | 
	
		
			
				|  |  | -separate (x:xs) delim = x : delim : separate xs delim
 | 
	
		
			
				|  |  | -separate [] _ = []
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | --- Check if response is valid, then call the appropriate function.
 | 
	
		
			
				|  |  | -parseIndex :: (Integer -> String) -> String -> String -> String
 | 
	
		
			
				|  |  | -parseIndex printFun delim response =
 | 
	
		
			
				|  |  | -  if (isInfixOf ".." response) then
 | 
	
		
			
				|  |  | -    let
 | 
	
		
			
				|  |  | -      range = splitOn ".." response
 | 
	
		
			
				|  |  | -      low = readMaybe $ range !! 0 :: Maybe Integer
 | 
	
		
			
				|  |  | -      high = readMaybe $ range !! 1 :: Maybe Integer
 | 
	
		
			
				|  |  | -    in
 | 
	
		
			
				|  |  | -      rangePi printFun delim low high
 | 
	
		
			
				|  |  | -    else do
 | 
	
		
			
				|  |  | -      case (readMaybe response :: Maybe Integer) of
 | 
	
		
			
				|  |  | -        Nothing -> printErr
 | 
	
		
			
				|  |  | -        Just x -> printFun $ hexDigits `genericIndex` x
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | --- Continuously prompt for input.
 | 
	
		
			
				|  |  | -prompt :: (Integer -> String) -> String -> IO ()
 | 
	
		
			
				|  |  | -prompt printFun delim = do
 | 
	
		
			
				|  |  | -  putStr ">> "
 | 
	
		
			
				|  |  | -  hFlush stdout
 | 
	
		
			
				|  |  | -  response <- getLine
 | 
	
		
			
				|  |  | -  putStrLn $ parseIndex printFun delim response
 | 
	
		
			
				|  |  | -  prompt printFun delim
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | --- The list of answers.
 | 
	
		
			
				|  |  | -hexDigits :: [Integer]
 | 
	
		
			
				|  |  | -hexDigits = [hexPi x | x <- [0..]]
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | --- Complain about argument type.
 | 
	
		
			
				|  |  | -printErr :: String
 | 
	
		
			
				|  |  | -printErr = "Error: Please give an Integer (ex: 3) or a range (ex: 3..5)."
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | +import Parsing (argHandle, arguments)
 | 
	
		
			
				|  |  |  
 | 
	
		
			
				|  |  |  main :: IO ()
 | 
	
		
			
				|  |  |  main = argHandle =<< execParser opts
 | 
	
	
		
			
				|  | @@ -99,61 +13,3 @@ main = argHandle =<< execParser opts
 | 
	
		
			
				|  |  |       <> progDesc "Generate hexadecimal Pi digits.")
 | 
	
		
			
				|  |  |  
 | 
	
		
			
				|  |  |  
 | 
	
		
			
				|  |  | --- Arguments to parse.
 | 
	
		
			
				|  |  | -data Arguments = Arguments
 | 
	
		
			
				|  |  | -  { eval  :: Maybe String
 | 
	
		
			
				|  |  | -  , print :: Maybe PrintFunc
 | 
	
		
			
				|  |  | -  , delimiter :: String}
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -arguments :: Parser Arguments
 | 
	
		
			
				|  |  | -arguments = Arguments
 | 
	
		
			
				|  |  | -      <$> optional ( argument str (
 | 
	
		
			
				|  |  | -                       help "Evaluate an index/range, and exit."
 | 
	
		
			
				|  |  | -                       <> (metavar "eval")))
 | 
	
		
			
				|  |  | -      <*> printFunc
 | 
	
		
			
				|  |  | -      <*> strOption ( long "delimiter"
 | 
	
		
			
				|  |  | -                        <> metavar "delim"
 | 
	
		
			
				|  |  | -                        <> value ""
 | 
	
		
			
				|  |  | -                        <> help "Delimiter to separate printed values.")
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | --- Decide which printing function to use.
 | 
	
		
			
				|  |  | -data PrintFunc = DecPrint | BinPrint
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -printFunc :: Parser (Maybe PrintFunc)
 | 
	
		
			
				|  |  | -printFunc = optional (decPrint <|> binPrint)
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -decPrint :: Parser PrintFunc
 | 
	
		
			
				|  |  | -decPrint = flag' DecPrint ( long "decimal"
 | 
	
		
			
				|  |  | -                            <> short 'd'
 | 
	
		
			
				|  |  | -                            <> help "Output in decimal.")
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -binPrint :: Parser PrintFunc
 | 
	
		
			
				|  |  | -binPrint = flag' BinPrint ( long "binary"
 | 
	
		
			
				|  |  | -                            <> short 'b'
 | 
	
		
			
				|  |  | -                            <> help "Output in binary.")
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | -
 | 
	
		
			
				|  |  | --- Handle args, either prompt or eval & quit.
 | 
	
		
			
				|  |  | -argHandle :: Arguments -> IO ()
 | 
	
		
			
				|  |  | -argHandle (Arguments toEval outputType delim) = do
 | 
	
		
			
				|  |  | -  let
 | 
	
		
			
				|  |  | -    printFunIO =
 | 
	
		
			
				|  |  | -      case outputType of
 | 
	
		
			
				|  |  | -        Just DecPrint -> do
 | 
	
		
			
				|  |  | -          putStrLn "Outputting in decimal."
 | 
	
		
			
				|  |  | -          return (\n -> show n ++ "")
 | 
	
		
			
				|  |  | -        Just BinPrint -> do
 | 
	
		
			
				|  |  | -          putStrLn "Outputting in binary."
 | 
	
		
			
				|  |  | -          return (\n -> showIntAtBase 2 (\x -> show x !! 0) n "")
 | 
	
		
			
				|  |  | -        _ -> do
 | 
	
		
			
				|  |  | -          putStrLn "Outputting in hex."
 | 
	
		
			
				|  |  | -          return (\n -> showHex n "")
 | 
	
		
			
				|  |  | -    in do
 | 
	
		
			
				|  |  | -    printFun <- printFunIO
 | 
	
		
			
				|  |  | -    case toEval of
 | 
	
		
			
				|  |  | -      (Just s) -> putStrLn $ parseIndex printFun delim s
 | 
	
		
			
				|  |  | -      _ -> do
 | 
	
		
			
				|  |  | -        putStrLn "Enter a digit or range (Ctrl-C to exit)."
 | 
	
		
			
				|  |  | -        prompt printFun delim
 |