{-# LANGUAGE Safe #-}

{- |
    Module      :  Text.Read.SDP
    Copyright   :  (c) Andrey Mulik 2019
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  portable
    
    "Text.Read.SDP" provides common 'ReadPrec' parsers and related stuff.
-}
module Text.Read.SDP
(
  -- * Exports
  module Text.Read,
  module Text.Read.Lex,
  
  appPrec,
  
  -- * Common parsers
  linearPrec, indexedPrec, indexedPrec',
  
  readZeroPrec, readAsList, readAsListN, readAssocsPrec,
  
  -- * Common parser combinators
  allPrec, allPrecWith, expectPrec, namedPrec,
  
  -- * Generalized readers
  readDef, readBy, readMaybeBy, readEitherBy, readDefBy,
  
  -- * Enum parsers
  readAsEnum, enumFromPrec, enumFromToPrec, enumFromThenPrec, enumFromThenToPrec
)
where

import Prelude ()
import SDP.SafePrelude
import SDP.Indexed

import Data.Default.Class

import Text.ParserCombinators.ReadP ( eof, manyTill, skipSpaces )
import Text.Read.Lex ( expect )
import Text.Read

import GHC.Show ( appPrec )

default ()

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

{- |
  @'indexedPrec' ident@ is common parser of 'Indexed' structure with name
  @ident@:
  
  > read "ident (0,1) [(0,0),(1,1)]" == read "(0,1) [(0,0),(1,1)]" == assoc (0,1) [(0,0),(1,1)]
-}
indexedPrec :: (Indexed v i e, Read i, Read e) => String -> ReadPrec v
indexedPrec :: String -> ReadPrec v
indexedPrec =  ReadPrec v -> String -> ReadPrec v
forall e. ReadPrec e -> String -> ReadPrec e
namedPrec ReadPrec v
forall v i e. (Indexed v i e, Read i, Read e) => ReadPrec v
readAssocsPrec

{- |
  @'linearPrec' ident@ is common parser of 'Linear' structure with name
  @ident@:
  
  > read "Z" == read "[]" == []
  > read "['l','g','p','l']" == fromList "lgpl"
  > read "4 [1,5,-1,45,12,6,0,0,12]" == fromListN 4 [1,5,-1,45,12,6,0,0,12]
-}
linearPrec :: (Linear l e, Read e) => String -> ReadPrec l
linearPrec :: String -> ReadPrec l
linearPrec =  ReadPrec l -> String -> ReadPrec l
forall e. ReadPrec e -> String -> ReadPrec e
namedPrec (ReadPrec l
forall l e. Linear l e => ReadPrec l
readZeroPrec ReadPrec l -> ReadPrec l -> ReadPrec l
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ ReadPrec l
forall l e. (Linear l e, Read e) => ReadPrec l
readAsList ReadPrec l -> ReadPrec l -> ReadPrec l
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ ReadPrec l
forall l e. (Linear l e, Read e) => ReadPrec l
readAsListN)

-- | 'indexedPrec'' is common 'Linear' and 'Indexed' parser (recommended).
indexedPrec' :: (Indexed v i e, Read i, Read e) => String -> ReadPrec v
indexedPrec' :: String -> ReadPrec v
indexedPrec' =  ReadPrec v -> String -> ReadPrec v
forall e. ReadPrec e -> String -> ReadPrec e
namedPrec (ReadPrec v
forall l e. Linear l e => ReadPrec l
readZeroPrec ReadPrec v -> ReadPrec v -> ReadPrec v
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ ReadPrec v
forall l e. (Linear l e, Read e) => ReadPrec l
readAsList ReadPrec v -> ReadPrec v -> ReadPrec v
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ ReadPrec v
forall l e. (Linear l e, Read e) => ReadPrec l
readAsListN ReadPrec v -> ReadPrec v -> ReadPrec v
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ ReadPrec v
forall v i e. (Indexed v i e, Read i, Read e) => ReadPrec v
readAssocsPrec)

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

{- Common parsers. -}

-- | 'readZeroPrec' is just 'Z' parser, see 'linearPrec'.
readZeroPrec :: (Linear l e) => ReadPrec l
readZeroPrec :: ReadPrec l
readZeroPrec = ReadPrec l -> ReadPrec l
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec l -> ReadPrec l) -> ReadPrec l -> ReadPrec l
forall a b. (a -> b) -> a -> b
$ Prec -> ReadPrec () -> ReadPrec ()
forall a. Prec -> ReadPrec a -> ReadPrec a
prec Prec
appPrec (Lexeme -> ReadPrec ()
expectPrec (Lexeme -> ReadPrec ()) -> Lexeme -> ReadPrec ()
forall a b. (a -> b) -> a -> b
$ String -> Lexeme
Ident String
"Z") ReadPrec () -> ReadPrec l -> ReadPrec l
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> l -> ReadPrec l
forall (m :: * -> *) a. Monad m => a -> m a
return l
forall e. Nullable e => e
Z

-- | 'readAsList' is 'fromList'-based parser, see 'linearPrec'.
readAsList :: (Linear l e, Read e) => ReadPrec l
readAsList :: ReadPrec l
readAsList = [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> ReadPrec [e] -> ReadPrec l
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [e]
forall a. Read a => ReadPrec [a]
readListPrec

-- | 'readAsListN' is 'fromListN'-based parser, see 'linearPrec'.
readAsListN :: (Linear l e, Read e) => ReadPrec l
readAsListN :: ReadPrec l
readAsListN = (Prec -> [e] -> l) -> ReadPrec Prec -> ReadPrec [e] -> ReadPrec l
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Prec -> [e] -> l
forall l e. Linear l e => Prec -> [e] -> l
fromListN (ReadPrec Prec -> ReadPrec Prec
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Prec
forall a. Read a => ReadPrec a
readPrec) (ReadPrec [e] -> ReadPrec [e]
forall a. ReadPrec a -> ReadPrec a
step ReadPrec [e]
forall a. Read a => ReadPrec a
readPrec)

{- |
  'readAssocsPrec' is @sdp@ recommended format 'ReadPrec' parser for 'Indexed'.
-}
readAssocsPrec :: (Indexed v i e, Read i, Read e) => ReadPrec v
readAssocsPrec :: ReadPrec v
readAssocsPrec = ReadPrec v -> ReadPrec v
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec v -> ReadPrec v) -> ReadPrec v -> ReadPrec v
forall a b. (a -> b) -> a -> b
$ ((i, i) -> [(i, e)] -> v)
-> ReadPrec (i, i) -> ReadPrec [(i, e)] -> ReadPrec v
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (i, i) -> [(i, e)] -> v
forall v i e. Indexed v i e => (i, i) -> [(i, e)] -> v
assoc (ReadPrec (i, i) -> ReadPrec (i, i)
forall a. ReadPrec a -> ReadPrec a
step ReadPrec (i, i)
forall a. Read a => ReadPrec a
readPrec) (ReadPrec [(i, e)] -> ReadPrec [(i, e)]
forall a. ReadPrec a -> ReadPrec a
step ReadPrec [(i, e)]
forall a. Read a => ReadPrec a
readPrec)

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

{- Enum parsers. -}

-- | Common 'Enum' parser.
readAsEnum :: (Linear l e, Read e, Enum e) => ReadPrec l
readAsEnum :: ReadPrec l
readAsEnum =  [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> ReadPrec [e] -> ReadPrec l
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [e] -> ReadPrec [e]
forall a. ReadPrec a -> ReadPrec a
parens' (ReadPrec [e]
forall e. (Read e, Enum e) => ReadPrec [e]
fromPrec_ ReadPrec [e] -> ReadPrec [e] -> ReadPrec [e]
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ ReadPrec [e]
forall e. (Read e, Enum e) => ReadPrec [e]
fromThenPrec_ ReadPrec [e] -> ReadPrec [e] -> ReadPrec [e]
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ ReadPrec [e]
forall e. (Read e, Enum e) => ReadPrec [e]
fromToPrec_ ReadPrec [e] -> ReadPrec [e] -> ReadPrec [e]
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ ReadPrec [e]
forall e. (Read e, Enum e) => ReadPrec [e]
fromThenToPrec_)

{- |
  'enumFrom' parser:
  
  > take 5 (readBy enumFromPrec "[1 ..]") == take 5 [1 ..] = [1,2,3,4,5]
-}
enumFromPrec :: (Linear l e, Read e, Enum e) => ReadPrec l
enumFromPrec :: ReadPrec l
enumFromPrec =  [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> ReadPrec [e] -> ReadPrec l
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [e] -> ReadPrec [e]
forall a. ReadPrec a -> ReadPrec a
parens' ReadPrec [e]
forall e. (Read e, Enum e) => ReadPrec [e]
fromPrec_

{- |
  'enumFromTo' parser:
  
  > readBy enumFromToPrec "[9 .. 12]" == [9 .. 12] == [9,10,11,12]
-}
enumFromToPrec :: (Linear l e, Read e, Enum e) => ReadPrec l
enumFromToPrec :: ReadPrec l
enumFromToPrec =  [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> ReadPrec [e] -> ReadPrec l
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [e] -> ReadPrec [e]
forall a. ReadPrec a -> ReadPrec a
parens' ReadPrec [e]
forall e. (Read e, Enum e) => ReadPrec [e]
fromToPrec_

{- |
  'enumFromThen' parser:
  
  > take 4 (readBy enumFromThenPrec "[17, -6 .. ]") == take 4 [17, -6 ..] == [17,-6,-29,-52]
-}
enumFromThenPrec :: (Linear l e, Read e, Enum e) => ReadPrec l
enumFromThenPrec :: ReadPrec l
enumFromThenPrec =  [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> ReadPrec [e] -> ReadPrec l
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [e] -> ReadPrec [e]
forall a. ReadPrec a -> ReadPrec a
parens' ReadPrec [e]
forall e. (Read e, Enum e) => ReadPrec [e]
fromThenPrec_

{- |
  'enumFromThenTo' parser:
  
  > take 4 (readBy enumFromThenToPrec "[17, -6 .. 4]") == [17, -6 .. 4] == [17]
-}
enumFromThenToPrec :: (Linear l e, Read e, Enum e) => ReadPrec l
enumFromThenToPrec :: ReadPrec l
enumFromThenToPrec =  [e] -> l
forall l e. Linear l e => [e] -> l
fromList ([e] -> l) -> ReadPrec [e] -> ReadPrec l
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [e] -> ReadPrec [e]
forall a. ReadPrec a -> ReadPrec a
parens' ReadPrec [e]
forall e. (Read e, Enum e) => ReadPrec [e]
fromThenToPrec_

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

{- Common parser combinators. -}

-- | Just lifted 'expect'.
expectPrec :: Lexeme -> ReadPrec ()
expectPrec :: Lexeme -> ReadPrec ()
expectPrec = ReadP () -> ReadPrec ()
forall a. ReadP a -> ReadPrec a
lift (ReadP () -> ReadPrec ())
-> (Lexeme -> ReadP ()) -> Lexeme -> ReadPrec ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lexeme -> ReadP ()
expect

-- | @allPrec@ is just @'allPrecWith' 'readPrec'@
allPrec :: (Read e) => ReadPrec [e]
allPrec :: ReadPrec [e]
allPrec =  ReadPrec e -> ReadPrec [e]
forall e. ReadPrec e -> ReadPrec [e]
allPrecWith ReadPrec e
forall a. Read a => ReadPrec a
readPrec

{- |
  allPrecWith is 'manyTill'-based combinator, which reads a sequence of elements
  without any separators:
  
  > readBy allPrecWith readPrec "1 2 3 4 5 6 7" :: [Int] == [1 .. 7]
-}
allPrecWith :: ReadPrec e -> ReadPrec [e]
allPrecWith :: ReadPrec e -> ReadPrec [e]
allPrecWith ReadPrec e
parser = ReadP [e] -> ReadPrec [e]
forall a. ReadP a -> ReadPrec a
lift (ReadP e -> ReadP () -> ReadP [e]
forall a end. ReadP a -> ReadP end -> ReadP [a]
manyTill ReadP e
reader ReadP ()
eof)
  where
    reader :: ReadP e
reader = ReadPrec e -> Prec -> ReadP e
forall a. ReadPrec a -> Prec -> ReadP a
readPrec_to_P ReadPrec e
parser Prec
0

-- | @'namedPrec' readprec name@ is 'readPrec' with optional @name@ prefix.
namedPrec :: ReadPrec e -> String -> ReadPrec e
namedPrec :: ReadPrec e -> String -> ReadPrec e
namedPrec ReadPrec e
parser String
name =
  let named :: ReadPrec e
named = Prec -> ReadPrec () -> ReadPrec ()
forall a. Prec -> ReadPrec a -> ReadPrec a
prec Prec
appPrec (Lexeme -> ReadPrec ()
expectPrec (Lexeme -> ReadPrec ()) -> Lexeme -> ReadPrec ()
forall a b. (a -> b) -> a -> b
$ String -> Lexeme
Ident String
name) ReadPrec () -> ReadPrec e -> ReadPrec e
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadPrec e
parser
  in  ReadPrec e
named ReadPrec e -> ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ ReadPrec e
parser

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

-- | 'read' with implicit default value.
readDef :: (Read e, Default e) => String -> e
readDef :: String -> e
readDef =  (e
forall a. Default a => a
def e -> Maybe e -> e
forall a. a -> Maybe a -> a
+?) (Maybe e -> e) -> (String -> Maybe e) -> String -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe e
forall a. Read a => String -> Maybe a
readMaybe

-- | 'readBy' with implicit default value.
readDefBy :: (Default e) => ReadPrec e -> String -> e
readDefBy :: ReadPrec e -> String -> e
readDefBy =  (e
forall a. Default a => a
def e -> Maybe e -> e
forall a. a -> Maybe a -> a
+?) (Maybe e -> e)
-> (ReadPrec e -> String -> Maybe e) -> ReadPrec e -> String -> e
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... ReadPrec e -> String -> Maybe e
forall e. ReadPrec e -> String -> Maybe e
readMaybeBy

-- | 'readBy' is generalized 'read'.
readBy :: ReadPrec e -> String -> e
readBy :: ReadPrec e -> String -> e
readBy ReadPrec e
parser String
string = case ReadPrec e -> String -> Either String e
forall e. ReadPrec e -> String -> Either String e
readEitherBy ReadPrec e
parser String
string of
  Left String
msg -> String -> e
forall a. HasCallStack => String -> a
error String
msg
  Right  e
x -> e
x

-- | 'readMaybeBy' is generalized 'readMaybe'.
readMaybeBy :: ReadPrec e -> String -> Maybe e
readMaybeBy :: ReadPrec e -> String -> Maybe e
readMaybeBy ReadPrec e
parser String
string = case ReadPrec e -> Prec -> ReadS e
forall a. ReadPrec a -> Prec -> ReadS a
readPrec_to_S ReadPrec e
read' Prec
minPrec String
string of
    [(e
x, String
"")] -> e -> Maybe e
forall a. a -> Maybe a
Just e
x
    [(e, String)]
_         -> Maybe e
forall a. Maybe a
Nothing
  where
    read' :: ReadPrec e
read' = do e
x <- ReadPrec e
parser; ReadP () -> ReadPrec ()
forall a. ReadP a -> ReadPrec a
lift ReadP ()
skipSpaces; e -> ReadPrec e
forall (m :: * -> *) a. Monad m => a -> m a
return e
x

-- | 'readEitherBy' is generalized 'readEither'.
readEitherBy :: ReadPrec e -> String -> Either String e
readEitherBy :: ReadPrec e -> String -> Either String e
readEitherBy ReadPrec e
parser String
string = case ReadPrec e -> Prec -> ReadS e
forall a. ReadPrec a -> Prec -> ReadS a
readPrec_to_S ReadPrec e
read' Prec
minPrec String
string of
    [(e
x, String
"")] -> e -> Either String e
forall a b. b -> Either a b
Right e
x
    []        -> String -> Either String e
forall a b. a -> Either a b
Left String
"SDP.Internal.Read.readBy: no parse"
    [(e, String)]
_         -> String -> Either String e
forall a b. a -> Either a b
Left String
"SDP.Internal.Read.readBy: ambiguous parse"
  where
    read' :: ReadPrec e
read' = do e
x <- ReadPrec e
parser; ReadP () -> ReadPrec ()
forall a. ReadP a -> ReadPrec a
lift ReadP ()
skipSpaces; e -> ReadPrec e
forall (m :: * -> *) a. Monad m => a -> m a
return e
x

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

fromPrec_ :: (Read e, Enum e) => ReadPrec [e]
fromPrec_ :: ReadPrec [e]
fromPrec_ =  do
  e
fr <- ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
step ReadPrec e
forall a. Read a => ReadPrec a
readPrec)
  Lexeme -> ReadPrec ()
expectPrec (String -> Lexeme
Punc String
"..")
  [e] -> ReadPrec [e]
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> [e]
forall a. Enum a => a -> [a]
enumFrom e
fr)

fromToPrec_ :: (Read e, Enum e) => ReadPrec [e]
fromToPrec_ :: ReadPrec [e]
fromToPrec_ =  do
  e
fr <- ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
step ReadPrec e
forall a. Read a => ReadPrec a
readPrec)
  Lexeme -> ReadPrec ()
expectPrec (String -> Lexeme
Punc String
"..")
  e
to <- ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
step ReadPrec e
forall a. Read a => ReadPrec a
readPrec)
  [e] -> ReadPrec [e]
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> e -> [e]
forall a. Enum a => a -> a -> [a]
enumFromTo e
fr e
to)

fromThenPrec_ :: (Read e, Enum e) => ReadPrec [e]
fromThenPrec_ :: ReadPrec [e]
fromThenPrec_ =  do
  e
fr <- ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
step ReadPrec e
forall a. Read a => ReadPrec a
readPrec)
  Lexeme -> ReadPrec ()
expectPrec (String -> Lexeme
Punc  String
",")
  e
th <- ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
step ReadPrec e
forall a. Read a => ReadPrec a
readPrec)
  Lexeme -> ReadPrec ()
expectPrec (String -> Lexeme
Punc String
"..")
  [e] -> ReadPrec [e]
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> e -> [e]
forall a. Enum a => a -> a -> [a]
enumFromThen e
fr e
th)

fromThenToPrec_ :: (Read e, Enum e) => ReadPrec [e]
fromThenToPrec_ :: ReadPrec [e]
fromThenToPrec_ =  do
  e
fr <- ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
step ReadPrec e
forall a. Read a => ReadPrec a
readPrec)
  Lexeme -> ReadPrec ()
expectPrec (String -> Lexeme
Punc  String
",")
  e
th <- ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
step ReadPrec e
forall a. Read a => ReadPrec a
readPrec)
  Lexeme -> ReadPrec ()
expectPrec (String -> Lexeme
Punc String
"..")
  e
to <- ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec e -> ReadPrec e
forall a. ReadPrec a -> ReadPrec a
step ReadPrec e
forall a. Read a => ReadPrec a
readPrec)
  [e] -> ReadPrec [e]
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> e -> e -> [e]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo e
fr e
th e
to)

parens' :: ReadPrec e -> ReadPrec e
parens' :: ReadPrec e -> ReadPrec e
parens' ReadPrec e
parser = do
  Lexeme -> ReadPrec ()
expectPrec (String -> Lexeme
Punc String
"[")
  e
value <- ReadPrec e
parser
  Lexeme -> ReadPrec ()
expectPrec (String -> Lexeme
Punc String
"]")
  e -> ReadPrec e
forall (m :: * -> *) a. Monad m => a -> m a
return e
value