{- |
Support for creating Show instances using the accessors.
-}
module Data.Accessor.Show (field, showsPrec) where

import qualified Data.Accessor.Basic as Accessor

import Data.Maybe (catMaybes)

-- import qualified Text.Show as Show
import qualified Prelude as Show
import Prelude hiding (showsPrec)


toMaybe :: Bool -> a -> Maybe a
toMaybe :: Bool -> a -> Maybe a
toMaybe Bool
False a
_ = Maybe a
forall a. Maybe a
Nothing
toMaybe Bool
True  a
x = a -> Maybe a
forall a. a -> Maybe a
Just a
x

field :: (Show a, Eq a) =>
   String -> Accessor.T r a -> r -> r -> Maybe ShowS
field :: String -> T r a -> r -> r -> Maybe ShowS
field String
name T r a
acc r
deflt r
record =
   let x :: a
x = T r a -> r -> a
forall r a. T r a -> r -> a
Accessor.get T r a
acc r
record
   in  Bool -> ShowS -> Maybe ShowS
forall a. Bool -> a -> Maybe a
toMaybe
          (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= T r a -> r -> a
forall r a. T r a -> r -> a
Accessor.get T r a
acc r
deflt)
          (String -> ShowS
showString String
name ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" ^= " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
Show.showsPrec Int
5 a
x)

showsPrec ::
   [r -> r -> Maybe ShowS] -> String -> r -> Int -> r -> ShowS
showsPrec :: [r -> r -> Maybe ShowS] -> String -> r -> Int -> r -> ShowS
showsPrec [r -> r -> Maybe ShowS]
fields String
defltName r
deflt Int
p r
record =
   let calls :: [ShowS]
calls =
          [Maybe ShowS] -> [ShowS]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ShowS] -> [ShowS]) -> [Maybe ShowS] -> [ShowS]
forall a b. (a -> b) -> a -> b
$
          ((r -> r -> Maybe ShowS) -> Maybe ShowS)
-> [r -> r -> Maybe ShowS] -> [Maybe ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (\r -> r -> Maybe ShowS
f -> r -> r -> Maybe ShowS
f r
deflt r
record) ([r -> r -> Maybe ShowS] -> [Maybe ShowS])
-> [r -> r -> Maybe ShowS] -> [Maybe ShowS]
forall a b. (a -> b) -> a -> b
$
          [r -> r -> Maybe ShowS]
fields
   in  if [ShowS] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ShowS]
calls
         then String -> ShowS
showString String
defltName
         else Bool -> ShowS -> ShowS
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0)
                 ((ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                     (\ShowS
acc ShowS
s -> ShowS
acc ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" $ " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s)
                     (String -> ShowS
showString String
defltName)
                     [ShowS]
calls)