{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Test.StateMachine.TreeDiff.Class (
ediff,
ediff',
ToExpr (..),
defaultExprViaShow,
sopToExpr,
) where
import Data.Foldable
(toList)
import Data.List.Compat
(uncons)
import Data.Proxy
(Proxy(..))
import Generics.SOP
(All, All2, ConstructorInfo(..), DatatypeInfo(..),
FieldInfo(..), I(..), K(..), NP(..), SOP(..),
constructorInfo, hcliftA2, hcmap, hcollapse, mapIK)
import Generics.SOP.GGP
(GCode, GDatatypeInfo, GFrom, gdatatypeInfo, gfrom)
import GHC.Generics
(Generic)
import Test.StateMachine.TreeDiff.Expr
import qualified Data.Map as Map
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
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
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.Time as Time
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
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
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)
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)
class ToExpr a where
toExpr :: a -> Expr
default toExpr
:: (Generic a, All2 ToExpr (GCode a), GFrom a, GDatatypeInfo a)
=> a -> Expr
toExpr a
x = DatatypeInfo (GCode a) -> SOP I (GCode a) -> Expr
forall (xss :: [[*]]).
All2 ToExpr xss =>
DatatypeInfo xss -> SOP I xss -> Expr
sopToExpr (Proxy a -> DatatypeInfo (GCode a)
forall (proxy :: * -> *) a.
GDatatypeInfo a =>
proxy a -> DatatypeInfo (GCode a)
gdatatypeInfo (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) (a -> SOP I (GCode a)
forall a. (GFrom a, Generic a) => a -> SOP I (GCode a)
gfrom a
x)
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
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) []
sopToExpr :: (All2 ToExpr xss) => DatatypeInfo xss -> SOP I xss -> Expr
sopToExpr :: forall (xss :: [[*]]).
All2 ToExpr xss =>
DatatypeInfo xss -> SOP I xss -> Expr
sopToExpr DatatypeInfo xss
di (SOP NS (NP I) xss
xss) = NS (K Expr) xss -> CollapseTo NS Expr
forall (xs :: [[*]]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K Expr) xss -> CollapseTo NS Expr)
-> NS (K Expr) xss -> CollapseTo NS Expr
forall a b. (a -> b) -> a -> b
$ Proxy (All ToExpr)
-> (forall (a :: [*]).
All ToExpr a =>
ConstructorInfo a -> NP I a -> K Expr a)
-> Prod NS ConstructorInfo xss
-> NS (NP I) xss
-> NS (K Expr) xss
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
(xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
(f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hcliftA2
(Proxy (All ToExpr)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (All ToExpr))
(\ConstructorInfo a
ci NP I a
xs -> Expr -> K Expr a
forall k a (b :: k). a -> K a b
K (Bool -> ConstructorInfo a -> NP I a -> Expr
forall (xs :: [*]).
All ToExpr xs =>
Bool -> ConstructorInfo xs -> NP I xs -> Expr
sopNPToExpr Bool
isNewtype ConstructorInfo a
ci NP I a
xs))
(DatatypeInfo xss -> NP ConstructorInfo xss
forall (xss :: [[*]]). DatatypeInfo xss -> NP ConstructorInfo xss
constructorInfo DatatypeInfo xss
di)
NS (NP I) xss
xss
where
isNewtype :: Bool
isNewtype = case DatatypeInfo xss
di of
Newtype {} -> Bool
True
ADT {} -> Bool
False
sopNPToExpr :: All ToExpr xs => Bool -> ConstructorInfo xs -> NP I xs -> Expr
sopNPToExpr :: forall (xs :: [*]).
All ToExpr xs =>
Bool -> ConstructorInfo xs -> NP I xs -> Expr
sopNPToExpr Bool
_ (Infix ConstructorName
cn Associativity
_ Fixity
_) NP I xs
xs = ConstructorName -> [Expr] -> Expr
App (ConstructorName
"_" ConstructorName -> ConstructorName -> ConstructorName
forall a. [a] -> [a] -> [a]
++ ConstructorName
cn ConstructorName -> ConstructorName -> ConstructorName
forall a. [a] -> [a] -> [a]
++ ConstructorName
"_") ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ NP (K Expr) xs -> CollapseTo NP Expr
forall (xs :: [*]) a.
SListIN NP xs =>
NP (K a) xs -> CollapseTo NP a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NP (K Expr) xs -> CollapseTo NP Expr)
-> NP (K Expr) xs -> CollapseTo NP Expr
forall a b. (a -> b) -> a -> b
$
Proxy ToExpr
-> (forall a. ToExpr a => I a -> K Expr a)
-> NP I xs
-> NP (K Expr) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
(xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
(f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (Proxy ToExpr
forall {k} (t :: k). Proxy t
Proxy :: Proxy ToExpr) ((a -> Expr) -> I a -> K Expr a
forall {k} a b (c :: k). (a -> b) -> I a -> K b c
mapIK a -> Expr
forall a. ToExpr a => a -> Expr
toExpr) NP I xs
xs
sopNPToExpr Bool
_ (Constructor ConstructorName
cn) NP I xs
xs = ConstructorName -> [Expr] -> Expr
App ConstructorName
cn ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ NP (K Expr) xs -> CollapseTo NP Expr
forall (xs :: [*]) a.
SListIN NP xs =>
NP (K a) xs -> CollapseTo NP a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NP (K Expr) xs -> CollapseTo NP Expr)
-> NP (K Expr) xs -> CollapseTo NP Expr
forall a b. (a -> b) -> a -> b
$
Proxy ToExpr
-> (forall a. ToExpr a => I a -> K Expr a)
-> NP I xs
-> NP (K Expr) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
(xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
(f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (Proxy ToExpr
forall {k} (t :: k). Proxy t
Proxy :: Proxy ToExpr) ((a -> Expr) -> I a -> K Expr a
forall {k} a b (c :: k). (a -> b) -> I a -> K b c
mapIK a -> Expr
forall a. ToExpr a => a -> Expr
toExpr) NP I xs
xs
sopNPToExpr Bool
True (Record ConstructorName
cn NP FieldInfo xs
_) NP I xs
xs = ConstructorName -> [Expr] -> Expr
App ConstructorName
cn ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ NP (K Expr) xs -> CollapseTo NP Expr
forall (xs :: [*]) a.
SListIN NP xs =>
NP (K a) xs -> CollapseTo NP a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NP (K Expr) xs -> CollapseTo NP Expr)
-> NP (K Expr) xs -> CollapseTo NP Expr
forall a b. (a -> b) -> a -> b
$
Proxy ToExpr
-> (forall a. ToExpr a => I a -> K Expr a)
-> NP I xs
-> NP (K Expr) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
(xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
(f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (Proxy ToExpr
forall {k} (t :: k). Proxy t
Proxy :: Proxy ToExpr) ((a -> Expr) -> I a -> K Expr a
forall {k} a b (c :: k). (a -> b) -> I a -> K b c
mapIK a -> Expr
forall a. ToExpr a => a -> Expr
toExpr) NP I xs
xs
sopNPToExpr Bool
False (Record ConstructorName
cn NP FieldInfo xs
fi) NP I xs
xs = ConstructorName -> Map ConstructorName Expr -> Expr
Rec ConstructorName
cn (Map ConstructorName Expr -> Expr)
-> Map ConstructorName Expr -> Expr
forall a b. (a -> b) -> a -> b
$ [(ConstructorName, Expr)] -> Map ConstructorName Expr
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ConstructorName, Expr)] -> Map ConstructorName Expr)
-> [(ConstructorName, Expr)] -> Map ConstructorName Expr
forall a b. (a -> b) -> a -> b
$ NP (K (ConstructorName, Expr)) xs
-> CollapseTo NP (ConstructorName, Expr)
forall (xs :: [*]) a.
SListIN NP xs =>
NP (K a) xs -> CollapseTo NP a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NP (K (ConstructorName, Expr)) xs
-> CollapseTo NP (ConstructorName, Expr))
-> NP (K (ConstructorName, Expr)) xs
-> CollapseTo NP (ConstructorName, Expr)
forall a b. (a -> b) -> a -> b
$
Proxy ToExpr
-> (forall a.
ToExpr a =>
FieldInfo a -> I a -> K (ConstructorName, Expr) a)
-> Prod NP FieldInfo xs
-> NP I xs
-> NP (K (ConstructorName, Expr)) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
(xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
(f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hcliftA2 (Proxy ToExpr
forall {k} (t :: k). Proxy t
Proxy :: Proxy ToExpr) FieldInfo a -> I a -> K (ConstructorName, Expr) a
forall a.
ToExpr a =>
FieldInfo a -> I a -> K (ConstructorName, Expr) a
mk Prod NP FieldInfo xs
NP FieldInfo xs
fi NP I xs
xs
where
mk :: ToExpr x => FieldInfo x -> I x -> K (FieldName, Expr) x
mk :: forall a.
ToExpr a =>
FieldInfo a -> I a -> K (ConstructorName, Expr) a
mk (FieldInfo ConstructorName
fn) (I x
x) = (ConstructorName, Expr) -> K (ConstructorName, Expr) x
forall k a (b :: k). a -> K a b
K (ConstructorName
fn, x -> Expr
forall a. ToExpr a => a -> Expr
toExpr x
x)
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 :: Fixity -> Expr
toExpr = Fixity -> 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
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
-> [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)]
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 -> ConstructorName -> ConstructorName
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]
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
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"]
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
instance ToExpr a => ToExpr (Semi.Min a) where
instance ToExpr a => ToExpr (Semi.Max a) where
instance ToExpr a => ToExpr (Semi.First a) where
instance ToExpr a => ToExpr (Semi.Last a) where
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" [ [(Fixity, v)] -> Expr
forall a. ToExpr a => a -> Expr
toExpr ([(Fixity, v)] -> Expr) -> [(Fixity, v)] -> Expr
forall a b. (a -> b) -> a -> b
$ IntMap v -> [(Fixity, v)]
forall a. IntMap a -> [(Fixity, a)]
IntMap.toList IntMap v
x ]
instance ToExpr IntSet.IntSet where
toExpr :: IntSet -> Expr
toExpr IntSet
x = ConstructorName -> [Expr] -> Expr
App ConstructorName
"IntSet.fromList" [ [Fixity] -> Expr
forall a. ToExpr a => a -> Expr
toExpr ([Fixity] -> Expr) -> [Fixity] -> Expr
forall a b. (a -> b) -> a -> b
$ IntSet -> [Fixity]
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 ]
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
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
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) ]
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
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 Fixity)
-> (Fixity -> 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 Fixity
BS.elemIndex Fixity -> ByteString -> (ByteString, ByteString)
BS.splitAt
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
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 ]