{-| 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 :: String -> Maybe Double
readReal = [(Double, String)] -> Maybe Double
forall a b. [(a, b)] -> Maybe a
readsToMaybe ([(Double, String)] -> Maybe Double)
-> (String -> [(Double, String)]) -> String -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(Double, String)]
forall a. Read a => ReadS a
reads (String -> [(Double, String)])
-> (String -> String) -> String -> [(Double, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'+') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
combineAtDot ((String, String) -> String)
-> (String -> (String, String)) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> (String, String)
fixAtDot ((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
breakAtDot (String -> (String, String))
-> (String -> String) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
replaceDwithE (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
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 :: String -> Maybe Integer
readInteger String
s = [(Integer, String)] -> Maybe Integer
forall a b. [(a, b)] -> Maybe a
readsToMaybe ([(Integer, String)] -> Maybe Integer)
-> [(Integer, String)] -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ case String
s' of
  Char
'b':String
_ -> Integer -> (Char -> Bool) -> (Char -> Int) -> ReadS Integer
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt Integer
2 (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"01") Char -> Int
digitToInt (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 String
s')
  Char
'o':String
_ -> Integer -> (Char -> Bool) -> (Char -> Int) -> ReadS Integer
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt Integer
8 (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'0'..Char
'7']) Char -> Int
digitToInt (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 String
s')
  Char
'z':String
_ -> Integer -> (Char -> Bool) -> (Char -> Int) -> ReadS Integer
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt Integer
16 (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char
'0'..Char
'9'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'F'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'a'..Char
'f'])) Char -> Int
digitToInt (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 String
s')
  String
_     -> ReadS Integer -> ReadS Integer
forall a. Real a => ReadS a -> ReadS a
readSigned ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readDec String
s'
  where
    s' :: String
s' = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'+') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
s

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

combineAtDot :: (String, String) -> String
combineAtDot (String
a, String
b) = String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b
fixAtDot :: (String, String) -> (String, String)
fixAtDot (String, String)
x
  | (String, String)
x (String, String) -> (String, String) -> Bool
forall a. Eq a => a -> a -> Bool
== (String, String)
x'         = (String, String)
x
  | Bool
otherwise       = (String, String) -> (String, String)
fixAtDot (String, String)
x' where x' :: (String, String)
x' = (String, String) -> (String, String)
fixAtDot' (String, String)
x
breakAtDot :: String -> (String, String)
breakAtDot          = (String -> String) -> (String, String) -> (String, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1) ((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
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 :: [(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