{-# LANGUAGE CPP                 #-}
{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE DefaultSignatures   #-}
{-# LANGUAGE EmptyCase           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators       #-}
-- | A 'ToExpr' class.
module Data.TreeDiff.Class (
    ediff,
    ediff',
    ToExpr (..),
    defaultExprViaShow,
    -- * Generics
    genericToExpr,
    GToExpr,
    ) where

import Data.Foldable (toList)
import Data.List     (sort, uncons)
import Data.Proxy    (Proxy (..))
import GHC.Generics
       (Constructor (..), Generic (..), K1 (..), M1 (..), Selector (..),
       U1 (..), V1, (:*:) (..), (:+:) (..))

import qualified Data.Map           as Map
import qualified Data.TreeDiff.OMap as OMap

import Data.TreeDiff.Expr

-- Instances
import Control.Applicative   (Const (..), ZipList (..))
import Data.Fixed            (Fixed, HasResolution)
import Data.Functor.Identity (Identity (..))
import Data.Int
import Data.List.NonEmpty    (NonEmpty (..))
import Data.Void             (Void)
import Data.Word
import Numeric.Natural       (Natural)

import qualified Data.Monoid    as Mon
import qualified Data.Ratio     as Ratio
import qualified Data.Semigroup as Semi

-- containers
import qualified Data.IntMap   as IntMap
import qualified Data.IntSet   as IntSet
import qualified Data.Sequence as Seq
import qualified Data.Set      as Set
import qualified Data.Tree     as Tree

-- text
import qualified Data.Text      as T
import qualified Data.Text.Lazy as LT

-- time
import qualified Data.Time as Time

-- bytestring
import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy as LBS

import qualified Data.ByteString.Short as SBS

-- scientific
import qualified Data.Scientific as Sci

-- uuid-types
import qualified Data.UUID.Types as UUID

-- vector
import qualified Data.Vector           as V
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Storable  as VS
import qualified Data.Vector.Unboxed   as VU

-- tagged
import Data.Tagged (Tagged (..))

-- hashable
import Data.Hashable (Hashed, unhashed)

-- unordered-containers
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet        as HS

-- aeson
import qualified Data.Aeson        as Aeson
import qualified Data.Aeson.Key    as Key
import qualified Data.Aeson.KeyMap as KM

-- strict
import qualified Data.Strict as Strict

-- these
import Data.These (These (..))

-- primitive
import qualified Data.Primitive  as Prim

-- $setup
-- >>> :set -XDeriveGeneric
-- >>> import Data.Foldable (traverse_)
-- >>> import Data.Ratio ((%))
-- >>> import Data.Time (Day (..))
-- >>> import Data.Scientific (Scientific)
-- >>> import GHC.Generics (Generic)
-- >>> import qualified Data.ByteString.Char8 as BS8
-- >>> import qualified Data.ByteString.Lazy.Char8 as LBS8
-- >>> import Data.TreeDiff.Pretty

-------------------------------------------------------------------------------
-- Code
-------------------------------------------------------------------------------

-- | Difference between two 'ToExpr' values.
--
-- >>> let x = (1, Just 2) :: (Int, Maybe Int)
-- >>> let y = (1, Nothing)
-- >>> prettyEditExpr (ediff x y)
-- _×_ 1 -(Just 2) +Nothing
--
-- >>> data Foo = Foo { fooInt :: Either Char Int, fooBool :: [Maybe Bool], fooString :: String } deriving (Eq, Generic)
-- >>> instance ToExpr Foo
--
-- >>> prettyEditExpr $ ediff (Foo (Right 2) [Just True] "fo") (Foo (Right 3) [Just True] "fo")
-- Foo {fooInt = Right -2 +3, fooBool = [Just True], fooString = "fo"}
--
-- >>> prettyEditExpr $ ediff (Foo (Right 42) [Just True, Just False] "old") (Foo (Right 42) [Nothing, Just False, Just True] "new")
-- Foo {
--   fooInt = Right 42,
--   fooBool = [-Just True, +Nothing, Just False, +Just True],
--   fooString = -"old" +"new"}
--
ediff :: ToExpr a => a -> a -> Edit EditExpr
ediff :: forall a. ToExpr a => a -> a -> Edit EditExpr
ediff a
x a
y = Expr -> Expr -> Edit EditExpr
exprDiff (a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
x) (a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
y)

-- | Compare different types.
--
-- /Note:/ Use with care as you can end up comparing apples with oranges.
--
-- >>> prettyEditExpr $ ediff' ["foo", "bar"] [Just "foo", Nothing]
-- [-"foo", +Just "foo", -"bar", +Nothing]
--
ediff' :: (ToExpr a, ToExpr b) => a -> b -> Edit EditExpr
ediff' :: forall a b. (ToExpr a, ToExpr b) => a -> b -> Edit EditExpr
ediff' a
x b
y = Expr -> Expr -> Edit EditExpr
exprDiff (a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
x) (b -> Expr
forall a. ToExpr a => a -> Expr
toExpr b
y)

-- | 'toExpr' converts a Haskell value into
-- untyped Haskell-like syntax tree, 'Expr'.
--
-- >>> toExpr ((1, Just 2) :: (Int, Maybe Int))
-- App "_\215_" [App "1" [],App "Just" [App "2" []]]
--
class ToExpr a where
    toExpr :: a -> Expr
    default toExpr
        :: (Generic a, GToExpr (Rep a))
        => a -> Expr
    toExpr = a -> Expr
forall a. (Generic a, GToExpr (Rep a)) => a -> Expr
genericToExpr

    listToExpr :: [a] -> Expr
    listToExpr = [Expr] -> Expr
Lst ([Expr] -> Expr) -> ([a] -> [Expr]) -> [a] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Expr) -> [a] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map a -> Expr
forall a. ToExpr a => a -> Expr
toExpr

instance ToExpr Expr where
    toExpr :: Expr -> Expr
toExpr = Expr -> Expr
forall a. a -> a
id

-- | An alternative implementation for literal types. We use 'show'
-- representation of them.
defaultExprViaShow :: Show a => a -> Expr
defaultExprViaShow :: forall a. Show a => a -> Expr
defaultExprViaShow a
x = ConstructorName -> [Expr] -> Expr
App (a -> ConstructorName
forall a. Show a => a -> ConstructorName
show a
x) []

-------------------------------------------------------------------------------
-- Generics
-------------------------------------------------------------------------------

class GToExpr f where
    gtoExpr :: f x -> Expr

instance GSumToExpr f => GToExpr (M1 i c f) where
    gtoExpr :: forall x. M1 i c f x -> Expr
gtoExpr (M1 f x
x) = f x -> Expr
forall x. f x -> Expr
forall (f :: * -> *) x. GSumToExpr f => f x -> Expr
gsumToExpr f x
x

class GSumToExpr f where
    gsumToExpr :: f x -> Expr

instance (GSumToExpr f, GSumToExpr g) => GSumToExpr (f :+: g) where
    gsumToExpr :: forall x. (:+:) f g x -> Expr
gsumToExpr (L1 f x
x) = f x -> Expr
forall x. f x -> Expr
forall (f :: * -> *) x. GSumToExpr f => f x -> Expr
gsumToExpr f x
x
    gsumToExpr (R1 g x
x) = g x -> Expr
forall x. g x -> Expr
forall (f :: * -> *) x. GSumToExpr f => f x -> Expr
gsumToExpr g x
x

instance GSumToExpr V1 where
    gsumToExpr :: forall x. V1 x -> Expr
gsumToExpr V1 x
x = case V1 x
x of {}

instance (Constructor c, GProductToExpr f) => GSumToExpr (M1 i c f) where
    gsumToExpr :: forall x. M1 i c f x -> Expr
gsumToExpr z :: M1 i c f x
z@(M1 f x
x) = case f x -> AppOrRec
forall x. f x -> AppOrRec
forall (f :: * -> *) x. GProductToExpr f => f x -> AppOrRec
gproductToExpr f x
x of
        App' [Expr]
exprs   -> ConstructorName -> [Expr] -> Expr
App ConstructorName
cn [Expr]
exprs
        Rec' []      -> ConstructorName -> [Expr] -> Expr
App ConstructorName
cn []
        Rec' [(ConstructorName
_,Expr
e)] -> ConstructorName -> [Expr] -> Expr
App ConstructorName
cn [Expr
e]
        Rec' [(ConstructorName, Expr)]
pairs   -> ConstructorName -> OMap ConstructorName Expr -> Expr
Rec ConstructorName
cn ([(ConstructorName, Expr)] -> OMap ConstructorName Expr
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList [(ConstructorName, Expr)]
pairs)
      where
        cn :: ConstructorName
cn = M1 i c f x -> ConstructorName
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> ConstructorName
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> ConstructorName
conName M1 i c f x
z

class GProductToExpr f where
    gproductToExpr :: f x -> AppOrRec

instance (GProductToExpr f, GProductToExpr g) => GProductToExpr (f :*: g) where
    gproductToExpr :: forall x. (:*:) f g x -> AppOrRec
gproductToExpr (f x
f :*: g x
g) = f x -> AppOrRec
forall x. f x -> AppOrRec
forall (f :: * -> *) x. GProductToExpr f => f x -> AppOrRec
gproductToExpr f x
f AppOrRec -> AppOrRec -> AppOrRec
`combine` g x -> AppOrRec
forall x. g x -> AppOrRec
forall (f :: * -> *) x. GProductToExpr f => f x -> AppOrRec
gproductToExpr g x
g

instance GProductToExpr U1 where
    gproductToExpr :: forall x. U1 x -> AppOrRec
gproductToExpr U1 x
_ = [(ConstructorName, Expr)] -> AppOrRec
Rec' []

instance (Selector s, GLeafToExpr f) => GProductToExpr (M1 i s f) where
    gproductToExpr :: forall x. M1 i s f x -> AppOrRec
gproductToExpr z :: M1 i s f x
z@(M1 f x
x) = case M1 i s f x -> ConstructorName
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> ConstructorName
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> ConstructorName
selName M1 i s f x
z of
        [] -> [Expr] -> AppOrRec
App' [f x -> Expr
forall x. f x -> Expr
forall (f :: * -> *) x. GLeafToExpr f => f x -> Expr
gleafToExpr f x
x]
        ConstructorName
sn -> [(ConstructorName, Expr)] -> AppOrRec
Rec' [(ConstructorName
sn, f x -> Expr
forall x. f x -> Expr
forall (f :: * -> *) x. GLeafToExpr f => f x -> Expr
gleafToExpr f x
x)]

class GLeafToExpr f where
    gleafToExpr :: f x -> Expr

instance ToExpr x => GLeafToExpr (K1 i x) where
    gleafToExpr :: forall x. K1 i x x -> Expr
gleafToExpr (K1 x
x) = x -> Expr
forall a. ToExpr a => a -> Expr
toExpr x
x

data AppOrRec = App' [Expr] | Rec' [(FieldName, Expr)]
  deriving Int -> AppOrRec -> ShowS
[AppOrRec] -> ShowS
AppOrRec -> ConstructorName
(Int -> AppOrRec -> ShowS)
-> (AppOrRec -> ConstructorName)
-> ([AppOrRec] -> ShowS)
-> Show AppOrRec
forall a.
(Int -> a -> ShowS)
-> (a -> ConstructorName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AppOrRec -> ShowS
showsPrec :: Int -> AppOrRec -> ShowS
$cshow :: AppOrRec -> ConstructorName
show :: AppOrRec -> ConstructorName
$cshowList :: [AppOrRec] -> ShowS
showList :: [AppOrRec] -> ShowS
Show

combine :: AppOrRec -> AppOrRec -> AppOrRec
combine :: AppOrRec -> AppOrRec -> AppOrRec
combine (Rec' [(ConstructorName, Expr)]
xs) (Rec' [(ConstructorName, Expr)]
ys) = [(ConstructorName, Expr)] -> AppOrRec
Rec' ([(ConstructorName, Expr)]
xs [(ConstructorName, Expr)]
-> [(ConstructorName, Expr)] -> [(ConstructorName, Expr)]
forall a. [a] -> [a] -> [a]
++ [(ConstructorName, Expr)]
ys)
combine AppOrRec
xs        AppOrRec
ys        = [Expr] -> AppOrRec
App' (AppOrRec -> [Expr]
exprs AppOrRec
xs [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ AppOrRec -> [Expr]
exprs AppOrRec
ys)
  where
    exprs :: AppOrRec -> [Expr]
exprs (App' [Expr]
zs) = [Expr]
zs
    exprs (Rec' [(ConstructorName, Expr)]
zs) = ((ConstructorName, Expr) -> Expr)
-> [(ConstructorName, Expr)] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (ConstructorName, Expr) -> Expr
forall a b. (a, b) -> b
snd [(ConstructorName, Expr)]
zs

-- | Generic 'toExpr'.
--
-- >>> data Foo = Foo Int Char deriving Generic
-- >>> genericToExpr (Foo 42 'x')
-- App "Foo" [App "42" [],App "'x'" []]
--
genericToExpr :: (Generic a, GToExpr (Rep a)) => a -> Expr
genericToExpr :: forall a. (Generic a, GToExpr (Rep a)) => a -> Expr
genericToExpr = Rep a Any -> Expr
forall x. Rep a x -> Expr
forall (f :: * -> *) x. GToExpr f => f x -> Expr
gtoExpr (Rep a Any -> Expr) -> (a -> Rep a Any) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from

-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------

instance ToExpr () where toExpr :: () -> Expr
toExpr = () -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow
instance ToExpr Bool where toExpr :: Bool -> Expr
toExpr = Bool -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow
instance ToExpr Ordering where toExpr :: Ordering -> Expr
toExpr = Ordering -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow

instance ToExpr Integer where toExpr :: Integer -> Expr
toExpr = Integer -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow
instance ToExpr Natural where toExpr :: Natural -> Expr
toExpr = Natural -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow

instance ToExpr Float where toExpr :: Float -> Expr
toExpr = Float -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow
instance ToExpr Double where toExpr :: Double -> Expr
toExpr = Double -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow

instance ToExpr Int where toExpr :: Int -> Expr
toExpr = Int -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow
instance ToExpr Int8 where toExpr :: Int8 -> Expr
toExpr = Int8 -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow
instance ToExpr Int16 where toExpr :: Int16 -> Expr
toExpr = Int16 -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow
instance ToExpr Int32 where toExpr :: Int32 -> Expr
toExpr = Int32 -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow
instance ToExpr Int64 where toExpr :: Int64 -> Expr
toExpr = Int64 -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow

instance ToExpr Word where toExpr :: Word -> Expr
toExpr = Word -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow
instance ToExpr Word8 where toExpr :: Word8 -> Expr
toExpr = Word8 -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow
instance ToExpr Word16 where toExpr :: Word16 -> Expr
toExpr = Word16 -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow
instance ToExpr Word32 where toExpr :: Word32 -> Expr
toExpr = Word32 -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow
instance ToExpr Word64 where toExpr :: Word64 -> Expr
toExpr = Word64 -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow

instance ToExpr (Proxy a) where toExpr :: Proxy a -> Expr
toExpr = Proxy a -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow

-- | >>> prettyExpr $ toExpr 'a'
-- 'a'
--
-- >>> prettyExpr $ toExpr "Hello world"
-- "Hello world"
--
-- >>> prettyExpr $ toExpr "Hello\nworld"
-- concat ["Hello\n", "world"]
--
-- >>> traverse_ (print . prettyExpr . toExpr) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
-- ""
-- "\n"
-- "foo"
-- "foo\n"
-- concat ["foo\n", "bar"]
-- concat ["foo\n", "bar\n"]
--
instance ToExpr Char where
    toExpr :: Char -> Expr
toExpr = Char -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow
    listToExpr :: ConstructorName -> Expr
listToExpr = ConstructorName -> [ConstructorName] -> Expr
forall a. Show a => ConstructorName -> [a] -> Expr
stringToExpr ConstructorName
"concat" ([ConstructorName] -> Expr)
-> (ConstructorName -> [ConstructorName])
-> ConstructorName
-> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstructorName -> Maybe (Char, ConstructorName))
-> ConstructorName -> [ConstructorName]
forall a. (a -> Maybe (Char, a)) -> a -> [ConstructorName]
unconcat ConstructorName -> Maybe (Char, ConstructorName)
forall a. [a] -> Maybe (a, [a])
uncons

stringToExpr
    :: Show a
    => String -- ^ name of concat
    -> [a]
    -> Expr
stringToExpr :: forall a. Show a => ConstructorName -> [a] -> Expr
stringToExpr ConstructorName
_  []  = ConstructorName -> [Expr] -> Expr
App ConstructorName
"\"\"" []
stringToExpr ConstructorName
_  [a
l] = a -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow a
l
stringToExpr ConstructorName
cn [a]
ls  = ConstructorName -> [Expr] -> Expr
App ConstructorName
cn [[Expr] -> Expr
Lst ((a -> Expr) -> [a] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map a -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow [a]
ls)]

-- | Split on '\n'.
--
-- prop> \xs -> xs == concat (unconcat uncons xs)
unconcat :: forall a. (a -> Maybe (Char, a)) -> a -> [String]
unconcat :: forall a. (a -> Maybe (Char, a)) -> a -> [ConstructorName]
unconcat a -> Maybe (Char, a)
uncons_ = a -> [ConstructorName]
go where
    go :: a -> [String]
    go :: a -> [ConstructorName]
go a
xs = case a -> (ConstructorName, a)
span_ a
xs of
        ~(ConstructorName
ys, a
zs)
            | ConstructorName -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ConstructorName
ys   -> []
            | Bool
otherwise -> ConstructorName
ys ConstructorName -> [ConstructorName] -> [ConstructorName]
forall a. a -> [a] -> [a]
: a -> [ConstructorName]
go a
zs

    span_ :: a -> (String, a)
    span_ :: a -> (ConstructorName, a)
span_ a
xs = case a -> Maybe (Char, a)
uncons_ a
xs of
        Maybe (Char, a)
Nothing         -> (ConstructorName
"", a
xs)
        Just ~(Char
x, a
xs')
            | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' -> (ConstructorName
"\n", a
xs')
            | Bool
otherwise -> case a -> (ConstructorName, a)
span_ a
xs' of
            ~(ConstructorName
ys, a
zs) -> (Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ConstructorName
ys, a
zs)

instance ToExpr a => ToExpr (Maybe a) where
    toExpr :: Maybe a -> Expr
toExpr Maybe a
Nothing  = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Nothing" []
    toExpr (Just a
x) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Just" [a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
x]

instance (ToExpr a, ToExpr b) => ToExpr (Either a b) where
    toExpr :: Either a b -> Expr
toExpr (Left a
x)  = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Left"  [a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
x]
    toExpr (Right b
y) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Right" [b -> Expr
forall a. ToExpr a => a -> Expr
toExpr b
y]

instance ToExpr a => ToExpr [a] where
    toExpr :: [a] -> Expr
toExpr = [a] -> Expr
forall a. ToExpr a => [a] -> Expr
listToExpr

instance (ToExpr a, ToExpr b) => ToExpr (a, b) where
    toExpr :: (a, b) -> Expr
toExpr (a
a, b
b) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"_×_" [a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
a, b -> Expr
forall a. ToExpr a => a -> Expr
toExpr b
b]
instance (ToExpr a, ToExpr b, ToExpr c) => ToExpr (a, b, c) where
    toExpr :: (a, b, c) -> Expr
toExpr (a
a, b
b, c
c) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"_×_×_" [a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
a, b -> Expr
forall a. ToExpr a => a -> Expr
toExpr b
b, c -> Expr
forall a. ToExpr a => a -> Expr
toExpr c
c]
instance (ToExpr a, ToExpr b, ToExpr c, ToExpr d) => ToExpr (a, b, c, d) where
    toExpr :: (a, b, c, d) -> Expr
toExpr (a
a, b
b, c
c, d
d) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"_×_×_×_" [a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
a, b -> Expr
forall a. ToExpr a => a -> Expr
toExpr b
b, c -> Expr
forall a. ToExpr a => a -> Expr
toExpr c
c, d -> Expr
forall a. ToExpr a => a -> Expr
toExpr d
d]
instance (ToExpr a, ToExpr b, ToExpr c, ToExpr d, ToExpr e) => ToExpr (a, b, c, d, e) where
    toExpr :: (a, b, c, d, e) -> Expr
toExpr (a
a, b
b, c
c, d
d, e
e) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"_×_×_×_×_" [a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
a, b -> Expr
forall a. ToExpr a => a -> Expr
toExpr b
b, c -> Expr
forall a. ToExpr a => a -> Expr
toExpr c
c, d -> Expr
forall a. ToExpr a => a -> Expr
toExpr d
d, e -> Expr
forall a. ToExpr a => a -> Expr
toExpr e
e]

-- | >>> prettyExpr $ toExpr (3 % 12 :: Rational)
-- _%_ 1 4
instance (ToExpr a, Integral a) => ToExpr (Ratio.Ratio a) where
    toExpr :: Ratio a -> Expr
toExpr Ratio a
r = ConstructorName -> [Expr] -> Expr
App ConstructorName
"_%_" [ a -> Expr
forall a. ToExpr a => a -> Expr
toExpr (a -> Expr) -> a -> Expr
forall a b. (a -> b) -> a -> b
$ Ratio a -> a
forall a. Ratio a -> a
Ratio.numerator Ratio a
r, a -> Expr
forall a. ToExpr a => a -> Expr
toExpr (a -> Expr) -> a -> Expr
forall a b. (a -> b) -> a -> b
$ Ratio a -> a
forall a. Ratio a -> a
Ratio.denominator Ratio a
r ]
instance HasResolution a => ToExpr (Fixed a) where toExpr :: Fixed a -> Expr
toExpr = Fixed a -> Expr
forall a. Show a => a -> Expr
defaultExprViaShow

-- | >>> prettyExpr $ toExpr $ Identity 'a'
-- Identity 'a'
instance ToExpr a => ToExpr (Identity a) where
    toExpr :: Identity a -> Expr
toExpr (Identity a
x) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Identity" [a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
x]

instance ToExpr a => ToExpr (Const a b)
instance ToExpr a => ToExpr (ZipList a)

instance ToExpr a => ToExpr (NonEmpty a) where
    toExpr :: NonEmpty a -> Expr
toExpr (a
x :| [a]
xs) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"NE.fromList" [[a] -> Expr
forall a. ToExpr a => a -> Expr
toExpr (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)]

instance ToExpr Void where
    toExpr :: Void -> Expr
toExpr Void
_ = ConstructorName -> [Expr] -> Expr
App ConstructorName
"error" [ConstructorName -> Expr
forall a. ToExpr a => a -> Expr
toExpr ConstructorName
"Void"]

-------------------------------------------------------------------------------
-- Monoid/semigroups
-------------------------------------------------------------------------------

instance ToExpr a => ToExpr (Mon.Dual a) where
instance ToExpr a => ToExpr (Mon.Sum a) where
instance ToExpr a => ToExpr (Mon.Product a) where
instance ToExpr a => ToExpr (Mon.First a) where
instance ToExpr a => ToExpr (Mon.Last a) where

-- ...
#if !MIN_VERSION_base(4,16,0)
instance ToExpr a => ToExpr (Semi.Option a) where
    toExpr (Semi.Option x) = App "Option" [toExpr x]
#endif
instance ToExpr a => ToExpr (Semi.Min a) where
    toExpr :: Min a -> Expr
toExpr (Semi.Min a
x) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Min" [a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
x]
instance ToExpr a => ToExpr (Semi.Max a) where
    toExpr :: Max a -> Expr
toExpr (Semi.Max a
x) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Max" [a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
x]
instance ToExpr a => ToExpr (Semi.First a) where
    toExpr :: First a -> Expr
toExpr (Semi.First a
x) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"First" [a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
x]
instance ToExpr a => ToExpr (Semi.Last a) where
    toExpr :: Last a -> Expr
toExpr (Semi.Last a
x) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Last" [a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
x]

-------------------------------------------------------------------------------
-- containers
-------------------------------------------------------------------------------

instance ToExpr a => ToExpr (Tree.Tree a) where
    toExpr :: Tree a -> Expr
toExpr (Tree.Node a
x [Tree a]
xs) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Node" [a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
x, [Tree a] -> Expr
forall a. ToExpr a => a -> Expr
toExpr [Tree a]
xs]

instance (ToExpr k, ToExpr v) => ToExpr (Map.Map k v) where
    toExpr :: Map k v -> Expr
toExpr Map k v
x = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Map.fromList" [ [(k, v)] -> Expr
forall a. ToExpr a => a -> Expr
toExpr ([(k, v)] -> Expr) -> [(k, v)] -> Expr
forall a b. (a -> b) -> a -> b
$ Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
x ]
instance (ToExpr k) => ToExpr (Set.Set k) where
    toExpr :: Set k -> Expr
toExpr Set k
x = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Set.fromList" [ [k] -> Expr
forall a. ToExpr a => a -> Expr
toExpr ([k] -> Expr) -> [k] -> Expr
forall a b. (a -> b) -> a -> b
$ Set k -> [k]
forall a. Set a -> [a]
Set.toList Set k
x ]
instance (ToExpr v) => ToExpr (IntMap.IntMap v) where
    toExpr :: IntMap v -> Expr
toExpr IntMap v
x = ConstructorName -> [Expr] -> Expr
App ConstructorName
"IntMap.fromList" [ [(Int, v)] -> Expr
forall a. ToExpr a => a -> Expr
toExpr ([(Int, v)] -> Expr) -> [(Int, v)] -> Expr
forall a b. (a -> b) -> a -> b
$ IntMap v -> [(Int, v)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap v
x ]
instance ToExpr IntSet.IntSet where
    toExpr :: IntSet -> Expr
toExpr IntSet
x = ConstructorName -> [Expr] -> Expr
App ConstructorName
"IntSet.fromList" [ [Int] -> Expr
forall a. ToExpr a => a -> Expr
toExpr ([Int] -> Expr) -> [Int] -> Expr
forall a b. (a -> b) -> a -> b
$ IntSet -> [Int]
IntSet.toList IntSet
x ]
instance (ToExpr v) => ToExpr (Seq.Seq v) where
    toExpr :: Seq v -> Expr
toExpr Seq v
x = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Seq.fromList" [ [v] -> Expr
forall a. ToExpr a => a -> Expr
toExpr ([v] -> Expr) -> [v] -> Expr
forall a b. (a -> b) -> a -> b
$ Seq v -> [v]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq v
x ]

-------------------------------------------------------------------------------
-- text
-------------------------------------------------------------------------------

-- | >>> traverse_ (print . prettyExpr . toExpr . LT.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
-- ""
-- "\n"
-- "foo"
-- "foo\n"
-- LT.concat ["foo\n", "bar"]
-- LT.concat ["foo\n", "bar\n"]
instance ToExpr LT.Text where
    toExpr :: Text -> Expr
toExpr = ConstructorName -> [ConstructorName] -> Expr
forall a. Show a => ConstructorName -> [a] -> Expr
stringToExpr ConstructorName
"LT.concat" ([ConstructorName] -> Expr)
-> (Text -> [ConstructorName]) -> Text -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe (Char, Text)) -> Text -> [ConstructorName]
forall a. (a -> Maybe (Char, a)) -> a -> [ConstructorName]
unconcat Text -> Maybe (Char, Text)
LT.uncons

-- | >>> traverse_ (print . prettyExpr . toExpr . T.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
-- ""
-- "\n"
-- "foo"
-- "foo\n"
-- T.concat ["foo\n", "bar"]
-- T.concat ["foo\n", "bar\n"]
instance ToExpr T.Text where
    toExpr :: Text -> Expr
toExpr = ConstructorName -> [ConstructorName] -> Expr
forall a. Show a => ConstructorName -> [a] -> Expr
stringToExpr ConstructorName
"T.concat" ([ConstructorName] -> Expr)
-> (Text -> [ConstructorName]) -> Text -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe (Char, Text)) -> Text -> [ConstructorName]
forall a. (a -> Maybe (Char, a)) -> a -> [ConstructorName]
unconcat Text -> Maybe (Char, Text)
T.uncons

-------------------------------------------------------------------------------
-- time
-------------------------------------------------------------------------------

-- | >>> prettyExpr $ toExpr $ ModifiedJulianDay 58014
-- Day "2017-09-18"
instance ToExpr Time.Day where
    toExpr :: Day -> Expr
toExpr Day
d = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Day" [ ConstructorName -> Expr
forall a. ToExpr a => a -> Expr
toExpr (Day -> ConstructorName
forall a. Show a => a -> ConstructorName
show Day
d) ]

instance ToExpr Time.UTCTime where
    toExpr :: UTCTime -> Expr
toExpr UTCTime
t = ConstructorName -> [Expr] -> Expr
App ConstructorName
"UTCTime" [ ConstructorName -> Expr
forall a. ToExpr a => a -> Expr
toExpr (UTCTime -> ConstructorName
forall a. Show a => a -> ConstructorName
show UTCTime
t) ]

-------------------------------------------------------------------------------
-- bytestring
-------------------------------------------------------------------------------

-- | >>> traverse_ (print . prettyExpr . toExpr . LBS8.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
-- ""
-- "\n"
-- "foo"
-- "foo\n"
-- LBS.concat ["foo\n", "bar"]
-- LBS.concat ["foo\n", "bar\n"]
instance ToExpr LBS.ByteString where
    toExpr :: ByteString -> Expr
toExpr = ConstructorName -> [ByteString] -> Expr
forall a. Show a => ConstructorName -> [a] -> Expr
stringToExpr ConstructorName
"LBS.concat" ([ByteString] -> Expr)
-> (ByteString -> [ByteString]) -> ByteString -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool)
-> (Word8 -> ByteString -> Maybe Int64)
-> (Int64 -> ByteString -> (ByteString, ByteString))
-> ByteString
-> [ByteString]
forall bs int.
Num int =>
(bs -> Bool)
-> (Word8 -> bs -> Maybe int)
-> (int -> bs -> (bs, bs))
-> bs
-> [bs]
bsUnconcat ByteString -> Bool
LBS.null Word8 -> ByteString -> Maybe Int64
LBS.elemIndex Int64 -> ByteString -> (ByteString, ByteString)
LBS.splitAt

-- | >>> traverse_ (print . prettyExpr . toExpr . BS8.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
-- ""
-- "\n"
-- "foo"
-- "foo\n"
-- BS.concat ["foo\n", "bar"]
-- BS.concat ["foo\n", "bar\n"]
instance ToExpr BS.ByteString where
    toExpr :: ByteString -> Expr
toExpr = ConstructorName -> [ByteString] -> Expr
forall a. Show a => ConstructorName -> [a] -> Expr
stringToExpr ConstructorName
"BS.concat" ([ByteString] -> Expr)
-> (ByteString -> [ByteString]) -> ByteString -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool)
-> (Word8 -> ByteString -> Maybe Int)
-> (Int -> ByteString -> (ByteString, ByteString))
-> ByteString
-> [ByteString]
forall bs int.
Num int =>
(bs -> Bool)
-> (Word8 -> bs -> Maybe int)
-> (int -> bs -> (bs, bs))
-> bs
-> [bs]
bsUnconcat ByteString -> Bool
BS.null Word8 -> ByteString -> Maybe Int
BS.elemIndex Int -> ByteString -> (ByteString, ByteString)
BS.splitAt

-- | >>> traverse_ (print . prettyExpr . toExpr . SBS.toShort . BS8.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
-- ""
-- "\n"
-- "foo"
-- "foo\n"
-- mconcat ["foo\n", "bar"]
-- mconcat ["foo\n", "bar\n"]
instance ToExpr SBS.ShortByteString where
    toExpr :: ShortByteString -> Expr
toExpr = ConstructorName -> [ByteString] -> Expr
forall a. Show a => ConstructorName -> [a] -> Expr
stringToExpr ConstructorName
"mconcat" ([ByteString] -> Expr)
-> (ShortByteString -> [ByteString]) -> ShortByteString -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool)
-> (Word8 -> ByteString -> Maybe Int)
-> (Int -> ByteString -> (ByteString, ByteString))
-> ByteString
-> [ByteString]
forall bs int.
Num int =>
(bs -> Bool)
-> (Word8 -> bs -> Maybe int)
-> (int -> bs -> (bs, bs))
-> bs
-> [bs]
bsUnconcat ByteString -> Bool
BS.null Word8 -> ByteString -> Maybe Int
BS.elemIndex Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (ByteString -> [ByteString])
-> (ShortByteString -> ByteString)
-> ShortByteString
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort

bsUnconcat
    :: forall bs int. Num int
    => (bs -> Bool)
    -> (Word8 -> bs -> Maybe int)
    -> (int -> bs -> (bs, bs))
    -> bs
    -> [bs]
bsUnconcat :: forall bs int.
Num int =>
(bs -> Bool)
-> (Word8 -> bs -> Maybe int)
-> (int -> bs -> (bs, bs))
-> bs
-> [bs]
bsUnconcat bs -> Bool
null_ Word8 -> bs -> Maybe int
elemIndex_ int -> bs -> (bs, bs)
splitAt_ = bs -> [bs]
go where
    go :: bs -> [bs]
    go :: bs -> [bs]
go bs
bs
        | bs -> Bool
null_ bs
bs  = []
        | Bool
otherwise = case Word8 -> bs -> Maybe int
elemIndex_ Word8
10 bs
bs of
            Maybe int
Nothing -> [bs
bs]
            Just int
i  -> case int -> bs -> (bs, bs)
splitAt_ (int
i int -> int -> int
forall a. Num a => a -> a -> a
+ int
1) bs
bs of
                (bs
bs0, bs
bs1) -> bs
bs0 bs -> [bs] -> [bs]
forall a. a -> [a] -> [a]
: bs -> [bs]
go bs
bs1

-------------------------------------------------------------------------------
-- scientific
-------------------------------------------------------------------------------

-- | >>> prettyExpr $ toExpr (123.456 :: Scientific)
-- scientific 123456 `-3`
instance ToExpr Sci.Scientific where
    toExpr :: Scientific -> Expr
toExpr Scientific
s = ConstructorName -> [Expr] -> Expr
App ConstructorName
"scientific" [ Integer -> Expr
forall a. ToExpr a => a -> Expr
toExpr (Integer -> Expr) -> Integer -> Expr
forall a b. (a -> b) -> a -> b
$ Scientific -> Integer
Sci.coefficient Scientific
s, Int -> Expr
forall a. ToExpr a => a -> Expr
toExpr (Int -> Expr) -> Int -> Expr
forall a b. (a -> b) -> a -> b
$ Scientific -> Int
Sci.base10Exponent Scientific
s ]

-------------------------------------------------------------------------------
-- uuid-types
-------------------------------------------------------------------------------

-- | >>> prettyExpr $ toExpr UUID.nil
-- UUID "00000000-0000-0000-0000-000000000000"
instance ToExpr UUID.UUID where
    toExpr :: UUID -> Expr
toExpr UUID
u = ConstructorName -> [Expr] -> Expr
App ConstructorName
"UUID" [ ConstructorName -> Expr
forall a. ToExpr a => a -> Expr
toExpr (ConstructorName -> Expr) -> ConstructorName -> Expr
forall a b. (a -> b) -> a -> b
$ UUID -> ConstructorName
UUID.toString UUID
u ]

-------------------------------------------------------------------------------
-- vector
-------------------------------------------------------------------------------

instance ToExpr a => ToExpr (V.Vector a) where
    toExpr :: Vector a -> Expr
toExpr Vector a
x = ConstructorName -> [Expr] -> Expr
App ConstructorName
"V.fromList" [ [a] -> Expr
forall a. ToExpr a => a -> Expr
toExpr ([a] -> Expr) -> [a] -> Expr
forall a b. (a -> b) -> a -> b
$ Vector a -> [a]
forall a. Vector a -> [a]
V.toList Vector a
x ]
instance (ToExpr a, VU.Unbox a) => ToExpr (VU.Vector a) where
    toExpr :: Vector a -> Expr
toExpr Vector a
x = ConstructorName -> [Expr] -> Expr
App ConstructorName
"VU.fromList" [ [a] -> Expr
forall a. ToExpr a => a -> Expr
toExpr ([a] -> Expr) -> [a] -> Expr
forall a b. (a -> b) -> a -> b
$ Vector a -> [a]
forall a. Unbox a => Vector a -> [a]
VU.toList Vector a
x ]
instance (ToExpr a, VS.Storable a) => ToExpr (VS.Vector a) where
    toExpr :: Vector a -> Expr
toExpr Vector a
x = ConstructorName -> [Expr] -> Expr
App ConstructorName
"VS.fromList" [ [a] -> Expr
forall a. ToExpr a => a -> Expr
toExpr ([a] -> Expr) -> [a] -> Expr
forall a b. (a -> b) -> a -> b
$ Vector a -> [a]
forall a. Storable a => Vector a -> [a]
VS.toList Vector a
x ]
instance (ToExpr a, VP.Prim a) => ToExpr (VP.Vector a) where
    toExpr :: Vector a -> Expr
toExpr Vector a
x = ConstructorName -> [Expr] -> Expr
App ConstructorName
"VP.fromList" [ [a] -> Expr
forall a. ToExpr a => a -> Expr
toExpr ([a] -> Expr) -> [a] -> Expr
forall a b. (a -> b) -> a -> b
$ Vector a -> [a]
forall a. Prim a => Vector a -> [a]
VP.toList Vector a
x ]

-------------------------------------------------------------------------------
-- tagged
-------------------------------------------------------------------------------

instance ToExpr a => ToExpr (Tagged t a) where
    toExpr :: Tagged t a -> Expr
toExpr (Tagged a
x) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Tagged" [ a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
x ]

-------------------------------------------------------------------------------
-- hashable
-------------------------------------------------------------------------------

instance ToExpr a => ToExpr (Hashed a) where
    toExpr :: Hashed a -> Expr
toExpr Hashed a
x = ConstructorName -> [Expr] -> Expr
App ConstructorName
"hashed" [ a -> Expr
forall a. ToExpr a => a -> Expr
toExpr (a -> Expr) -> a -> Expr
forall a b. (a -> b) -> a -> b
$ Hashed a -> a
forall a. Hashed a -> a
unhashed Hashed a
x ]

-------------------------------------------------------------------------------
-- unordered-containers
-------------------------------------------------------------------------------

instance (ToExpr k, ToExpr v) => ToExpr (HM.HashMap k v) where
    toExpr :: HashMap k v -> Expr
toExpr HashMap k v
x = ConstructorName -> [Expr] -> Expr
App ConstructorName
"HM.fromList" [ [Expr] -> Expr
Lst ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> [Expr]
forall a. Ord a => [a] -> [a]
sort ([Expr] -> [Expr]) -> [Expr] -> [Expr]
forall a b. (a -> b) -> a -> b
$ ((k, v) -> Expr) -> [(k, v)] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> Expr
forall a. ToExpr a => a -> Expr
toExpr ([(k, v)] -> [Expr]) -> [(k, v)] -> [Expr]
forall a b. (a -> b) -> a -> b
$ HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap k v
x ]
instance (ToExpr k) => ToExpr (HS.HashSet k) where
    toExpr :: HashSet k -> Expr
toExpr HashSet k
x = ConstructorName -> [Expr] -> Expr
App ConstructorName
"HS.fromList" [ [Expr] -> Expr
Lst ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> [Expr]
forall a. Ord a => [a] -> [a]
sort ([Expr] -> [Expr]) -> [Expr] -> [Expr]
forall a b. (a -> b) -> a -> b
$ (k -> Expr) -> [k] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map k -> Expr
forall a. ToExpr a => a -> Expr
toExpr ([k] -> [Expr]) -> [k] -> [Expr]
forall a b. (a -> b) -> a -> b
$ HashSet k -> [k]
forall a. HashSet a -> [a]
HS.toList HashSet k
x ]

-------------------------------------------------------------------------------
-- aeson
-------------------------------------------------------------------------------

instance ToExpr Aeson.Value

instance ToExpr Key.Key where
    toExpr :: Key -> Expr
toExpr = ConstructorName -> [ConstructorName] -> Expr
forall a. Show a => ConstructorName -> [a] -> Expr
stringToExpr ConstructorName
"Key.concat" ([ConstructorName] -> Expr)
-> (Key -> [ConstructorName]) -> Key -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe (Char, Text)) -> Text -> [ConstructorName]
forall a. (a -> Maybe (Char, a)) -> a -> [ConstructorName]
unconcat Text -> Maybe (Char, Text)
T.uncons (Text -> [ConstructorName])
-> (Key -> Text) -> Key -> [ConstructorName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
Key.toText

instance ToExpr a => ToExpr (KM.KeyMap a) where
    toExpr :: KeyMap a -> Expr
toExpr KeyMap a
x = ConstructorName -> [Expr] -> Expr
App ConstructorName
"KM.fromList" [ [(Key, a)] -> Expr
forall a. ToExpr a => a -> Expr
toExpr ([(Key, a)] -> Expr) -> [(Key, a)] -> Expr
forall a b. (a -> b) -> a -> b
$ KeyMap a -> [(Key, a)]
forall v. KeyMap v -> [(Key, v)]
KM.toList KeyMap a
x ]

-------------------------------------------------------------------------------
-- strict
-------------------------------------------------------------------------------

instance ToExpr a => ToExpr (Strict.Maybe a) where
    toExpr :: Maybe a -> Expr
toExpr = Maybe a -> Expr
forall a. ToExpr a => a -> Expr
toExpr (Maybe a -> Expr) -> (Maybe a -> Maybe a) -> Maybe a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Maybe a
forall lazy strict. Strict lazy strict => strict -> lazy
Strict.toLazy

instance (ToExpr a, ToExpr b) => ToExpr (Strict.Either a b) where
    toExpr :: Either a b -> Expr
toExpr = Either a b -> Expr
forall a. ToExpr a => a -> Expr
toExpr (Either a b -> Expr)
-> (Either a b -> Either a b) -> Either a b -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either a b -> Either a b
forall lazy strict. Strict lazy strict => strict -> lazy
Strict.toLazy

instance (ToExpr a, ToExpr b) => ToExpr (Strict.These a b) where
    toExpr :: These a b -> Expr
toExpr = These a b -> Expr
forall a. ToExpr a => a -> Expr
toExpr (These a b -> Expr)
-> (These a b -> These a b) -> These a b -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These a b -> These a b
forall lazy strict. Strict lazy strict => strict -> lazy
Strict.toLazy

instance (ToExpr a, ToExpr b) => ToExpr (Strict.Pair a b) where
    toExpr :: Pair a b -> Expr
toExpr = (a, b) -> Expr
forall a. ToExpr a => a -> Expr
toExpr ((a, b) -> Expr) -> (Pair a b -> (a, b)) -> Pair a b -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair a b -> (a, b)
forall lazy strict. Strict lazy strict => strict -> lazy
Strict.toLazy

-------------------------------------------------------------------------------
-- these
-------------------------------------------------------------------------------

instance (ToExpr a, ToExpr b) => ToExpr (These a b) where
    toExpr :: These a b -> Expr
toExpr (This a
x)    = ConstructorName -> [Expr] -> Expr
App ConstructorName
"This" [a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
x]
    toExpr (That b
y)    = ConstructorName -> [Expr] -> Expr
App ConstructorName
"That" [b -> Expr
forall a. ToExpr a => a -> Expr
toExpr b
y]
    toExpr (These a
x b
y) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"These " [a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
x, b -> Expr
forall a. ToExpr a => a -> Expr
toExpr b
y]

-------------------------------------------------------------------------------
-- primitive
-------------------------------------------------------------------------------

-- | @since 0.2.2
instance ToExpr Prim.ByteArray where
    toExpr :: ByteArray -> Expr
toExpr ByteArray
ba = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Prim.byteArrayFromList" [[Word8] -> Expr
forall a. ToExpr a => a -> Expr
toExpr ((Word8 -> [Word8] -> [Word8]) -> [Word8] -> ByteArray -> [Word8]
forall a b. Prim a => (a -> b -> b) -> b -> ByteArray -> b
Prim.foldrByteArray (:) [] ByteArray
ba :: [Word8])]