{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE UndecidableInstances,
CPP #-}
#if __GLASGOW_HASKELL__ >= 810
{-# LANGUAGE StandaloneKindSignatures #-}
#endif
module Parsley.Internal.Common.Utils (WQ(..), Code, Quapplicative(..), intercalate, intercalateDiff) where
import Data.List (intersperse)
import Data.String (IsString(..))
#if __GLASGOW_HASKELL__ >= 810
import Data.Kind (Type)
import GHC.Exts (TYPE, RuntimeRep)
#endif
#if __GLASGOW_HASKELL__ < 900
import Language.Haskell.TH (TExp, Q)
#else
import qualified Language.Haskell.TH as TH (Code, Q)
#endif
#if __GLASGOW_HASKELL__ >= 810
type Code :: forall (r :: RuntimeRep). TYPE r -> Type
#endif
#if __GLASGOW_HASKELL__ < 900
type Code a = Q (TExp a)
#else
type Code a = TH.Code TH.Q a
#endif
data WQ a = WQ { forall a. WQ a -> a
__val :: a, forall a. WQ a -> Code a
__code :: Code a }
class Quapplicative q where
makeQ :: a -> Code a -> q a
_val :: q a -> a
_code :: q a -> Code a
(>*<) :: q (a -> b) -> q a -> q b
q (a -> b)
f >*< q a
x = forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ (forall (q :: Type -> Type) a. Quapplicative q => q a -> a
_val q (a -> b)
f (forall (q :: Type -> Type) a. Quapplicative q => q a -> a
_val q a
x)) [||$$(_code f) $$(_code x)||]
infixl 9 >*<
instance Quapplicative WQ where
makeQ :: forall a. a -> Code a -> WQ a
makeQ = forall a. a -> Code a -> WQ a
WQ
_code :: forall a. WQ a -> Code a
_code = forall a. WQ a -> Code a
__code
_val :: forall a. WQ a -> a
_val = forall a. WQ a -> a
__val
intercalate :: Monoid w => w -> [w] -> w
intercalate :: forall w. Monoid w => w -> [w] -> w
intercalate w
xs [w]
xss = forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse w
xs [w]
xss)
instance IsString (String -> String) where
fromString :: String -> String -> String
fromString = String -> String -> String
showString
newtype Id a = Id {forall a. Id a -> a -> a
unId :: a -> a}
instance Semigroup (Id a) where Id a
f <> :: Id a -> Id a -> Id a
<> Id a
g = forall a. (a -> a) -> Id a
Id forall a b. (a -> b) -> a -> b
$ forall a. Id a -> a -> a
unId Id a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Id a -> a -> a
unId Id a
g
instance Monoid (Id a) where mempty :: Id a
mempty = forall a. (a -> a) -> Id a
Id forall a. a -> a
id
intercalateDiff :: (a -> a) -> [a -> a] -> a -> a
intercalateDiff :: forall a. (a -> a) -> [a -> a] -> a -> a
intercalateDiff a -> a
sep [a -> a]
xs = forall a. Id a -> a -> a
unId forall a b. (a -> b) -> a -> b
$ forall w. Monoid w => w -> [w] -> w
intercalate (forall a. (a -> a) -> Id a
Id a -> a
sep) (forall a b. (a -> b) -> [a] -> [b]
map forall a. (a -> a) -> Id a
Id [a -> a]
xs)