Форум программистов, компьютерный форум, киберфорум
Наши страницы
Haskell
Войти
Регистрация
Восстановить пароль
 
XRuZzz
Антикодер
1683 / 786 / 46
Регистрация: 15.09.2012
Сообщений: 2,898
1

Разрыв шаблона

02.08.2018, 19:01. Просмотров 368. Ответов 5

Всем привет!

Сделал функции, которые генерируют код для решения след. проблемы:
Кликните здесь для просмотра всего текста

Часто возникает ситуация когда, в БД есть таблица связывающая две другие таблицы. Я делаю это, чтобы избежать связи "многие ко многим". У этой таблицы 3 поля:
- собственный id
- id первой таблицы
- id второй таблицы

Вот пример кода, который должен получится:
Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
{-# LANGUAGE
    Arrows,
    DeriveGeneric,
    FlexibleInstances,
    MultiParamTypeClasses,
    OverloadedStrings,
    TemplateHaskell,
    UnicodeSyntax #-}
module VV.Web.Database.Types.SiteDomainFully (
        SiteDomainFully,
        SiteDomainFullyPGR,
        SiteDomainFullyPGW,
        PolySiteDomainFully(..),
        QuerySiteDomainFully,
        pSiteDomainFully,
        sitesTable
    ) where
 
import GHC.Generics
import Control.Arrow
import VVT.TypeClasses as ALTC(BaseId(..), Idable, getId)
import VVT.Network as ALTNET(Port(..))
import qualified Data.ByteString as BS (concat, ByteString)
import Data.Profunctor.Product.Default (Default(..))
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import VV.Web.Database.Types.Common as VVWDB (MPgIC, PgIC, schemaWeb)
import Database.PostgreSQL.Simple.FromField (FromField(..))
import Opaleye (Column, Nullable, SqlArray, SqlUuid, SqlInt4, SqlInt8, SqlText, SqlDate, SqlFloat8, SqlBool,
    Query, QueryArr, QueryRunner, QueryRunnerColumnDefault(..), Table(Table), Unpackspec,
    aggregate, fieldQueryRunnerColumn, matchNullable, isNull, ifThenElse, sqlString, groupBy,
    leftJoin, optional, required, runQuery, showSqlForPostgres, tableColumn)
import Data.Time as TM (Day)
 
data PolySiteDomainFully idn ido = SiteDomainFully {
    _id :: idn, _idUrlScheme, _idDomainFully :: ido}
    deriving (Show)
 
type SiteDomainFully = PolySiteDomainFully BaseId BaseId
type SiteDomainFullyPGW = PolySiteDomainFully MPgIC PgIC
type SiteDomainFullyPGR = PolySiteDomainFully PgIC PgIC
type QuerySiteDomainFully = Query SiteDomainFullyPGR
 
instance Idable SiteDomainFully where
    getId x = _id x
 
$(makeAdaptorAndInstance "pSiteDomainFully" ''PolySiteDomainFully)
 
sitesTable в€· Table SiteDomainFullyPGW SiteDomainFullyPGR
sitesTable = schemaWeb "sites" (pSiteDomainFully (SiteDomainFully {
                                _id = tableColumn "id",
                                _idUrlScheme = tableColumn "id_url_scheme",
                                _idDomainFully = tableColumn "id_domain_fully"}))
Файл RelationTemplate.hs:
Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
{-# LANGUAGE
    Arrows,
    DeriveGeneric,
    UnicodeSyntax,
    TemplateHaskell
    #-}
module VVT.Database.RelationTemplate (
        makeDataType,
        makeTable
    ) where
 
import GHC.Generics
import qualified Data.ByteString as BS (concat, ByteString)
import qualified Data.ByteString.Char8 as BSC8 (pack, unpack, unwords)
import Data.Text.Internal(Text)
import VVT.TypeClasses as ALCL(Idable, getId)
import VVT.Database.Types.Common as TYPES (BaseId(..))
import VVT.Database.Types.Errors as TYPES (RequestError(..))
import Control.Monad.Trans.Except as CMT (Except(..), throwE)
import Opaleye as OE ((.==), (.<=), (.&&), (.<), (.===), (.++), 
    Column, Nullable, Query, QueryArr, Table(Table), Unpackspec,
    aggregate, avg, count, groupBy, ifThenElse, isNull, leftJoin, matchNullable, queryTable, required,
    restrict, runQuery, showSqlForPostgres, sum)
import Language.Haskell.TH as LHTH
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 
makeDataType :: String -> String -> Q [Dec]
makeDataType t1 t2 =
    let
        tin s1 s2 = (mkName s1, Bang LHTH.NoSourceUnpackedness LHTH.NoSourceStrictness, VarT (mkName s2))
        t12 = t1 ++ t2
        poly_t12 = mkName ("Poly" ++ t12)
        conBaseId = ConT $ mkName "BaseId"
        pgIC = ConT $ mkName "PgIC"
        mpgIC = ConT $ mkName "MPgIC"
        t12PGR = t12 ++ "PGR"
    in return $ [
        DataD [] poly_t12 [(PlainTV (mkName "idn")), (PlainTV (mkName "ido"))] Nothing [RecC (mkName t12) [tin "_id" "idn", tin ("_id" ++ t1) "ido", tin ("_id" ++ t2) "ido"]] [],
        TySynD (mkName t12) [] (AppT (AppT (ConT poly_t12) conBaseId) conBaseId),
        TySynD (mkName (t12 ++ "PGW")) [] (AppT (AppT (ConT poly_t12) mpgIC) pgIC),
        TySynD (mkName t12PGR) [] (AppT (AppT (ConT poly_t12) pgIC) pgIC),
        TySynD (mkName ("Query" ++ t12)) [] (AppT (ConT (mkName "Query")) (ConT (mkName t12PGR))),
        InstanceD Nothing [] (AppT (ConT $ mkName "Idable") (ConT $ mkName t12)) [
            FunD (mkName "getId") [Clause [VarP $ mkName "x"] (NormalB (AppE (VarE $ mkName "_id") (VarE $ mkName "x"))) []
                ]
            ]]
 
makeTable :: String -> String -> String -> Q [Dec]
makeTable sch t1 t2 = return [
        SigD (mkName nameF) (AppT
            (AppT
                (ConT (mkName "Table"))
                (ConT (mkName (allCamel ++ "PGW"))))
            (ConT (mkName (allCamel ++ "PGR")))),
        ValD (VarP (mkName nameF)) (NormalB (AppE
            (AppE
                (AppE (ConE (mkName "TableWithSchema")) (LitE (StringL sch)))
                (LitE (StringL nameTable))
            )
            (AppE (UnboundVarE  (mkName pName)) (RecConE (mkName allCamel) [
                    crTuple [],
                    crTuple t1u,
                    crTuple t2u
                ]) ))) []]
    where
        t1u = words t1
        t2u = words t2
        nameF = head t1u ++ toCamel (tail t1u) ++ toCamel t2u ++ "Table"
        toCamel = concatMap (\(x:xs) -> toUpper x :xs)
        nameTable = intercalate "_" $ t1u ++ t2u
        allCamel = toCamel (t1u ++ t2u)
        pName = 'p' : allCamel
        crTuple x = (mkName ("_id" ++ toCamel x), AppE (UnboundVarE (mkName "tableColumn")) (LitE (StringL ("id_" ++ intercalate "_" x))))
Файл Relations.dump-splices после компиляции:
Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
src/VV/Web/Database/Types/Relations.hs:34:3-35: Splicing declarations
    makeDataType "Site" "DomainFully"
  ======>
    data PolySiteDomainFully idn ido
      = SiteDomainFully {_id :: idn,
                         _idSite :: ido,
                         _idDomainFully :: ido}
    type SiteDomainFully = PolySiteDomainFully BaseId BaseId
    type SiteDomainFullyPGW = PolySiteDomainFully MPgIC PgIC
    type SiteDomainFullyPGR = PolySiteDomainFully PgIC PgIC
    type QuerySiteDomainFully = Query SiteDomainFullyPGR
    instance Idable SiteDomainFully where
      getId x = _id x
src/VV/Web/Database/Types/Relations.hs:36:3-78: Splicing declarations
    makeAdaptorAndInstance
      ("p" ++ "Site" ++ "DomainFully") ''PolySiteDomainFully
  ======>
    pSiteDomainFully ::
      forall p a1_0 a2_0 a1_1 a2_1.
      product-profunctors-0.9.0.0:Data.Profunctor.Product.Class.ProductProfunctor p =>
      PolySiteDomainFully (p a1_0 a1_1) (p a2_0 a2_1)
      -> p (PolySiteDomainFully a1_0 a2_0) (PolySiteDomainFully a1_1 a2_1)
    pSiteDomainFully f
      = ((product-profunctors-0.9.0.0:Data.Profunctor.Product.Class.****)
           (((product-profunctors-0.9.0.0:Data.Profunctor.Product.Class.****)
               (((Data.Profunctor.Product.***$) SiteDomainFully)
                  ((profunctors-5.2.2:Data.Profunctor.Unsafe.lmap _id) (_id f))))
              ((profunctors-5.2.2:Data.Profunctor.Unsafe.lmap _idSite)
                 (_idSite f))))
          ((profunctors-5.2.2:Data.Profunctor.Unsafe.lmap _idDomainFully)
             (_idDomainFully f))
    instance (product-profunctors-0.9.0.0:Data.Profunctor.Product.Class.ProductProfunctor p,
              product-profunctors-0.9.0.0:Data.Profunctor.Product.Default.Class.Default p a1_0 a1_1,
              product-profunctors-0.9.0.0:Data.Profunctor.Product.Default.Class.Default p a2_0 a2_1) =>
             product-profunctors-0.9.0.0:Data.Profunctor.Product.Default.Class.Default p (PolySiteDomainFully a1_0 a2_0) (PolySiteDomainFully a1_1 a2_1) where
      product-profunctors-0.9.0.0:Data.Profunctor.Product.Default.Class.def
        = pSiteDomainFully
            (((SiteDomainFully
                 product-profunctors-0.9.0.0:Data.Profunctor.Product.Default.Class.def)
                product-profunctors-0.9.0.0:Data.Profunctor.Product.Default.Class.def)
               product-profunctors-0.9.0.0:Data.Profunctor.Product.Default.Class.def)
src/VV/Web/Database/Types/Relations.hs:39:3-39: Splicing declarations
    makeTable "web" "site" "domain fully"
  ======>
    siteDomainFullyTable :: Table SiteDomainFullyPGW SiteDomainFullyPGR
    siteDomainFullyTable
      = ((TableWithSchema "web") "site_domain_fully")
          (pSiteDomainFully
             SiteDomainFully
               {_id = tableColumn "id_", _idSite = tableColumn "id_site",
                _idDomainFully = tableColumn "id_domain_fully"})


Файл Relations.hs, в котором происходят вызовы шаблонов:
Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
{-# LANGUAGE
    Arrows,
    DeriveGeneric,
    FlexibleInstances,
    MultiParamTypeClasses,
    OverloadedStrings,
    TemplateHaskell,
    UnicodeSyntax #-}
module VV.Web.Database.Types.Relations () where
 
import GHC.Generics
import Control.Arrow
import VVT.TypeClasses as ALTC(BaseId(..), Idable, getId)
import VVT.Network as ALTNET(Port(..))
import qualified Data.ByteString as BS (concat, ByteString)
import qualified Data.ByteString.Char8 as BSC8 (pack, unpack, unwords)
import Data.Profunctor.Product.Default (Default(..))
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import VV.Web.Database.Types.Common as VVWDB (MPgIC, PgIC, schemaWeb)
import Database.PostgreSQL.Simple.FromField (FromField(..))
import Opaleye (Column, Nullable, SqlArray, SqlUuid, SqlInt4, SqlInt8, SqlText, SqlDate, SqlFloat8, SqlBool,
    Query, QueryArr, QueryRunner, QueryRunnerColumnDefault(..), Table(Table), Unpackspec,
    aggregate, fieldQueryRunnerColumn, matchNullable, isNull, ifThenElse, sqlString, groupBy,
    leftJoin, optional, required, runQuery, showSqlForPostgres, tableColumn)
import Data.Time as TM (Day)
 
import VVT.Database.RelationTemplate
 
$(makeDataType "Site" "DomainFully")
 
$(makeAdaptorAndInstance "pSiteDomainFully" ''PolySiteDomainFully)  -- Функция makeAdaptorAndInstance не моя,
                                    -- но возвращает тип Q [Dec], как и мои.
 
$(makeTable "web" "site" "domain fully") -- Здесь генеруется функция, которая нуждается в том,
                            -- чтобы шаблоны makeDataType и makeAdaptorAndInstance были уже сгенерированы
Так вот, вопрос как(и можно ли) makeAdaptorAndInstance вставить внутрь, скажем в makeDataType?

Для того, чтобы можно было сделать одну общую функцию для генерации кода всего файла:
Haskell
1
$(makeRelation "web" "site" "domain fully")
Кроме того принимаются любые замечания по коду.
0
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
02.08.2018, 19:01
Ответы с готовыми решениями:

"Разрыв шаблона" - верстка шаблона
Доброго времени суток, комрады форумчане. Столкнулся со смешной, на первый взгляд, проблемой...

Определение метода-шаблона за пределами шаблона класса
День добрый! Разбираюсь в шаблонах, решил копнуть поглубже. Вот пример: template &lt;typename T1&gt;...

Редактирование шаблона сайта и шаблона письма
Помогите найти , где и как ? Т.е. уже 3 дня роюсь и не в состоянии найти где убить пару кнопок и...

Разрыв Wi-Fi
Есть проблема, которую все не могу решить. Ситуевина такая: есть два компа (ноут и нетбук), ноут...

Разрыв строки
Вот учу php не могу понять почему не происходит разрыв строки, а вдобавок ко все ошибку выдает ...

5
Curry
2991 / 2072 / 257
Регистрация: 01.06.2013
Сообщений: 4,526
Записей в блоге: 9
02.08.2018, 21:59 2
Цитата Сообщение от XRuZzz Посмотреть сообщение
как(и можно ли) makeAdaptorAndInstance вставить внутрь, скажем в makeDataType?
Вызвать функцию makeAdaptorAndInstance из функции makeDataType? Какие проблемы?
Создаёте свой тип в своей функции, его имя передаёте makeAdaptorAndInstance, возвращаемый этой функции список объединяете с тем что сами нагенерили и общий список возвращаете.
1
XRuZzz
Антикодер
1683 / 786 / 46
Регистрация: 15.09.2012
Сообщений: 2,898
03.08.2018, 14:43  [ТС] 3
Ну если написать в файле RelationTemplate.hs:
Haskell
1
2
3
4
5
makeRelation ::  String -> String -> Q [Dec]
makeRelation s1 s2 = do
    c1 <- makeDataType s1 s2
    c2 <- makeAdaptorAndInstance "pSiteDomainFully" (mkName "PolySiteDomainFully")
    return $ c1 ++ c2
то при генерации компилятор ругается на файл Relation.hs:
Bash
1
2
3
4
5
Relations.hs:34:3: error:
        ‘PolySiteDomainFully’ is not in scope at a reify
       |
    34 | $(makeRelation "Site" "DomainFully")
       |   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
То есть когда генерируется makeAdaptorAndInstance, PolySiteDomainFully должен быть уже сгенерирован в makeDataType.
1
Curry
2991 / 2072 / 257
Регистрация: 01.06.2013
Сообщений: 4,526
Записей в блоге: 9
03.08.2018, 22:02 4
XRuZzz, увы, Вы правы. Похоже генерируемый список Q [Dec] не ленивый, и даже если мы определяем тип в начале списка, он не будет виден функции reify (вызываемой в makeAdaptorAndInstance) пока мы не выйдем из внешней splice функции и то что она нагенерила не "увидит" компилятор.

Нужно продвинутых спрашивать в чате.

Мой неудачный эксперимент
Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
{-# LANGUAGE TemplateHaskell #-}
module MyTemplates where
 
import Language.Haskell.TH
 
foo:: Name -> DecsQ
foo n = do
    info <- reify n
    let fn = mkName "fooGeneratedFunction"
    sequence [sigD fn [t| String |]
             ,funD fn [clause [] (normalB [| $(stringE $ show info) |]) []]
             ]
 
bar::  DecsQ
bar = do
    let nameMyType = mkName "MyType"
        nameMyConstr = mkName "MyConstr" 
    (:) <$> (dataD (return []) nameMyType [] Nothing [normalC nameMyConstr []] [])
        <*> (foo nameMyType)
Haskell
1
2
3
4
5
6
7
8
9
{-# LANGUAGE TemplateHaskell #-}
module Main where
 
import MyTemplates
 
bar
 
main :: IO ()
main = putStrLn fooGeneratedFunction
1
XRuZzz
Антикодер
1683 / 786 / 46
Регистрация: 15.09.2012
Сообщений: 2,898
04.08.2018, 12:06  [ТС] 5
хотя бы понять, как написать:
Haskell
1
2
3
$(makeDataType "Site" "DomainFully")
$(makeAdaptorAndInstance "pSiteDomainFully" ''PolySiteDomainFully)
$(makeTable "web" "site" "domain fully")
в одной функции:
Haskell
1
2
3
4
5
6
relation sch s1 s2 =
  $(makeDataType (f1 s1) (f2 s2)
  $(makeAdaptorAndInstance ('p' : f12)  (mkName ("Poly" ++ f12)) )
  $(makeTable sch s1 s2)
  where
    f12 = f1 s1 ++ f1 s2
0
Curry
2991 / 2072 / 257
Регистрация: 01.06.2013
Сообщений: 4,526
Записей в блоге: 9
04.08.2018, 13:23 6
Цитата Сообщение от XRuZzz Посмотреть сообщение
в одной функции
так splic-ы же и развернуться внутри тела функции. А определять типы, к примеру, внутри функции в Haskell нельзя.
Если хочется что бы несколько splic-ов вызывались в одной строке, то предлагаю тривиально-сермяжный способ.
Haskell
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
{-# LANGUAGE TemplateHaskell #-}
module MyTemplates where
 
import Language.Haskell.TH
 
foo:: Name -> DecsQ
foo n = do
    info <- reify n
    let fn = mkName "fooGeneratedFunction"
    sequence [sigD fn [t| String |]
             ,funD fn [clause [] (normalB [| $(stringE $ show info) |]) []]
             ]
 
bar:: String -> DecsQ
bar typeName = do
    let nameMyType = mkName typeName
        nameMyConstr = mkName "MyConstr" 
    (:[]) <$> (dataD (return []) nameMyType [] Nothing [normalC nameMyConstr []] [])
Haskell
1
2
3
4
5
6
7
8
9
10
11
12
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module Main where
 
import MyTemplates
 
#include "RelationDefine.h"
 
RELATION_DEF(MyType)
 
main :: IO ()
main = putStrLn fooGeneratedFunction
RelationDefine.h :
C
1
#define RELATION_DEF(t) bar "t";foo ''t
1
04.08.2018, 13:23
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
04.08.2018, 13:23

Разрыв соеденения
Всем доброго времени суток! Решил вот наконец-то перейти на Windows 7 и возникла такая проблема: ...

Разрыв сети
Привет ребята! Небольшая предыстория. Организация работает с прогой 1С Рарус,которая стоит не...

Разрыв дат
Здравствуйте. кто-нибудь может помочь? у меня выводятся 2 даты, 1 начало, 2 окончания. и сразу же...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
6
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.