{-| Simple module to provide functions that read Fortran literals -}
module Language.Fortran.Parser.Utils
  ( readReal
  , readInteger
  ) where

import           Data.Char
import           Numeric

breakAtDot :: String -> (String, String)
replaceDwithE :: Char -> Char
readsToMaybe :: [(a, b)] -> Maybe a
fixAtDot :: (String, String) -> (String, String)
fixAtDot' :: (String, String) -> (String, String)
combineAtDot :: (String, String) -> String

-- | Convert a Fortran literal Real into a Haskell Double.
readReal :: String -> Maybe Double
readReal :: [Char] -> Maybe Double
readReal = [(Double, [Char])] -> Maybe Double
forall a b. [(a, b)] -> Maybe a
readsToMaybe ([(Double, [Char])] -> Maybe Double)
-> ([Char] -> [(Double, [Char])]) -> [Char] -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [(Double, [Char])]
forall a. Read a => ReadS a
reads ([Char] -> [(Double, [Char])])
-> ([Char] -> [Char]) -> [Char] -> [(Double, [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'+') ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
combineAtDot (([Char], [Char]) -> [Char])
-> ([Char] -> ([Char], [Char])) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> ([Char], [Char])
fixAtDot (([Char], [Char]) -> ([Char], [Char]))
-> ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ([Char], [Char])
breakAtDot ([Char] -> ([Char], [Char]))
-> ([Char] -> [Char]) -> [Char] -> ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
replaceDwithE ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_')

-- | Convert a Fortran literal Integer into a Haskell Integer.
readInteger :: String -> Maybe Integer
readInteger :: [Char] -> Maybe Integer
readInteger [Char]
s = [(Integer, [Char])] -> Maybe Integer
forall a b. [(a, b)] -> Maybe a
readsToMaybe ([(Integer, [Char])] -> Maybe Integer)
-> [(Integer, [Char])] -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ case [Char]
s' of
  Char
'b':[Char]
_ -> Integer -> (Char -> Bool) -> (Char -> Int) -> ReadS Integer
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt Integer
2 (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"01") Char -> Int
digitToInt (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
2 [Char]
s')
  Char
'o':[Char]
_ -> Integer -> (Char -> Bool) -> (Char -> Int) -> ReadS Integer
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt Integer
8 (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'0'..Char
'7']) Char -> Int
digitToInt (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
2 [Char]
s')
  Char
'z':[Char]
_ -> Integer -> (Char -> Bool) -> (Char -> Int) -> ReadS Integer
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt Integer
16 (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char
'0'..Char
'9'] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'F'] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'a'..Char
'f'])) Char -> Int
digitToInt (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
2 [Char]
s')
  [Char]
_     -> ReadS Integer -> ReadS Integer
forall a. Real a => ReadS a -> ReadS a
readSigned ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readDec [Char]
s'
  where
    s' :: [Char]
s' = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'+') ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
s

fixAtDot' :: ([Char], [Char]) -> ([Char], [Char])
fixAtDot' ([Char]
"", [Char]
r)                      = ([Char]
"0", [Char]
r)
fixAtDot' ([Char]
"-", [Char]
r)                     = ([Char]
"-0", [Char]
r)
fixAtDot' ([Char]
l, [Char]
"")                      = ([Char]
l, [Char]
"0")
fixAtDot' ([Char]
l, Char
r0:[Char]
r) | Bool -> Bool
not (Char -> Bool
isDigit Char
r0) = ([Char]
l, Char
'0'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
r0Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
r)
fixAtDot' ([Char], [Char])
x                            = ([Char], [Char])
x

combineAtDot :: ([Char], [Char]) -> [Char]
combineAtDot ([Char]
a, [Char]
b) = [Char]
a [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
b
fixAtDot :: ([Char], [Char]) -> ([Char], [Char])
fixAtDot ([Char], [Char])
x
  | ([Char], [Char])
x ([Char], [Char]) -> ([Char], [Char]) -> Bool
forall a. Eq a => a -> a -> Bool
== ([Char], [Char])
x'         = ([Char], [Char])
x
  | Bool
otherwise       = ([Char], [Char]) -> ([Char], [Char])
fixAtDot ([Char], [Char])
x' where x' :: ([Char], [Char])
x' = ([Char], [Char]) -> ([Char], [Char])
fixAtDot' ([Char], [Char])
x
breakAtDot :: [Char] -> ([Char], [Char])
breakAtDot          = ([Char] -> [Char]) -> ([Char], [Char]) -> ([Char], [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1) (([Char], [Char]) -> ([Char], [Char]))
-> ([Char] -> ([Char], [Char])) -> [Char] -> ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.')
replaceDwithE :: Char -> Char
replaceDwithE Char
'd'   = Char
'e'
replaceDwithE Char
c     = Char
c

readsToMaybe :: forall a b. [(a, b)] -> Maybe a
readsToMaybe [(a, b)]
r = case [(a, b)]
r of
  (a
x, b
_):[(a, b)]
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
  [(a, b)]
_ -> Maybe a
forall a. Maybe a
Nothing