module HBooru.Parsers.GenericBooru.TH where
import Control.Applicative
import HBooru.Types
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
makePost n = liftA2 (++) (makePost' n) (makePostInstance n)
makePost' :: Name -> Q [Dec]
makePost' n =
fmap (:[]) $ dataD (cxt []) n []
[ recC n
[ varStrictType (mkName "heightT") $ strictType notStrict [t| Integer |]
, varStrictType (mkName "scoreT") $ strictType notStrict [t| Integer |]
, varStrictType (mkName "file_urlT") $ strictType notStrict [t| String |]
, varStrictType (mkName "parent_idT") $ strictType notStrict
[t| Maybe Integer |]
, varStrictType (mkName "sample_urlT") $ strictType notStrict [t| String |]
, varStrictType (mkName "sample_widthT") $ strictType notStrict
[t| Integer |]
, varStrictType (mkName "sample_heightT") $ strictType notStrict
[t| Integer |]
, varStrictType (mkName "preview_urlT") $ strictType notStrict [t| String |]
, varStrictType (mkName "ratingT") $ strictType notStrict [t| Rating |]
, varStrictType (mkName "tagsT") $ strictType notStrict [t| [String] |]
, varStrictType (mkName "idT") $ strictType notStrict [t| Integer |]
, varStrictType (mkName "widthT") $ strictType notStrict [t| Integer |]
, varStrictType (mkName "changeT") $ strictType notStrict [t| String |]
, varStrictType (mkName "md5T") $ strictType notStrict [t| String |]
, varStrictType (mkName "creator_idT") $ strictType notStrict [t| Integer |]
, varStrictType (mkName "has_childrenT") $ strictType notStrict
[t| Maybe Bool |]
, varStrictType (mkName "created_atT") $ strictType notStrict [t| String |]
, varStrictType (mkName "statusT") $ strictType notStrict [t| String |]
, varStrictType (mkName "sourceT") $ strictType notStrict [t| String |]
, varStrictType (mkName "has_notesT") $ strictType notStrict
[t| Maybe Bool |]
, varStrictType (mkName "has_commentsT") $ strictType notStrict
[t| Maybe Bool |]
, varStrictType (mkName "preview_widthT") $ strictType notStrict
[t| Integer |]
, varStrictType (mkName "preview_heightT") $ strictType notStrict
[t| Integer |]
]
] [mkName "Show", mkName "Eq"]
makePostInstance :: Name -> Q [Dec]
makePostInstance n = do
return [InstanceD
[]
(ConT (mkName "Post") `AppT` ConT n)
[ onG "height", onG "score", onG "file_url", onG "parent_id"
, onG "sample_url", onG "sample_width", onG "sample_height"
, onG "preview_url", onG "rating", onG "tags", onG "id"
, onG "width", onG "change", onG "md5", onG "creator_id"
, onG "has_children", onG "created_at", onG "status"
, onG "source", onG "has_notes", onG "has_comments"
, onG "preview_width", onG "preview_height"
]
]
where
onG n = FunD (mkName n)
[ Clause [(VarP (mkName "g"))]
(NormalB (AppE (VarE (mkName $ n ++ "T"))
(VarE (mkName "g")))) []
]