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

import Data.Foldable    (toList)
import Data.List        (sort)
import Data.List.Compat (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)

#ifdef MIN_VERSION_generic_deriving
import Generics.Deriving.Instances ()
#endif

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
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key    as Key
import qualified Data.Aeson.KeyMap as KM
#endif

-- strict
import qualified Data.Strict as Strict

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

-- primitive
import qualified Data.Primitive as Prim

#if MIN_VERSION_base(4,9,0)
import Data.Array.Byte (ByteArray (..))
#endif

-- $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 (forall a. ToExpr a => a -> Expr
toExpr a
x) (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 (forall a. ToExpr a => a -> Expr
toExpr a
x) (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 = forall a. (Generic a, GToExpr (Rep a)) => a -> Expr
genericToExpr

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

instance ToExpr Expr where
    toExpr :: Expr -> Expr
toExpr = 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 (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) = 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) = forall (f :: * -> *) x. GSumToExpr f => f x -> Expr
gsumToExpr f x
x
    gsumToExpr (R1 g x
x) = forall (f :: * -> *) x. GSumToExpr f => f x -> Expr
gsumToExpr g x
x

instance GSumToExpr V1 where
#if __GLASGOW_HASKELL__ >= 708
    gsumToExpr :: forall x. V1 x -> Expr
gsumToExpr V1 x
x = case V1 x
x of {}
#else
    gsumToExpr x = x `seq` error "panic: V1 value"
#endif

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 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 (forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList [(ConstructorName, Expr)]
pairs)
      where
        cn :: ConstructorName
cn = forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
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) = forall (f :: * -> *) x. GProductToExpr f => f x -> AppOrRec
gproductToExpr f x
f AppOrRec -> AppOrRec -> AppOrRec
`combine` 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 forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> ConstructorName
selName M1 i s f x
z of
        [] -> [Expr] -> AppOrRec
App' [forall (f :: * -> *) x. GLeafToExpr f => f x -> Expr
gleafToExpr f x
x]
        ConstructorName
sn -> [(ConstructorName, Expr)] -> AppOrRec
Rec' [(ConstructorName
sn, 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) = forall a. ToExpr a => a -> Expr
toExpr x
x

data AppOrRec = App' [Expr] | Rec' [(FieldName, Expr)]
  deriving Int -> AppOrRec -> ShowS
[AppOrRec] -> ShowS
AppOrRec -> ConstructorName
forall a.
(Int -> a -> ShowS)
-> (a -> ConstructorName) -> ([a] -> ShowS) -> Show a
showList :: [AppOrRec] -> ShowS
$cshowList :: [AppOrRec] -> ShowS
show :: AppOrRec -> ConstructorName
$cshow :: AppOrRec -> ConstructorName
showsPrec :: Int -> AppOrRec -> ShowS
$cshowsPrec :: Int -> 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 forall a. [a] -> [a] -> [a]
++ [(ConstructorName, Expr)]
ys)
combine AppOrRec
xs        AppOrRec
ys        = [Expr] -> AppOrRec
App' (AppOrRec -> [Expr]
exprs AppOrRec
xs 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) = forall a b. (a -> b) -> [a] -> [b]
map 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 = forall (f :: * -> *) x. GToExpr f => f x -> Expr
gtoExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from

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

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

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

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

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

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

instance ToExpr (Proxy a) where toExpr :: Proxy a -> Expr
toExpr = 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 = forall a. Show a => a -> Expr
defaultExprViaShow
    listToExpr :: ConstructorName -> Expr
listToExpr = forall a. Show a => ConstructorName -> [a] -> Expr
stringToExpr ConstructorName
"concat" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Maybe (Char, a)) -> a -> [ConstructorName]
unconcat 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] = forall a. Show a => a -> Expr
defaultExprViaShow a
l
stringToExpr ConstructorName
cn [a]
ls  = ConstructorName -> [Expr] -> Expr
App ConstructorName
cn [[Expr] -> Expr
Lst (forall a b. (a -> b) -> [a] -> [b]
map 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)
            | forall (t :: * -> *) a. Foldable t => t a -> Bool
null ConstructorName
ys   -> []
            | Bool
otherwise -> ConstructorName
ys 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 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 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" [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"  [forall a. ToExpr a => a -> Expr
toExpr a
x]
    toExpr (Right b
y) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"Right" [forall a. ToExpr a => a -> Expr
toExpr b
y]

instance ToExpr a => ToExpr [a] where
    toExpr :: [a] -> Expr
toExpr = 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
"_×_" [forall a. ToExpr a => a -> Expr
toExpr a
a, 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
"_×_×_" [forall a. ToExpr a => a -> Expr
toExpr a
a, forall a. ToExpr a => a -> Expr
toExpr b
b, 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
"_×_×_×_" [forall a. ToExpr a => a -> Expr
toExpr a
a, forall a. ToExpr a => a -> Expr
toExpr b
b, forall a. ToExpr a => a -> Expr
toExpr c
c, 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
"_×_×_×_×_" [forall a. ToExpr a => a -> Expr
toExpr a
a, forall a. ToExpr a => a -> Expr
toExpr b
b, forall a. ToExpr a => a -> Expr
toExpr c
c, forall a. ToExpr a => a -> Expr
toExpr d
d, 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
"_%_" [ forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ forall a. Ratio a -> a
Ratio.numerator Ratio a
r, forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ forall a. Ratio a -> a
Ratio.denominator Ratio a
r ]
instance HasResolution a => ToExpr (Fixed a) where toExpr :: Fixed a -> Expr
toExpr = 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" [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" [forall a. ToExpr a => a -> Expr
toExpr (a
x forall a. a -> [a] -> [a]
: [a]
xs)]

instance ToExpr Void where
    toExpr :: Void -> Expr
toExpr Void
_ = ConstructorName -> [Expr] -> Expr
App ConstructorName
"error" [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" [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" [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" [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" [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" [forall a. ToExpr a => a -> Expr
toExpr a
x, 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" [ forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ 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" [ forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ 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" [ forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ 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" [ forall a. ToExpr a => a -> Expr
toExpr 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" [ forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ 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 = forall a. Show a => ConstructorName -> [a] -> Expr
stringToExpr ConstructorName
"LT.concat" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Show a => ConstructorName -> [a] -> Expr
stringToExpr ConstructorName
"T.concat" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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" [ forall a. ToExpr a => a -> Expr
toExpr (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" [ forall a. ToExpr a => a -> Expr
toExpr (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 = forall a. Show a => ConstructorName -> [a] -> Expr
stringToExpr ConstructorName
"LBS.concat" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Show a => ConstructorName -> [a] -> Expr
stringToExpr ConstructorName
"BS.concat" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Show a => ConstructorName -> [a] -> Expr
stringToExpr ConstructorName
"mconcat" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 forall a. Num a => a -> a -> a
+ int
1) bs
bs of
                (bs
bs0, bs
bs1) -> bs
bs0 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" [ forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ Scientific -> Integer
Sci.coefficient Scientific
s, forall a. ToExpr a => a -> Expr
toExpr 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" [ forall a. ToExpr a => a -> Expr
toExpr 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" [ forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ 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" [ forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ 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" [ forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ 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" [ forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ 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" [ 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" [ forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ forall a. HashSet a -> [a]
HS.toList HashSet k
x ]

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

instance ToExpr Aeson.Value

#if MIN_VERSION_aeson(2,0,0)
instance ToExpr Key.Key where
    toExpr :: Key -> Expr
toExpr = forall a. Show a => ConstructorName -> [a] -> Expr
stringToExpr ConstructorName
"Key.concat" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Maybe (Char, a)) -> a -> [ConstructorName]
unconcat Text -> Maybe (Char, Text)
T.uncons 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" [ forall a. ToExpr a => a -> Expr
toExpr forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [(Key, v)]
KM.toList KeyMap a
x ]
#endif

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

instance ToExpr a => ToExpr (Strict.Maybe a) where
    toExpr :: Maybe a -> Expr
toExpr = forall a. ToExpr a => a -> Expr
toExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. ToExpr a => a -> Expr
toExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. ToExpr a => a -> Expr
toExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. ToExpr a => a -> Expr
toExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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" [forall a. ToExpr a => a -> Expr
toExpr a
x]
    toExpr (That b
y)    = ConstructorName -> [Expr] -> Expr
App ConstructorName
"That" [forall a. ToExpr a => a -> Expr
toExpr b
y]
    toExpr (These a
x b
y) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"These " [forall a. ToExpr a => a -> Expr
toExpr a
x, 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" [forall a. ToExpr a => a -> Expr
toExpr (forall a b. Prim a => (a -> b -> b) -> b -> ByteArray -> b
Prim.foldrByteArray (:) [] ByteArray
ba :: [Word8])]

#if !MIN_VERSION_primitive(0,8,0) && MIN_VERSION_base(4,9,0)
-- | @since 0.2.2
instance ToExpr ByteArray where
    toExpr (ByteArray ba) = App "byteArrayFromList" [toExpr (Prim.foldrByteArray (:) [] (Prim.ByteArray ba) :: [Word8])]
#endif

-- TODO: add more instances