{-# LANGUAGE TupleSections #-}

-- |
-- The ConditionalRestriction library offers functionality for parsing and
-- evaluating of conditional restriction values
-- (see [OSM Wiki](https://wiki.openstreetmap.org/wiki/Conditional_restrictions)).
--
-- This module offers functions suitable for most basic use cases.
module ConditionalRestriction
  ( needsData,
    evaluate,
    parseRestriction,
    ID,
    Value (..),
    Type (..),
    Token,
    Result (..),
    ErrorMsg,
  )
where

import ConditionalRestriction.Internal.Evaluate
  ( ErrorMsg,
    result,
  )
import ConditionalRestriction.Internal.Parse.ParserLib (end, parse)
import ConditionalRestriction.Internal.Parse.RestrictionParser
  ( pConditionalRestriction,
  )
import ConditionalRestriction.Parse.AST
  ( ConditionalRestriction,
    Token,
  )
import ConditionalRestriction.Parse.InputData
  ( ID,
    Type (..),
    Value (..),
  )
import ConditionalRestriction.Parse.InputDataParser (pValue)
import ConditionalRestriction.Result (Result (..))
import Data.Bifunctor (Bifunctor (first))

-- | Takes a conditional restriction string and returns the data needed in order to evaluate this string.
-- If the conditional restriction couldn't be parsed,
-- an error message is returned instead.
needsData :: String -> Result ErrorMsg [(ID, Type)]
needsData :: ErrorMsg -> Result ErrorMsg [(ErrorMsg, Type)]
needsData ErrorMsg
s =
  ErrorMsg -> Result ErrorMsg ConditionalRestriction
parseRestriction ErrorMsg
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ConditionalRestriction
r -> case [(ErrorMsg, Value)]
-> ConditionalRestriction
-> Result ([ErrorMsg], [(ErrorMsg, Type)]) (Maybe ErrorMsg)
result [] ConditionalRestriction
r of
    Err ([ErrorMsg]
_, [(ErrorMsg, Type)]
neededs) -> forall e a. a -> Result e a
Ok [(ErrorMsg, Type)]
neededs
    Ok Maybe ErrorMsg
_ -> forall e a. a -> Result e a
Ok []

-- | Takes a conditional restriction string and some input data.
-- It returns the value as a token if any restriction condition was met, or 'Nothing' otherwise.
-- If there was a parsing error or a problem with the provided data, a list of error messages
-- and a list of needed data is returned.
evaluate :: String -> [(ID, String)] -> Result ([ErrorMsg], [(ID, Type)]) (Maybe Token)
evaluate :: ErrorMsg
-> [(ErrorMsg, ErrorMsg)]
-> Result ([ErrorMsg], [(ErrorMsg, Type)]) (Maybe ErrorMsg)
evaluate ErrorMsg
s [(ErrorMsg, ErrorMsg)]
ds = do
  ConditionalRestriction
r <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\ErrorMsg
msg -> ([ErrorMsg
"Parser error in restriction: " forall a. [a] -> [a] -> [a]
++ ErrorMsg
msg], [])) forall a b. (a -> b) -> a -> b
$ ErrorMsg -> Result ErrorMsg ConditionalRestriction
parseRestriction ErrorMsg
s
  [(ErrorMsg, Value)]
ds' <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\ErrorMsg
msg -> ([ErrorMsg
"Parser error in data: " forall a. [a] -> [a] -> [a]
++ ErrorMsg
msg], [])) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(ErrorMsg
id, ErrorMsg
d) -> (ErrorMsg
id,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i a. Parser i a -> i -> Result ErrorMsg (a, i)
parse (Parser ErrorMsg Value
pValue forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ErrorMsg ()
end) ErrorMsg
d) [(ErrorMsg, ErrorMsg)]
ds
  [(ErrorMsg, Value)]
-> ConditionalRestriction
-> Result ([ErrorMsg], [(ErrorMsg, Type)]) (Maybe ErrorMsg)
result [(ErrorMsg, Value)]
ds' ConditionalRestriction
r

-- | Takes a conditional restriction string and returns the corresponding AST.
-- Take a look at the "ConditionalRestriction.Parse.AST" module for AST manipulation.
parseRestriction :: String -> Result ErrorMsg ConditionalRestriction
parseRestriction :: ErrorMsg -> Result ErrorMsg ConditionalRestriction
parseRestriction = 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 i a. Parser i a -> i -> Result ErrorMsg (a, i)
parse (Parser ErrorMsg ConditionalRestriction
pConditionalRestriction forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ErrorMsg ()
end)