-- | Read functions.
module Music.Theory.Read where

import Data.Char {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import Data.Ratio {- base -}
import Data.Word {- base -}
import Numeric {- base -}

-- | Transform 'ReadS' function into precise 'Read' function.
-- Requires using all the input to produce a single token.  The only
-- exception is a singular trailing white space character.
reads_to_read_precise :: ReadS t -> (String -> Maybe t)
reads_to_read_precise :: forall t. ReadS t -> String -> Maybe t
reads_to_read_precise ReadS t
f String
s =
    case ReadS t
f String
s of
      [(t
r,[])] -> forall a. a -> Maybe a
Just t
r
      [(t
r,[Char
c])] -> if Char -> Bool
isSpace Char
c then forall a. a -> Maybe a
Just t
r else forall a. Maybe a
Nothing
      [(t, String)]
_ -> forall a. Maybe a
Nothing

-- | Error variant of 'reads_to_read_precise'.
reads_to_read_precise_err :: String -> ReadS t -> String -> t
reads_to_read_precise_err :: forall t. String -> ReadS t -> String -> t
reads_to_read_precise_err String
err ReadS t
f =
    forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error (String
"reads_to_read_precise_err:" forall a. [a] -> [a] -> [a]
++ String
err)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall t. ReadS t -> String -> Maybe t
reads_to_read_precise ReadS t
f

-- | 'reads_to_read_precise' of 'reads'.
--
-- > read_maybe "1.0" :: Maybe Int
-- > read_maybe "1.0" :: Maybe Float
read_maybe :: Read a => String -> Maybe a
read_maybe :: forall a. Read a => String -> Maybe a
read_maybe = forall t. ReadS t -> String -> Maybe t
reads_to_read_precise forall a. Read a => ReadS a
reads

-- | Variant of 'read_maybe' with default value.
--
-- > map (read_def 0) ["2","2:","2\n"] == [2,0,2]
read_def :: Read a => a -> String -> a
read_def :: forall a. Read a => a -> String -> a
read_def a
x String
s = forall a. a -> Maybe a -> a
fromMaybe a
x (forall a. Read a => String -> Maybe a
read_maybe String
s)

-- | Variant of 'read_maybe' that errors on 'Nothing', printing message.
read_err_msg :: Read a => String -> String -> a
read_err_msg :: forall a. Read a => String -> String -> a
read_err_msg String
msg String
s = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error (String
"read_err: " forall a. [a] -> [a] -> [a]
++ String
msg forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
s)) (forall a. Read a => String -> Maybe a
read_maybe String
s)

-- | Default message.
read_err :: Read a => String -> a
read_err :: forall a. Read a => String -> a
read_err = forall a. Read a => String -> String -> a
read_err_msg String
"read_maybe failed"

-- | Variant of 'reads' requiring exact match, no trailing white space.
--
-- > map reads_exact ["1.5","2,5"] == [Just 1.5,Nothing]
reads_exact :: Read a => String -> Maybe a
reads_exact :: forall a. Read a => String -> Maybe a
reads_exact String
s =
    case forall a. Read a => ReadS a
reads String
s of
      [(a
r,String
"")] -> forall a. a -> Maybe a
Just a
r
      [(a, String)]
_ -> forall a. Maybe a
Nothing

-- | Variant of 'reads_exact' that errors on failure.
reads_exact_err :: Read a => String -> String -> a
reads_exact_err :: forall a. Read a => String -> String -> a
reads_exact_err String
err_txt String
str =
    let err :: a
err = forall a. HasCallStack => String -> a
error (String
"reads: " forall a. [a] -> [a] -> [a]
++ String
err_txt forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
str)
    in forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err (forall a. Read a => String -> Maybe a
reads_exact String
str)

-- * Type specific variants

-- | Allow commas as thousand separators.
--
-- > let r = [Just 123456,Just 123456,Nothing,Just 123456789]
-- > map read_integral_allow_commas_maybe ["123456","123,456","1234,56","123,456,789"] == r
read_integral_allow_commas_maybe :: Read i => String -> Maybe i
read_integral_allow_commas_maybe :: forall a. Read a => String -> Maybe a
read_integral_allow_commas_maybe String
s =
    let c :: [(Char, Int)]
c = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== Char
',') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [a]
reverse String
s) [Int
0..])
    in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Char, Int)]
c
       then forall a. Read a => String -> Maybe a
read_maybe String
s
       else if forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Char, Int)]
c forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Int
3::Int,Int
7..]
            then forall a. Read a => String -> Maybe a
read_maybe (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
',') String
s)
            else forall a. Maybe a
Nothing

read_integral_allow_commas_err :: (Integral i,Read i) => String -> i
read_integral_allow_commas_err :: forall i. (Integral i, Read i) => String -> i
read_integral_allow_commas_err String
s =
    let err :: a
err = forall a. HasCallStack => String -> a
error (String
"read_integral_allow_commas: misplaced commas: " forall a. [a] -> [a] -> [a]
++ String
s)
    in forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err (forall a. Read a => String -> Maybe a
read_integral_allow_commas_maybe String
s)

-- | Type specialised.
--
-- > map read_int_allow_commas ["123456","123,456","123,456,789"] == [123456,123456,123456789]
read_int_allow_commas :: String -> Int
read_int_allow_commas :: String -> Int
read_int_allow_commas = forall i. (Integral i, Read i) => String -> i
read_integral_allow_commas_err

-- | Read a ratio where the division is given by @/@ instead of @%@
-- and the integers allow commas.
--
-- > map read_ratio_with_div_err ["123,456/7","123,456,789"] == [123456/7,123456789]
read_ratio_with_div_err :: (Integral i, Read i) => String -> Ratio i
read_ratio_with_div_err :: forall i. (Integral i, Read i) => String -> Ratio i
read_ratio_with_div_err String
s =
    let f :: String -> i
f = forall i. (Integral i, Read i) => String -> i
read_integral_allow_commas_err
    in case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'/') String
s of
         (String
n,Char
'/':String
d) -> String -> i
f String
n forall a. Integral a => a -> a -> Ratio a
% String -> i
f String
d
         (String, String)
_ -> forall i. (Integral i, Read i) => String -> i
read_integral_allow_commas_err String
s forall a. Integral a => a -> a -> Ratio a
% i
1

-- | Read 'Ratio', allow commas for thousand separators.
--
-- > read_ratio_allow_commas_err "327,680" "177,147" == 327680 / 177147
read_ratio_allow_commas_err :: (Integral i,Read i) => String -> String -> Ratio i
read_ratio_allow_commas_err :: forall i. (Integral i, Read i) => String -> String -> Ratio i
read_ratio_allow_commas_err String
n String
d = let f :: String -> i
f = forall i. (Integral i, Read i) => String -> i
read_integral_allow_commas_err in String -> i
f String
n forall a. Integral a => a -> a -> Ratio a
% String -> i
f String
d

-- | Delete trailing @.@, 'read' fails for @700.@.
delete_trailing_point :: String -> String
delete_trailing_point :: String -> String
delete_trailing_point String
s =
    case forall a. [a] -> [a]
reverse String
s of
      Char
'.':String
s' -> forall a. [a] -> [a]
reverse String
s'
      String
_ -> String
s

-- | 'read_err' disallows trailing decimal points.
--
-- > map read_fractional_allow_trailing_point_err ["123.","123.4"] == [123.0,123.4]
read_fractional_allow_trailing_point_err :: Read n => String -> n
read_fractional_allow_trailing_point_err :: forall a. Read a => String -> a
read_fractional_allow_trailing_point_err = forall a. Read a => String -> a
read_err forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
delete_trailing_point

-- * Plain type specialisations

-- | Type specialised 'read_maybe'.
--
-- > map read_maybe_int ["2","2:","2\n","x"] == [Just 2,Nothing,Just 2,Nothing]
read_maybe_int :: String -> Maybe Int
read_maybe_int :: String -> Maybe Int
read_maybe_int = forall a. Read a => String -> Maybe a
read_maybe

-- | Type specialised 'read_err'.
read_int :: String -> Int
read_int :: String -> Int
read_int = forall a. Read a => String -> a
read_err

-- | Type specialised 'read_maybe'.
read_maybe_double :: String -> Maybe Double
read_maybe_double :: String -> Maybe Double
read_maybe_double = forall a. Read a => String -> Maybe a
read_maybe

-- | Type specialised 'read_err'.
read_double :: String -> Double
read_double :: String -> Double
read_double = forall a. Read a => String -> a
read_err

-- | Type specialised 'read_maybe'.
--
-- > map read_maybe_rational ["1","1%2","1/2"] == [Nothing,Just (1/2),Nothing]
read_maybe_rational :: String -> Maybe Rational
read_maybe_rational :: String -> Maybe Rational
read_maybe_rational = forall a. Read a => String -> Maybe a
read_maybe

-- | Type specialised 'read_err'.
--
-- > read_rational "1%4"
read_rational :: String -> Rational
read_rational :: String -> Rational
read_rational = forall a. Read a => String -> a
read_err

-- * Numeric variants

-- | Read binary integer.
--
-- > mapMaybe read_bin (words "000 001 010 011 100 101 110 111") == [0 .. 7]
read_bin :: Integral a => String -> Maybe a
read_bin :: forall a. Integral a => String -> Maybe a
read_bin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt a
2 (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"01") Char -> Int
digitToInt

-- | Erroring variant.
read_bin_err :: Integral a => String -> a
read_bin_err :: forall a. Integral a => String -> a
read_bin_err = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"read_bin") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => String -> Maybe a
read_bin

-- * HEX

-- | Error variant of 'readHex'.
--
-- > read_hex_err "F0B0" == 61616
read_hex_err :: (Eq n, Integral n) => String -> n
read_hex_err :: forall n. (Eq n, Integral n) => String -> n
read_hex_err = forall t. String -> ReadS t -> String -> t
reads_to_read_precise_err String
"readHex" forall a. (Eq a, Num a) => ReadS a
readHex

-- | Read hex value from string of at most /k/ places.
read_hex_sz :: (Eq n, Integral n) => Int -> String -> n
read_hex_sz :: forall n. (Eq n, Integral n) => Int -> String -> n
read_hex_sz Int
k String
str =
  if forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str forall a. Ord a => a -> a -> Bool
> Int
k
  then forall a. HasCallStack => String -> a
error String
"read_hex_sz? = > K"
  else case forall a. (Eq a, Num a) => ReadS a
readHex String
str of
         [(n
r,[])] -> n
r
         [(n, String)]
_ -> forall a. HasCallStack => String -> a
error String
"read_hex_sz? = PARSE"

-- | Read hexadecimal representation of 32-bit unsigned word.
--
-- > map read_hex_word32 ["00000000","12345678","FFFFFFFF"] == [minBound,305419896,maxBound]
read_hex_word32 :: String -> Word32
read_hex_word32 :: String -> Word32
read_hex_word32 = forall n. (Eq n, Integral n) => Int -> String -> n
read_hex_sz Int
8

-- * Rational

-- | Parser for 'rational_pp'.
--
-- > map rational_parse ["1","3/2","5/4","2"] == [1,3/2,5/4,2]
-- > rational_parse "" == undefined
rational_parse :: (Read t,Integral t) => String -> Ratio t
rational_parse :: forall t. (Read t, Integral t) => String -> Ratio t
rational_parse String
s =
  case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'/') String
s of
    ([],String
_) -> forall a. HasCallStack => String -> a
error String
"rational_parse"
    (String
n,[]) -> forall a. Read a => String -> a
read String
n forall a. Integral a => a -> a -> Ratio a
% t
1
    (String
n,Char
_:String
d) -> forall a. Read a => String -> a
read String
n forall a. Integral a => a -> a -> Ratio a
% forall a. Read a => String -> a
read String
d