packages feed

lens-toml-parser-0.3.0.2: src/Toml/Lens.hs

-- |
-- Module      : Toml.Lens
-- Description : Lenses for toml-parser
-- Copyright   : (c) 2017-2025, Henry Till
-- License     : ISC
-- Maintainer  : henrytill@gmail.com
-- Stability   : experimental
--
-- Lenses for <https://hackage.haskell.org/package/toml-parser toml-parser>.
module Toml.Lens
  ( -- * Unannotated
    _Table,
    _List,
    _Double,
    _Integer,
    _Text,
    _Bool,
    _ZonedTime,
    _LocalTime,
    _Day,
    _TimeOfDay,

    -- * Annotated
    _Table',
    _List',
    _Double',
    _Integer',
    _Text',
    _Bool',
    _ZonedTime',
    _LocalTime',
    _Day',
    _TimeOfDay',
  )
where

import Data.Profunctor
import Data.Text (Text)
import qualified Data.Time as Time
import Toml

--
-- With help from:
-- <https://github.com/ekmett/lens/wiki/How-can-I-write-lenses-without-depending-on-lens%3F>
--
-- @
-- type Prism s t a b = (Choice p, Applicative f) => p a (f b) -> p s (f t)
-- @
--
-- @
-- type Prism' s a = Prism s s a a
-- @
--

prism ::
  (Choice p, Applicative f) =>
  (b -> t) ->
  (s -> Either t a) ->
  p a (f b) ->
  p s (f t)
prism bt seta = dimap seta (either pure (fmap bt)) . right'
{-# INLINE prism #-}

-- | @_Table :: Prism' Value Table@
_Table ::
  (Choice p, Applicative f) =>
  p Table (f Table) ->
  p Value (f Value)
_Table =
  prism Table $ \n -> case n of
    Table v -> Right v
    _ -> Left n
{-# INLINE _Table #-}

-- | @_List :: Prism' Value [Value]@
_List ::
  (Choice p, Applicative f) =>
  p [Value] (f [Value]) ->
  p Value (f Value)
_List =
  prism List $ \n -> case n of
    List v -> Right v
    _ -> Left n
{-# INLINE _List #-}

-- | @_Double :: Prism' Value Double@
_Double ::
  (Choice p, Applicative f) =>
  p Double (f Double) ->
  p Value (f Value)
_Double =
  prism Double $ \n -> case n of
    Double v -> Right v
    _ -> Left n
{-# INLINE _Double #-}

-- | @_Integer :: Prism' Value Integer@
_Integer ::
  (Choice p, Applicative f) =>
  p Integer (f Integer) ->
  p Value (f Value)
_Integer =
  prism Integer $ \n -> case n of
    Integer v -> Right v
    _ -> Left n
{-# INLINE _Integer #-}

-- | @_Text :: Prism' Value Text@
_Text ::
  (Choice p, Applicative f) =>
  p Text (f Text) ->
  p Value (f Value)
_Text =
  prism Text $ \n -> case n of
    Text v -> Right v
    _ -> Left n
{-# INLINE _Text #-}

-- | @_Bool :: Prism' Value Bool@
_Bool ::
  (Choice p, Applicative f) =>
  p Bool (f Bool) ->
  p Value (f Value)
_Bool =
  prism Bool $ \n -> case n of
    Bool v -> Right v
    _ -> Left n
{-# INLINE _Bool #-}

-- | @_ZonedTime :: Prism' Value Time.ZonedTime@
_ZonedTime ::
  (Choice p, Applicative f) =>
  p Time.ZonedTime (f Time.ZonedTime) ->
  p Value (f Value)
_ZonedTime =
  prism ZonedTime $ \n -> case n of
    ZonedTime v -> Right v
    _ -> Left n
{-# INLINE _ZonedTime #-}

-- | @_LocalTime :: Prism' Value Time.LocalTime@
_LocalTime ::
  (Choice p, Applicative f) =>
  p Time.LocalTime (f Time.LocalTime) ->
  p Value (f Value)
_LocalTime =
  prism LocalTime $ \n -> case n of
    LocalTime v -> Right v
    _ -> Left n
{-# INLINE _LocalTime #-}

-- | @_Day :: Prism' Value Time.Day@
_Day ::
  (Choice p, Applicative f) =>
  p Time.Day (f Time.Day) ->
  p Value (f Value)
_Day =
  prism Day $ \n -> case n of
    Day v -> Right v
    _ -> Left n
{-# INLINE _Day #-}

-- | @_TimeOfDay :: Prism' Value Time.TimeOfDay@
_TimeOfDay ::
  (Choice p, Applicative f) =>
  p Time.TimeOfDay (f Time.TimeOfDay) ->
  p Value (f Value)
_TimeOfDay =
  prism TimeOfDay $ \n -> case n of
    TimeOfDay v -> Right v
    _ -> Left n
{-# INLINE _TimeOfDay #-}

-- | @_Table' :: Prism' (Value' a) (a, Table' a)@
_Table' ::
  (Choice p, Applicative f) =>
  p (a, Table' a) (f (a, Table' a)) ->
  p (Value' a) (f (Value' a))
_Table' =
  prism (uncurry Table') $ \n -> case n of
    Table' a v -> Right (a, v)
    _ -> Left n
{-# INLINE _Table' #-}

-- | @_Array' :: Prism' (Value' a) (a, [Value' a])@
_List' ::
  (Choice p, Applicative f) =>
  p (a, [Value' a]) (f (a, [Value' a])) ->
  p (Value' a) (f (Value' a))
_List' =
  prism (uncurry List') $ \n -> case n of
    List' a v -> Right (a, v)
    _ -> Left n
{-# INLINE _List' #-}

-- | @_Double' :: Prism' (Value' a) (a, Double)@
_Double' ::
  (Choice p, Applicative f) =>
  p (a, Double) (f (a, Double)) ->
  p (Value' a) (f (Value' a))
_Double' =
  prism (uncurry Double') $ \n -> case n of
    Double' a v -> Right (a, v)
    _ -> Left n
{-# INLINE _Double' #-}

-- | @_Integer' :: Prism' (Value' a) (a, Integer)@
_Integer' ::
  (Choice p, Applicative f) =>
  p (a, Integer) (f (a, Integer)) ->
  p (Value' a) (f (Value' a))
_Integer' =
  prism (uncurry Integer') $ \n -> case n of
    Integer' a v -> Right (a, v)
    _ -> Left n
{-# INLINE _Integer' #-}

-- | @_Text' :: Prism' (Value' a) (a, Text)@
_Text' ::
  (Choice p, Applicative f) =>
  p (a, Text) (f (a, Text)) ->
  p (Value' a) (f (Value' a))
_Text' =
  prism (uncurry Text') $ \n -> case n of
    Text' a v -> Right (a, v)
    _ -> Left n
{-# INLINE _Text' #-}

-- | @_Bool' :: Prism' (Value' a) (a, Bool)@
_Bool' ::
  (Choice p, Applicative f) =>
  p (a, Bool) (f (a, Bool)) ->
  p (Value' a) (f (Value' a))
_Bool' =
  prism (uncurry Bool') $ \n -> case n of
    Bool' a v -> Right (a, v)
    _ -> Left n
{-# INLINE _Bool' #-}

-- | @_ZonedTime' :: Prism' (Value' a) (a, Time.ZonedTime)@
_ZonedTime' ::
  (Choice p, Applicative f) =>
  p (a, Time.ZonedTime) (f (a, Time.ZonedTime)) ->
  p (Value' a) (f (Value' a))
_ZonedTime' =
  prism (uncurry ZonedTime') $ \n -> case n of
    ZonedTime' a v -> Right (a, v)
    _ -> Left n
{-# INLINE _ZonedTime' #-}

-- | @_LocalTime' :: Prism' (Value' a) (a, Time.LocalTime)@
_LocalTime' ::
  (Choice p, Applicative f) =>
  p (a, Time.LocalTime) (f (a, Time.LocalTime)) ->
  p (Value' a) (f (Value' a))
_LocalTime' =
  prism (uncurry LocalTime') $ \n -> case n of
    LocalTime' a v -> Right (a, v)
    _ -> Left n
{-# INLINE _LocalTime' #-}

-- | @_Day' :: Prism' (Value' a) (a, Time.Day)@
_Day' ::
  (Choice p, Applicative f) =>
  p (a, Time.Day) (f (a, Time.Day)) ->
  p (Value' a) (f (Value' a))
_Day' =
  prism (uncurry Day') $ \n -> case n of
    Day' a v -> Right (a, v)
    _ -> Left n
{-# INLINE _Day' #-}

-- | @_TimeOfDay' :: Prism' (Value' a) (a, Time.TimeOfDay)@
_TimeOfDay' ::
  (Choice p, Applicative f) =>
  p (a, Time.TimeOfDay) (f (a, Time.TimeOfDay)) ->
  p (Value' a) (f (Value' a))
_TimeOfDay' =
  prism (uncurry TimeOfDay') $ \n -> case n of
    TimeOfDay' a v -> Right (a, v)
    _ -> Left n
{-# INLINE _TimeOfDay' #-}