module Language.Haskell.TH.TypeGraph.Orphans where
import Data.Aeson (FromJSON(parseJSON), Value(Null), ToJSON(toJSON))
#if MIN_VERSION_aeson(1,0,0)
import Data.Aeson (ToJSONKey, FromJSONKey)
#endif
#if !MIN_VERSION_aeson(0,11,0)
import Data.Aeson.Types (typeMismatch)
#endif
import qualified Data.Graph.Inductive as G
import Data.Proxy (Proxy(Proxy))
import Data.Set as Set (Set, toList)
import Data.Time (UTCTime(..), Day(ModifiedJulianDay), toModifiedJulianDay, DiffTime)
import Data.UserId (UserId(..))
import Instances.TH.Lift ()
import Language.Haskell.TH (ExpQ, Loc(..), location, Name, NameSpace, Type)
import Language.Haskell.TH.Instances ()
import Language.Haskell.TH.Lift (deriveLift, lift)
import Language.Haskell.TH.Ppr (Ppr(ppr))
import Language.Haskell.TH.PprLib (hcat, ptext, vcat)
import Language.Haskell.TH.Syntax (ModName(..), NameFlavour(..), OccName(..), PkgName(..))
import Data.SafeCopy (base, contain, deriveSafeCopy, SafeCopy(errorTypeName, getCopy, kind, putCopy, version))
import Data.Serialize (label, Serialize(..))
#if !MIN_VERSION_aeson(0,11,0)
instance ToJSON (Proxy a) where
toJSON _ = Null
instance FromJSON (Proxy a) where
parseJSON Null = pure Proxy
parseJSON v = typeMismatch "Proxy" v
#endif
instance Ppr () where
ppr () = ptext "()"
instance Ppr Int where
ppr = ptext . show
instance Ppr (Set Type, Set Type) where
ppr (extra, missing) = vcat [ptext "extra:", ppr extra, ptext "missing:", ppr missing]
instance Ppr (Set Type) where
ppr s = hcat [ptext "Set.fromList [", ppr (Set.toList s), ptext "]"]
instance SafeCopy (Proxy t) where
putCopy Proxy = contain (do { return () })
getCopy = contain (label "Data.Proxy.Proxy:" (pure Proxy))
version = 0
kind = base
errorTypeName _ = "Data.Proxy.Proxy"
$(deriveSafeCopy 0 'base ''OccName)
$(deriveSafeCopy 0 'base ''NameSpace)
$(deriveSafeCopy 0 'base ''PkgName)
$(deriveSafeCopy 0 'base ''ModName)
$(deriveSafeCopy 0 'base ''NameFlavour)
$(deriveSafeCopy 0 'base ''Name)
$(deriveSafeCopy 1 'base ''Loc)
instance Serialize UTCTime where
get = uncurry UTCTime <$> get
put (UTCTime day time) = put (day, time)
instance Serialize Day where
get = ModifiedJulianDay <$> get
put = put . toModifiedJulianDay
instance Serialize DiffTime where
get = fromRational <$> get
put = put . toRational
#if MIN_VERSION_aeson(1,0,0)
instance FromJSONKey UserId
instance ToJSONKey UserId
#endif
deriving instance Serialize UserId
deriving instance Serialize Loc
$(deriveLift ''UserId)
$(deriveLift ''G.Gr)
$(deriveLift ''G.NodeMap)