2019年5月14日火曜日

YesodのFileInfoにハマった

Yesodでアップロードファイルを扱うのにFileInfo型を使うんだけどこれ


data FileInfo = FileInfo {
    fileName :: !Text,
    fileContentType :: !Text,
    fileSourceRaw :: !(ConduitT () ByteString (ResourceT IO) ()),
    fileMove :: !(FilePath -> IO ())
}

これのfileSourceRawなんだが、こうやってとってみると[ByteString]がでてくる


bss <- sourceToList $ fileSource finfo

でたまたまこれをbase64化すればhtmlのimgタグで見れるかとおもいこうやってTextへ変換してhamletテンプレートに出力してみた

import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
...
byteString2Base64 :: [ByteString] -> T.Text
byteString2Base64 = decodeUtf8 . B64.encode . C.unwords

これで吐かれたテキストを


<img src="data:#{contentType};base64,#{b64img}" class="img-fluid mx-auto d-block" alt="">

b64imgにbase64のTextが流れてくが、これが甘い



これだと出力される画像が途中で腐ってしまう、しばらくハマる...よくよく調べてみると、こんなのあった


fileSourceByteString!!

Yesod.Core.Handlerで定義されテイルではないですか、、、やりたかったことそのまんま。

気になったので実装みてみたら....


fileSourceByteString :: MonadResource m => FileInfo -> m S.ByteString
fileSourceByteString fileInfo = runConduit (L.toStrict <$> (fileSource fileInfo .| sinkLazy))

なんか、CombinatorsでつなげてLazyをStrictに直してるようにしか見えないけど、sourceToListを使った方法との違いが分からない。

まぁ結果オーライとします。

2019年4月26日金曜日

悪い予感が的中したよ

今日は朝出てくるときに、嫌な感じがしたが、的中した。


初めは洒落てた、


どこかの国の洒落たびー


だから何だよ、結局、これ


そして、帰りたい


自力でいけるか、長い


やることなくなって結局こうなる。


長いGW開始したけど、皆さんお元気で.....

2019年4月25日木曜日

haskellの例外処理

多分よく分かってない

今日は割り込みによって例外が発生し、ビールを買ってしまいました、みたいな帰宅モナドのなかの話。



bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket :: (とりあえずやってみろ) -> (ダメだイケてなかったから何とかしろ) -> (とりあえずがイケてるならやれ) -> IO (うまくいった結果よこせ)

try..cache..finally みたいなやつです

getFileMimeType :: String -> IO (Maybe ImageContents)
getFileMimeType file = do
    magic <- magicOpen [MagicMimeType]
    magicLoadDefault magic
    mt <- try $ magicFile magic file
    case mt of
        Left (err::IOException) -> return Nothing
        Right mimeType -> do
            contents <- bracket (openFile file ReadMode) hClose hGetContents
            return $ return $ ImageContents { unMimeType = packChars mimeType, unImageBuff = contents }

ちなみにLeft (err::IOException)がScopedTypeVariables拡張が必要らしいです。

2019年4月23日火曜日

esqueletoでjoinとかイケてないcountとか

ちょっと癖が強いesqueletoですが、やはりhaskellの型安全なところでできるのがいい感じになる、まぁそんな個人的な感想はどうでもいいよっていつも言われるが...

こんな構成のデータベースにある3テーブルの各レコードをusr_member_idでjoinしてとるSQLを書いてみた



でコード、yesodのHandlerモナドの中から呼んでいるのでHandler Appになっているのは許してもらうとしてこんな感じ

getUsers :: Param -> HandlerFor App ([(E.Entity UsrMember, E.Value Text, E.Value Int)], Int)
getUsers p = runDB $ do
    let pagePerLine = fromIntegral $ unPagePerLine p
        page = fromIntegral $ unPageNum p
        reqId = fromIntegral $ unReqId p
        typeIds = [1, 2]
        (ageFrom, ageTo) = (unAgeFrom p, unAgeTo p)
        baseQuery = E.from $ \(usrMember `E.InnerJoin` usrImage `E.InnerJoin` usrAgeView) -> do
            E.on $ usrMember E.^. UsrMemberUsrMemberId E.==. usrAgeView E.^. UsrAgeViewUid
            E.on $ usrMember E.^. UsrMemberUsrMemberId E.==. usrImage E.^. UsrImageUsrId
            E.where_ $ do
                let reqQuery = usrMember E.^. UsrMemberReqId E.==. E.val reqId
                    ageQuery = usrAgeView E.^. UsrAgeViewAge E.>=. E.val ageFrom 
                             E.&&. usrAgeView E.^. UsrAgeViewAge E.<=. E.val ageTo
                usrMember E.^. UsrMemberTypeId `E.in_` E.valList typeIds
                    E.&&. (if reqId > 0 then reqQuery else E.val True)
                    E.&&. (if ageFrom > 0 && ageTo > 0 then ageQuery else E.val True)
                    E.&&. usrImage E.^. UsrImageImageDiv E.==. E.val 2
            return (usrMember, usrImage E.^. UsrImageFileName, usrAgeView E.^. UsrAgeViewAge)
        baseQueryPage = do r <- baseQuery; E.offset (pagePerLine * page); E.limit pagePerLine; return r
    cnt <- Import.length <$> E.select baseQuery
    s <- E.select baseQueryPage
    return (s,  cnt)


where句に条件で追加する方法、haskellのifは型を合わせる必要があるので、then、elseの
ところをexpr(Value a)にする必要があって、「E.val True」にするのは気がつかなかった、あとはoffsetだのlimitだのを後で追加する方法とかも参考になった。
 
ただ、カウントの取得方法がわからず、上のコードだと無駄なとり方になっているのはごめんなさい、どうしてもjoinした場合のcountRowsやその他の集計関数がうまく組み込めなかった。
どなたか教えては頂けないでしょうか?...

コードはこちらに置いておきます、「えすきゅーぅうれっちゅ」ネタでした。


2019年4月15日月曜日

emacsでSymbol's value as variable is void: last-command-char

emacsでanthyが動かない


emacsでanthyしようとおもったらできない。

そしたら、init.elこれかけと

(define-obsolete-variable-alias 'last-command-char 'last-command-event "at least 19.34")

何だこれ、意味分からん...

が、動いた、こういうのヤメテェー

2019年3月31日日曜日

persistentとsequence

Persistentでsequenceの扱い

Persistentからデータベースにテーブルやらを作成すると、自動でidと言う名前でサロゲートキーが生成される。 これなら簡単にinsertできる、insertしたエンティティの自動採番されたidを返してくる。
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Person
    name String
    age Int Maybe
    deriving Show
|]
...
...
    uid <- insert $ Person "Mac" $ Just 20
...
これはこれでいいのですが、既にシーケンスとかあって、それから採番している場合、モデルの書き方が変わってちょっと面倒くさくなる。
こんな感じ...
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
NiceGuy
    niceGuyId Int sqltype=bigint default=nextval('nice_guy_id_seq')
    name Text
    age Int
    authorizedDate Day Maybe sqltype=date
    regTime UTCTime sqltype=timestamptz
    Primary niceGuyId
    deriving Show
NiceGuyPet
    name Text
    niceGuyId NiceGuyId
    deriving Show

insertのときniceGuyNiceGuyIdにIntを要求されて「ウゼェー」ってなる

シーケンスを手動でとる


小一時間ほどPersistentまわりを調べたのですがあまりいいやり方が見つからなかったので適当に解決した
getNiceGuySeq :: MonadIO m => ReaderT SqlBackend m [Single Int]
getNiceGuySeq = rawSql "select nextval('nice_guy_id_seq')" []
Singleの中にシーケンスが入って返ってくる
動かした後のデータベースの中身はこちら
$ stack run
Migrating: CREATe TABLE "nice_guy"( PRIMARY KEY ("nice_guy_id"),"nice_guy_id" bigint NOT NULL DEFAULT nextval('nice_guy_id_seq'),"name" VARCHAR NOT NULL,"age" INT8 NOT NULL,"authorized_date" date NULL,"reg_time" timestamptz NOT NULL)
Migrating: CREATe TABLE "nice_guy_pet"("id" SERIAL8  PRIMARY KEY UNIQUE,"name" VARCHAR NOT NULL,"nice_guy_id" INT8 NOT NULL)
Migrating: ALTER TABLE "nice_guy_pet" ADD CONSTRAINT "nice_guy_pet_nice_guy_id_fkey" FOREIGN KEY("nice_guy_id") REFERENCES "nice_guy"("nice_guy_id")
insert nice_guy__id: NiceGuyKey {unNiceGuyKey = 1} / nice_guy_pet_id: NiceGuyPetKey {unNiceGuyPetKey = SqlBackendKey {unSqlBackendKey = 1}}
insert nice_guy__id: NiceGuyKey {unNiceGuyKey = 2} / nice_guy_pet_id: NiceGuyPetKey {unNiceGuyPetKey = SqlBackendKey {unSqlBackendKey = 2}}
insert nice_guy__id: NiceGuyKey {unNiceGuyKey = 3} / nice_guy_pet_id: NiceGuyPetKey {unNiceGuyPetKey = SqlBackendKey {unSqlBackendKey = 3}}

$ psql -U sample sampledb
psql (9.6.12)
Type "help" for help.

sampledb=>
sampledb=> \d
                List of relations
 Schema |        Name         |   Type   | Owner
--------+---------------------+----------+--------
 public | nice_guy            | table    | sample
 public | nice_guy_id_seq     | sequence | sample
 public | nice_guy_pet        | table    | sample
 public | nice_guy_pet_id_seq | sequence | sample
(4 rows)

sampledb=> select * from nice_guy;
 nice_guy_id |    name    | age | authorized_date |           reg_time
-------------+------------+-----+-----------------+-------------------------------
           1 | 玉輿平八郎 |  55 | 2019-03-31      | 2019-03-31 14:11:05.500591+09
           2 | 骨川筋太郎 |  47 | 2019-03-31      | 2019-03-31 14:11:05.517138+09
           3 | 裏筋太郎   |  75 | 2019-03-31      | 2019-03-31 14:11:05.525973+09
(3 rows)

sampledb=> select * from nice_guy_pet;
 id |   name   | nice_guy_id
----+----------+-------------
  1 | モッコ   |           1
  2 | めん     |           2
  3 | スージー |           3
(3 rows)
こんな感じ
全部のサンプルコードはgithubへあげておきます、興味のある方はどうぞ。

empty yoshidaとPersistent物語はこちら

もうちょい綺麗なやり方あんのかなぁ...

2019年2月10日日曜日

qtのAA_EnableHighDpiScaling

qt5のAA_EnableHighDpiScalingってなに

最近、PostgreSQLが使いやすくて、pgmodelerつかっているのですが、qtとのカラミがうまくいってないようで、画面サイズとウインドウサイズが合わなくてイライラしてたのでちょっと調べてみた。

qtは詳しくないが、怪しげなところにpatchあてて試したら、思いのほかうまくいったっぽい。


//High DPI suport via application attributes is available only from Qt 5.6.0
#if (QT_VERSION >= QT_VERSION_CHECK(5, 6, 0))
   Application::setAttribute(Qt::AA_EnableHighDpiScaling);
#endif

問題のばしょ、QTのバージョンがそれなら、Application::setAttributeが呼ばれるところを、削除したところ、うまくモニターのサイズにウインドウがフィットして表示された。

qt5がわるいのか、Xのライブラリが悪いのか不明なのですが、取り合えずこれなんだ?

ちなみに、我のqtのバージョンは5.11.3です、qtを利用するアプリケーション全般がそれっぽい。