{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module Data.API.Tools.Combinators
( Tool
, APITool
, APINodeTool
, runTool
, simpleTool
, mkTool
, contramapTool
, readTool
, subTools
, apiNodeTool
, apiDataTypeTool
, apiSpecTool
, ToolSettings
, warnOnOmittedInstance
, newtypeSmartConstructors
, defaultToolSettings
) where
import Data.API.Types
import Control.Applicative
import Data.Monoid
import Data.Semigroup as Sem
import Language.Haskell.TH
import Prelude
data ToolSettings = ToolSettings
{ ToolSettings -> Bool
warnOnOmittedInstance :: Bool
, ToolSettings -> Bool
newtypeSmartConstructors :: Bool
}
defaultToolSettings :: ToolSettings
defaultToolSettings :: ToolSettings
defaultToolSettings = ToolSettings
{ warnOnOmittedInstance :: Bool
warnOnOmittedInstance = Bool
False
, newtypeSmartConstructors :: Bool
newtypeSmartConstructors = Bool
False
}
newtype Tool a = Tool
{ forall a. Tool a -> ToolSettings -> a -> Q [Dec]
runTool :: ToolSettings -> a -> Q [Dec]
}
type APITool = Tool API
type APINodeTool = Tool APINode
instance Sem.Semigroup (Tool a) where
Tool ToolSettings -> a -> Q [Dec]
t1 <> :: Tool a -> Tool a -> Tool a
<> Tool ToolSettings -> a -> Q [Dec]
t2 = forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
Tool forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts a
x -> forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ToolSettings -> a -> Q [Dec]
t1 ToolSettings
ts a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ToolSettings -> a -> Q [Dec]
t2 ToolSettings
ts a
x
instance Monoid (Tool a) where
mempty :: Tool a
mempty = forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
Tool forall a b. (a -> b) -> a -> b
$ \ ToolSettings
_ a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return []
#if !(MIN_VERSION_base(4,11,0))
Tool t1 `mappend` Tool t2 = Tool $ \ ts x -> (++) <$> t1 ts x <*> t2 ts x
#endif
simpleTool :: (a -> Q [Dec]) -> Tool a
simpleTool :: forall a. (a -> Q [Dec]) -> Tool a
simpleTool a -> Q [Dec]
f = forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
Tool forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const a -> Q [Dec]
f
mkTool :: (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool :: forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool = forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
Tool
contramapTool :: (a -> b) -> Tool b -> Tool a
contramapTool :: forall a b. (a -> b) -> Tool b -> Tool a
contramapTool a -> b
f Tool b
t = forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
Tool forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts a
a -> forall a. Tool a -> ToolSettings -> a -> Q [Dec]
runTool Tool b
t ToolSettings
ts (a -> b
f a
a)
readTool :: (a -> Tool a) -> Tool a
readTool :: forall a. (a -> Tool a) -> Tool a
readTool a -> Tool a
t = forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts a
x -> forall a. Tool a -> ToolSettings -> a -> Q [Dec]
runTool (a -> Tool a
t a
x) ToolSettings
ts a
x
subTools :: Tool a -> Tool [a]
subTools :: forall a. Tool a -> Tool [a]
subTools Tool a
t = forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
Tool forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts [a]
as -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. Tool a -> ToolSettings -> a -> Q [Dec]
runTool Tool a
t ToolSettings
ts) [a]
as
apiNodeTool :: Tool APINode -> Tool API
apiNodeTool :: Tool APINode -> Tool API
apiNodeTool = forall a b. (a -> b) -> Tool b -> Tool a
contramapTool (\ API
api -> [APINode
an | ThNode APINode
an <- API
api ]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tool a -> Tool [a]
subTools
apiDataTypeTool :: Tool APINode -> Tool API
apiDataTypeTool :: Tool APINode -> Tool API
apiDataTypeTool = forall a b. (a -> b) -> Tool b -> Tool a
contramapTool (\ API
api -> [APINode
an | ThNode APINode
an <- API
api, Spec -> Bool
hasDataType forall a b. (a -> b) -> a -> b
$ APINode -> Spec
anSpec APINode
an ]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tool a -> Tool [a]
subTools
where
hasDataType :: Spec -> Bool
hasDataType (SpSynonym APIType
_) = Bool
False
hasDataType Spec
_ = Bool
True
apiSpecTool :: Tool (APINode, SpecNewtype)
-> Tool (APINode, SpecRecord )
-> Tool (APINode, SpecUnion )
-> Tool (APINode, SpecEnum )
-> Tool (APINode, APIType )
-> Tool APINode
apiSpecTool :: Tool (APINode, SpecNewtype)
-> Tool (APINode, SpecRecord)
-> Tool (APINode, SpecUnion)
-> Tool (APINode, SpecEnum)
-> Tool (APINode, APIType)
-> Tool APINode
apiSpecTool Tool (APINode, SpecNewtype)
n Tool (APINode, SpecRecord)
r Tool (APINode, SpecUnion)
u Tool (APINode, SpecEnum)
e Tool (APINode, APIType)
s = forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
Tool forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts APINode
an -> case APINode -> Spec
anSpec APINode
an of
SpNewtype SpecNewtype
sn -> forall a. Tool a -> ToolSettings -> a -> Q [Dec]
runTool Tool (APINode, SpecNewtype)
n ToolSettings
ts (APINode
an, SpecNewtype
sn)
SpRecord SpecRecord
sr -> forall a. Tool a -> ToolSettings -> a -> Q [Dec]
runTool Tool (APINode, SpecRecord)
r ToolSettings
ts (APINode
an, SpecRecord
sr)
SpUnion SpecUnion
su -> forall a. Tool a -> ToolSettings -> a -> Q [Dec]
runTool Tool (APINode, SpecUnion)
u ToolSettings
ts (APINode
an, SpecUnion
su)
SpEnum SpecEnum
se -> forall a. Tool a -> ToolSettings -> a -> Q [Dec]
runTool Tool (APINode, SpecEnum)
e ToolSettings
ts (APINode
an, SpecEnum
se)
SpSynonym APIType
ss -> forall a. Tool a -> ToolSettings -> a -> Q [Dec]
runTool Tool (APINode, APIType)
s ToolSettings
ts (APINode
an, APIType
ss)