-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Util
-- Copyright   :  (C) 2016-2026 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- = Overview
--
-- "Miso.Util" provides general-purpose combinators shared across miso's
-- internal modules and available to application code. It is re-exported
-- by "Miso".
--
-- = View helpers
--
-- * 'withFoldable' — @map@ over any 'Foldable' to produce a list of
--   views; particularly handy for @Maybe@:
--
-- @
-- 'withFoldable' (model ^. mAlert) $ \\msg ->
--   'Miso.Html.Element.div_' [ 'Miso.Html.Property.class_' \"alert\" ] [ 'Miso.text' msg ]
-- @
--
-- * 'conditionalViews' — include a list of views only when a condition
--   is 'True'; returns @[]@ otherwise:
--
-- @
-- 'conditionalViews' isLoggedIn
--   [ 'Miso.Html.Element.button_' [ 'Miso.Html.Event.onClick' Logout ] [ 'Miso.text' \"Log out\" ] ]
-- @
--
-- = Parser \/ lexer combinators
--
-- These 'Control.Applicative.Alternative'-polymorphic combinators work
-- with both 'Miso.Util.Lexer.Lexer' and 'Miso.Util.Parser.Parser':
--
-- * 'oneOf' — try alternatives in order, succeeding on the first match
--   (analogous to 'Data.Foldable.asum')
-- * 'sepBy' / 'sepBy1' — parse a list interleaved with a separator
-- * 'enclosed' — parse something between two delimiters (@l *> x \<* r@)
-- * 'between' — parse two things separated by a third, returning a pair
-- * 'optionalDefault' — parse with a fallback default on failure
-- * 'exists' — test whether a combinator succeeds, returning 'Bool'
--
-- = Miscellaneous
--
-- * '(=:)' — infix tuple constructor for key-value pairs:
--   @\"key\" '=:' value@
-- * 'compose' — forward function composition generalised to any
--   'Control.Category.Category': @f \`compose\` g = g . f@
--
-- = See also
--
-- * "Miso.Util.Lexer" — the 'Miso.Util.Lexer.Lexer' combinator library
-- * "Miso.Util.Parser" — the 'Miso.Util.Parser.Parser' combinator library
----------------------------------------------------------------------------
module Miso.Util
  ( withFoldable
  , conditionalViews
  , oneOf
  , enclosed
  , optionalDefault
  , exists
  , sepBy1
  , sepBy
  , between
  , (=:)
  , compose
  ) where
-----------------------------------------------------------------------------
import           Control.Category
import           Data.Maybe (isJust, fromMaybe)
import           Control.Applicative (Alternative, many, empty, (<|>), optional)
import           Data.Foldable (toList)
import           Prelude hiding ((.))
-----------------------------------------------------------------------------
-- | Generic @map@ function, useful for creating @View@s from the elements of
-- some @Foldable@. Particularly handy for @Maybe@, as shown in the example
-- below.
--
-- @
-- view model =
--     div_ [] $
--      withFoldable (model ^. mSomeMaybeVal) $ \\someVal ->
--         p_ [] [ text $ "Hey, look at this value: " <> ms (show someVal) ]
-- @
withFoldable
  :: Foldable t
  => t a
  -- ^ Container to map over (e.g. @Maybe@, @[]@)
  -> (a -> b)
  -- ^ Function to apply to each element
  -> [b]
withFoldable :: forall (t :: * -> *) a b. Foldable t => t a -> (a -> b) -> [b]
withFoldable t a
ta a -> b
f = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f (t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
ta)
-----------------------------------------------------------------------------
-- | Conditionally includes views.
-- Hides the 'Miso.Types.View's if the condition is False. Shows them when the condition
-- is True.
conditionalViews
  :: Bool
  -- ^ When 'True' the views are included; when 'False' an empty list is returned
  -> [view]
  -- ^ Views to include conditionally
  -> [view]
conditionalViews :: forall view. Bool -> [view] -> [view]
conditionalViews Bool
condition [view]
views =
    if Bool
condition
    then [view]
views
    else []
-----------------------------------------------------------------------------
-- | Selects the first 'Alternative', analogous to 'Data.Foldable.asum'.
oneOf :: Alternative f => [f a] -> f a
oneOf :: forall (f :: * -> *) a. Alternative f => [f a] -> f a
oneOf = (f a -> f a -> f a) -> f a -> [f a] -> f a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) f a
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty
----------------------------------------------------------------------------
-- | Convenience function for constructing parser / lexer combinators.
--
-- @
-- test :: Parser a -> Parser a
-- test = enclosed (char '(') (char ')')
-- @
enclosed
  :: Applicative f
  => f a
  -- ^ Opening delimiter (e.g. @char '('@)
  -> f b
  -- ^ Closing delimiter (e.g. @char ')'@)
  -> f c
  -- ^ Inner parser\/lexer whose result is returned
  -> f c
enclosed :: forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> f c -> f c
enclosed f a
l f b
r f c
x = f a
l f a -> f c -> f c
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f c
x f c -> f b -> f c
forall a b. f a -> f b -> f a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* f b
r
----------------------------------------------------------------------------
-- | Allow the specification of default values during parsing / lexing
-- in the case of parser / lexer failure.
--
-- @
-- test :: Parser MisoString
-- test = optionalDefault "foo" (string "bar")
-- @
optionalDefault
  :: Alternative f
  => b
  -- ^ Default value to use when the parser\/lexer fails
  -> f b
  -- ^ Parser\/lexer to attempt
  -> f b
optionalDefault :: forall (f :: * -> *) b. Alternative f => b -> f b -> f b
optionalDefault b
def f b
p = b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
def (Maybe b -> b) -> f (Maybe b) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b -> f (Maybe b)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional f b
p
----------------------------------------------------------------------------
-- | Combinator for testing parsing / lexing failure on any input.
--
-- @
-- test :: Parser Bool
-- test = exists (string "foo")
-- @
exists :: Alternative f => f a -> f Bool
exists :: forall (f :: * -> *) a. Alternative f => f a -> f Bool
exists f a
p = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> f (Maybe a) -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> f (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional f a
p
----------------------------------------------------------------------------
-- | Interleaves one parser combinator with another, must have at least one
-- successful parse.
--
-- @
-- test :: Parser [Int]
-- test = sepBy1 (char ',') number
-- @
sepBy1
  :: Alternative m
  => m sep
  -- ^ Separator parser\/lexer (result discarded)
  -> m a
  -- ^ Element parser\/lexer
  -> m [a]
sepBy1 :: forall (m :: * -> *) sep a. Alternative m => m sep -> m a -> m [a]
sepBy1 m sep
sep m a
p = (:) (a -> [a] -> [a]) -> m a -> m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
p m ([a] -> [a]) -> m [a] -> m [a]
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a -> m [a]
forall a. m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (m sep
sep m sep -> m a -> m a
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a
p)
----------------------------------------------------------------------------
-- | Interleaves one parser combinator with another, may not have any successful
-- parses.
--
-- @
-- test :: Parser [Int]
-- test = sepBy (char ',') number
-- @
sepBy
  :: Alternative m
  => m sep
  -- ^ Separator parser\/lexer (result discarded)
  -> m a
  -- ^ Element parser\/lexer
  -> m [a]
sepBy :: forall (m :: * -> *) sep a. Alternative m => m sep -> m a -> m [a]
sepBy m sep
sep m a
p = m sep -> m a -> m [a]
forall (m :: * -> *) sep a. Alternative m => m sep -> m a -> m [a]
sepBy1 m sep
sep m a
p m [a] -> m [a] -> m [a]
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
----------------------------------------------------------------------------
-- | Successfully parses the arguments between another combinator
--
-- @
-- test :: Parser (Int, Int)
-- test = between (char '*') number number
-- -- 5*5
-- @
between
  :: Applicative f
  => f a
  -- ^ Separator between the two elements (result discarded)
  -> f b
  -- ^ Left element parser\/lexer
  -> f c
  -- ^ Right element parser\/lexer
  -> f (b, c)
between :: forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> f c -> f (b, c)
between f a
c f b
l f c
r = (,) (b -> c -> (b, c)) -> f b -> f (c -> (b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
l f (c -> (b, c)) -> f c -> f (b, c)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (f a
c f a -> f c -> f c
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f c
r)
----------------------------------------------------------------------------
-- | Tuple constructor, useful for constructing key-value pairs.
--
(=:) :: k -> v -> (k, v)
k
k =: :: forall a b. a -> b -> (a, b)
=: v
v = (k
k,v
v)
----------------------------------------------------------------------------
-- | Function composition generalized to 'Category'
--
-- @
-- test :: Int -> Int
-- test = (+1) \`compose\` (+1)
-- @
compose :: Category cat => cat a b -> cat b c -> cat a c
compose :: forall (cat :: * -> * -> *) a b c.
Category cat =>
cat a b -> cat b c -> cat a c
compose = (cat b c -> cat a b -> cat a c) -> cat a b -> cat b c -> cat a c
forall a b c. (a -> b -> c) -> b -> a -> c
flip cat b c -> cat a b -> cat a c
forall b c a. cat b c -> cat a b -> cat a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.)
----------------------------------------------------------------------------