-- | A very simple Lens implementation
module GHC.Toolchain.Lens
    ( Lens(..)
    , (%)
    , over
    , (%++)
    , (&)
    ) where

import Prelude ((.), ($), (++))
import Data.Function ((&))

data Lens a b = Lens { forall a b. Lens a b -> a -> b
view :: (a -> b), forall a b. Lens a b -> b -> a -> a
set :: (b -> a -> a) }

(%) :: Lens a b -> Lens b c -> Lens a c
Lens a b
a % :: forall a b c. Lens a b -> Lens b c -> Lens a c
% Lens b c
b = Lens { view :: a -> c
view = Lens b c -> b -> c
forall a b. Lens a b -> a -> b
view Lens b c
b (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens a b -> a -> b
forall a b. Lens a b -> a -> b
view Lens a b
a
             , set :: c -> a -> a
set = \c
y a
x -> Lens a b -> b -> a -> a
forall a b. Lens a b -> b -> a -> a
set Lens a b
a (Lens b c -> c -> b -> b
forall a b. Lens a b -> b -> a -> a
set Lens b c
b c
y (Lens a b -> a -> b
forall a b. Lens a b -> a -> b
view Lens a b
a a
x)) a
x
             }

over :: Lens a b -> (b -> b) -> a -> a
over :: forall a b. Lens a b -> (b -> b) -> a -> a
over Lens a b
l b -> b
f a
x = Lens a b -> b -> a -> a
forall a b. Lens a b -> b -> a -> a
set Lens a b
l (b -> b
f (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Lens a b -> a -> b
forall a b. Lens a b -> a -> b
view Lens a b
l a
x) a
x

-- | Append @b@ to @[b]@
--
-- Example usage:
-- @@
-- cc & _ccProgram % _prgFlags %++ "-U__i686"
-- @@
(%++) :: Lens a [b] -> b -> (a -> a)
%++ :: forall a b. Lens a [b] -> b -> a -> a
(%++) Lens a [b]
l b
el = Lens a [b] -> ([b] -> [b]) -> a -> a
forall a b. Lens a b -> (b -> b) -> a -> a
over Lens a [b]
l ([b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++[b
el])