2017年10月27日金曜日

stackageに無いパッケージの利用方法

ないので困った


どこかのネ申祭りではありません、神祭りがはじまりました、これからがめでたいネモウの始まりです...どうでもいいですが


普通に使ってると必要なパッケージは自動で入ってくるけど、無い奴に遭遇したときにやり方がわからなかったのでメモ。

まず、package.yamlのdependenciesに追加、バージョンは書かない、これで***.cabalファイルが自動で更新される

..
- serversession-backend-persistent
...

次に、stack.yamlのextra-depsへ以下を追加

..
extra-deps:
  - serversession-backend-persistent-1.0.4

このあとこれをやる、これ、忘れがち

empeleryoshi $ stack build

stack便利なんだけど、gentooのebuildとかぶるので、ちょっと気まずい感じになる。

なので浪越...


2017年10月23日月曜日

Dolphin Manと同級生

有名になったらお金をいただこうと思っています


2017東京国際映画祭に出展される「DOLPHIN MAN」に私の友人が出演します。

泳いでる人ではありません。



観にいきたいと思います、皆さんもぜひどうぞ。


となっております、ちなみにその友人は日本人です@どうでもいい


2017年10月22日日曜日

Empty YoshidaとYesodのForm

AFormとMForm


YesodにはAFormとMFormがある、「あぷりかてぃぶふぉーむ」「モナドふぉーむ」らしいが、名前をみても何が違うのが分からないのがYesod...簡単にいうと、AFormは「お手軽版」でMFormが「好きにやれよ版」。

だと思ってる...

Formの情報をhaskellの型へ流し込んだり、その逆をやったりするもの、Formをいじくる関数を定義しておいて、generateFormPost関数とかでフォームを作成する、なんでGetとかPostでフォームの作成関数が違うのかは、CSRFとかのタグの出力があるとかないとかでちがいがある。



サンプルはこちらに置いときます。

AForm


ほとんどの場合が、これで済みそうな感じ、普通のフォームを上から並べてくならAFormで十分。
ただ、renderDivs関数とかでくるむ必要があるので、ちょっと細工をしたい場合に、邪魔になるケースがある、多分こでが気に入らなかったらMForm使えってことかな。
その他に、 renderDivsNoLabels関数とかrenderTable関数とかある、サンプルはrenderBootstrap3をBootStrap用の3種類のフォームで出力してみた。

-- Formの情報がここにはいる
data FileForm = FileForm {
    fileInfo :: FileInfo
  , inpText :: Text
}

fileUploadAFormInline :: Form FileForm
fileUploadAFormInline = renderBootstrap3 BootstrapInlineForm $ getAform

fileUploadAFormBasic :: Form FileForm
fileUploadAFormBasic = renderBootstrap3 BootstrapBasicForm $ getAform

fileUploadAFormHorizon :: Form FileForm
fileUploadAFormHorizon = renderBootstrap3 (BootstrapHorizontalForm (ColXs 2) (ColXs 8) (ColXs 2) (ColXs 6)) $ getAform

getAform :: AForm Handler FileForm
getAform = FileForm
    <$> fileAFormReq fs <*> areq textField tfs Nothing
    where fs = FieldSettings {
            fsLabel = "ファイル"
          , fsTooltip = Nothing
          , fsId = Nothing
          , fsName = Just "media"
          , fsAttrs =
              [   ("class", "form-group")
                , ("placeholder", "File description")
              ]
          }
          tfs = FieldSettings {
            fsLabel = "なんかいれろ"
          , fsTooltip = Nothing
          , fsId = Just "inptext"
          , fsName = Just "inptext"
          , fsAttrs =
              [   ("class", "form-group form-control")
                , ("placeholder", "input text")
              ]
          }


フォームの情報を取得する変数を<$>と<*>でいれていく、Formコントロールにスタイル等を設定したい場合は、FieldSettingsで属性情報を追加する。

でこれをHandlerで走らせて、Widgetを取得する

getFormexamR :: Handler Html
getFormexamR = do
  (formAWidgetBasic, formAEnctypeBasic) <- generateFormPost fileUploadAFormBasic
  (formAWidgetInline, formAEnctypeInline) <- generateFormPost fileUploadAFormInline
  (formAWidgetHorizon, formAEnctypeHorizon) <- generateFormPost fileUploadAFormHorizon
  ((res, widget), enctype) <- runFormPost fileUploadMForm
  defaultLayout $ do
        setTitle "Form Example!!!"
        $(widgetFile "formexam")

MForm


こっちは細かくフォームを作成できる方、mreqでつなげるぐらいで、基本的にAFormと一緒、mreqでFormから値を取り出すときに、ResultとViewが別々にとれるので、手動でFileFormへつめてやるところぐらいが違う、HTMLを細かく調整できる。
fileUploadMForm :: Html -> MForm Handler (FormResult FileForm, Widget)
fileUploadMForm extra = do
    let fsMedia = FieldSettings {
            fsLabel = ""
          , fsTooltip = Nothing
          , fsId = Nothing
          , fsName = Just "media"
          , fsAttrs =
              [   ("class", "uploadFile")
                , ("style", "display:none")
                , ("placeholder", "")
              ]
        }
    let fsText = FieldSettings {
            fsLabel = "なんか"
          , fsTooltip = Nothing
          , fsId = Nothing
          , fsName = Just "inptext"
          , fsAttrs =
              [   ("class", "form-group form-control")
                , ("placeholder", "")
              ]
        }

    (fileInfoRes, fileInfoView) <- mreq fileField fsMedia Nothing
    (inpTextRes, inpTextView) <- mreq textField fsText Nothing
    let fileRes = FileForm <$> fileInfoRes <*> inpTextRes
    let widget = do
            [whamlet|
                #{extra}
                <label>
                    <div class="form-group">
                        <span class="btn btn-default">Upload
                            ^{fvInput fileInfoView}
                        ^{fvInput inpTextView}
            |]
    return (fileRes, widget)

これをHandlerでつかう、resにはFileFormでwidgetにはwhamletで作成したwidgetがはいる。
...
((res, widget), enctype) <- runFormPost fileUploadMForm
...

出力はこんな感じ




HTMLの出力は4種類出力してみましたが、BootstrapとHTMLの知識は皆無ですので、あまり突っ込まないでください。



2017年10月15日日曜日

ER図をテキストから作成するhaskell製ツールのerd すげぇー

こういうの探してた


綺麗に図を作ってくれるツールを使ってみました。

gentooならこれでいれて、いちようgentoo-haskellに投下しておきましたのでそのうち使えるようになると思います。

ugui7 ~ # emerge dev-haskell/erd

使い方


オフィシャルに書いてあるとおりのまんま、
ER図の元になるファイルを作る、sample.erってファイル名で保存する。

title {label: "nfldb Entity-Relationship diagram (condensed)", size: "20"}

# Entities

[player] {bgcolor: "#d0e0d0"}
  *player_id {label: "varchar, not null"}
  full_name {label: "varchar, null"}
  team {label: "varchar, not null"}
  position {label: "player_pos, not null"}
  status {label: "player_status, not null"}

[team] {bgcolor: "#d0e0d0"}
  *team_id {label: "varchar, not null"}
  city {label: "varchar, not null"}
  name {label: "varchar, not null"}

[game] {bgcolor: "#ececfc"}
  *gsis_id {label: "gameid, not null"}
  start_time {label: "utctime, not null"}
  week {label: "usmallint, not null"}
  season_year {label: "usmallint, not null"}
  season_type {label: "season_phase, not null"}
  finished {label: "boolean, not null"}
  home_team {label: "varchar, not null"}
  home_score {label: "usmallint, not null"}
  away_team {label: "varchar, not null"}
  away_score {label: "usmallint, not null"}

[drive] {bgcolor: "#ececfc"}
  *+gsis_id {label: "gameid, not null"}
  *drive_id {label: "usmallint, not null"}
  start_field {label: "field_pos, null"}
  start_time {label: "game_time, not null"}
  end_field {label: "field_pos, null"}
  end_time {label: "game_time, not null"}
  pos_team {label: "varchar, not null"}
  pos_time {label: "pos_period, null"}

[play] {bgcolor: "#ececfc"}
  *+gsis_id {label: "gameid, not null"}
  *+drive_id {label: "usmallint, not null"}
  *play_id {label: "usmallint, not null"}
  time {label: "game_time, not null"}
  pos_team {label: "varchar, not null"}
  yardline {label: "field_pos, null"}
  down {label: "smallint, null"}
  yards_to_go {label: "smallint, null"}

[play_player] {bgcolor: "#ececfc"}
  *+gsis_id {label: "gameid, not null"}
  *+drive_id {label: "usmallint, not null"}
  *+play_id {label: "usmallint, not null"}
  *+player_id {label: "varchar, not null"}
  team {label: "varchar, not null"}

[meta] {bgcolor: "#fcecec"}
  version {label: "smallint, null"}
  season_type {label: "season_phase, null"}
  season_year {label: "usmallint, null"}
  week {label: "usmallint, null"}

# Relationships

player      *--1 team
game        *--1 team {label: "home"}
game        *--1 team {label: "away"}
drive       *--1 team
play        *--1 team
play_player *--1 team

game        1--* drive
game        1--* play
game        1--* play_player

drive       1--* play
drive       1--* play_player

play        1--* play_player

player      1--* play_player


それから、erdコマンドで吐き出す、「-o」オプションで出力ファイルを指定する、ファイルの拡張子をみて出力するファイルを変換してくれる。ちょっと適当に調べて見たところ「pdf」「png」「svg」とかも出てくる、ちなみに漢字もlabelの中ならいけるっぽい。
cuomo@ugui7 ~ $ erd -i sample.er -o simple.svg

出力はこんな綺麗


すごく見やすく出力してくれる、自動でテーブル配置とかリレーション情報を出力してくれる。


しばらく使ってみようかと思う。

オフィシャル


erd
Translates a plain text description of a relational database schema to a graphical entity-relationship diagram.

2017年10月13日金曜日

スターティングgo言語買いマスタ

それが私の信念です




すたーてんぐごうげんご、買いました、オブジェクト指向はないよとか、いろいろ興味深いところもあるので、読んでみます。


2017年10月12日木曜日

三島haskell無名関数の会 復活のお知らせ

偉く無くとも正しく生きる



haskell楽しいのですが、一人でやってる感が最近加齢臭のように漂いはじめたので、そろそろ開始しようかと思います。

今までの経緯は、こちらを参照してもらうとして、やったら誰かくるかな?

まぁ、半分以上は飲み会だとは思いますが...

2017年10月9日月曜日

Yesodのsettings.ymlとセッティング

Yesodの設定


三連休も結婚式だの、2次会からただの飲み会まで、昼からやりつづけた結果、夜にはバイオレンスおじさんが登場し出すし、それを押さえつける暴力おじさんとか、もう結構ひどい有様でだいぶウケたんだけど、Yesodのsettings.ymlです

いやぁつかれましたな

Databaseの設定


settings.ymlのdatabaseセクションにかかれているのがそれ、これはDatabase.Persist.MySQL.ConnectInfoにハマる
database:
  user:     "_env:MYSQL_USER:karky7"
  password: "_env:MYSQL_PASSWORD:hongani"
  host:     "_env:MYSQL_HOST:localhost"
  port:     "_env:MYSQL_PORT:3306"
  path:     "_env:MYSQL_SOCK:/var/run/mysqld/mysqld.sock"
  # See config/test-settings.yml for an override during tests
  database: "_env:MYSQL_DATABASE:hongani"
  poolsize: "_env:MYSQL_POOLSIZE:10"

で、これがSettings.hsのAppSettingsに読み込まれるのでHandlerの中でこうやって使える。
...
    master <- getYesod
    let dbconf = myConnInfo $ appDatabaseConf $ appSettings master
...

ここで帰ってくるdbconfの型はConnectInfo型でそれからsettings.ymlに書かれているそれぞれの値を取得するには
...
    host = connectHost dbconf,
    user = connectUser dbconf,
    passwd = connectPassword dbconf,
    db = connectDatabase dbconf,
    port = (fromIntegral(connectPort dbconf) :: Int),
    socket = connectPath dbconf
...

こうやって取れる、ちなみにMySQLのConnectInfo型は
data ConnectInfo
  = ConnectInfo {
      connectHost :: String,
      connectPort :: GHC.Word.Word16,
      connectUser :: String,
      connectPassword :: String,
      connectDatabase :: String,
      connectOptions :: [Database.MySQL.Base.Types.Option],
      connectPath :: FilePath,
      connectSSL :: Maybe SSLInfo
    }
で定義されてる。

_envってなんだよ


settings.ymlの中の「_env:XXX:」見たいな書き方
database:
  ...
  path:     "_env:MYSQL_SOCK:/var/run/mysqld/mysqld.sock"
  ...

これは環境変数を利用する書き方、要するに上の例だと環境変数MYSQL_SOCKが定義してあったら、それを使ってそうじゃないなら/var/run/mysqld/mysqld.sockを使うよって意味。
~/Code/hongani $ export MYSQL_SOCK=/var/tmp/mysqld.sock
~/Code/hongani $ stack exec -- yesod devel
Yesod devel server. Enter 'quit' or hit Ctrl-C to quit.
Application can be accessed at:

http://localhost:3000
https://localhost:3443
If you wish to test https capabilities, you should set the following variable:
  export APPROOT=https://localhost:3443
...

こんな感じ

settings.ymlに設定を追加する方法


settings.ymlへ変数の追加
...
# Upload files store directory
image-dir: "/home/cuomo/files/"
...

Settings.hsのAppSettingへ登録

最初にAppSettingsへ変数を追加する

data AppSettings = AppSettings
    { appStaticDir              :: String
    -- ^ Directory from which to serve static files.
    , appDatabaseConf           :: MySQLConf
    -- ^ Configuration settings for accessing the database.
    , appRoot                   :: Maybe Text
    -- ^ Base for all generated URLs. If @Nothing@, determined
    -- from the request headers.
    , appHost                   :: HostPreference
    -- ^ Host/interface the server should bind to.
    , appPort                   :: Int
    ...
    ...
    , appImageDir               :: Text
    -- ^ Image Stored Dir <==== ここら
    , appAnalytics              :: Maybe Text
    -- ^ Google Analytics code
    , appAuthDummyLogin         :: Bool
    -- ^ Indicate if auth dummy login should be enabled.
}

次にjsonのparseに追加する、「.:」は必ず値がある場合で、「.:?」はオプション値の場合の書き方。
...
instance FromJSON AppSettings where
    parseJSON = withObject "AppSettings" $ \o -> do
    ...
    appImageDir               <- o .:  "image-dir"
    ...
...

これでHandlerで使えるようになる
...
master <- getYesod
let imgDir = appImageDir $ appSettings master
...

以上、二日酔いから復旧中です...

2017年10月7日土曜日

PersistentでUNIONって無いよね?

PersistentでUNIONしたかった


そもそも違うEntityをがっちゃんこって無理でしょ。
「rawSql使えば出きるんじゃねぇ」 
って思ってたけど、よく見てみたら、それも綺麗にEntityを返してくるから駄目ね。

うまくやればというか、他にエレガントな方法があるかもしれませんが、そんな時間無いし、多分面倒になりそうなので、普通にHDBC使って生SQL、何だかんだこれはこれですごくわかりやすい。



コード

Yesodのデータベース接続設定を直接読み込みmariadbへ接続してます、あとは普通のやつ、
普通のユーザーと 
「凄いテッカテカ」
のユーザーをUNIONして出力してます。

余談ですが、適当に初期データをuserとtekateka_userへinsertして実行してください。

全部のコードはgithubに置いてありますので興味のある人はどうぞ
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Handler.Home where

import Import
import qualified Data.Map as M
import qualified Data.Maybe as MB
import Database.Persist.MySQL (ConnectInfo(..), myConnInfo)
import Database.HDBC (execute, prepare, fetchAllRowsMap, SqlValue, fromSql)
import Database.HDBC.MySQL (Connection, MySQLConnectInfo(..),
                            defaultMySQLConnectInfo, connectMySQL)
import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3)
import Text.Julius (RawJS (..))

-- Define our data that will be used for creating the form.
data FileForm = FileForm
    { fileInfo :: FileInfo
    , fileDescription :: Text
    }

data TekaUser = TekaUser {
    tid :: Int64
  , ident :: Text
  , password :: Text
} deriving(Show, Eq)

-- This is a handler function for the GET request method on the HomeR
-- resource pattern. All of your resource patterns are defined in
-- config/routes
--
-- The majority of the code you will write in Yesod lives in these handler
-- functions. You can spread them across multiple files if you are so
-- inclined, or create a single monolithic file.
getHomeR :: Handler Html
getHomeR = do
    master <- getYesod
    (formWidget, formEnctype) <- generateFormPost sampleForm
    let submission = Nothing :: Maybe FileForm
        handlerName = "getHomeR" :: Text
        dbconf = myConnInfo $ appDatabaseConf $ appSettings master
    tekkaTeka <- liftIO $ getDBConn dbconf >>= getTekkatekaUsers
    $(logInfo) $ pack $ "=====> テカテカログ: " ++ show tekkaTeka
    defaultLayout $ do
        let (commentFormId, commentTextareaId, commentListId) = commentIds
        aDomId <- newIdent
        setTitle "Welcome To Yesod!"
        $(widgetFile "homepage")

getTekkatekaUsers :: Connection -> IO ([TekaUser])
getTekkatekaUsers con = do
    stm <- prepare con $ "SELECT u.* FROM user AS u UNION SELECT tu.* FROM tekateka_user AS tu"
    _ <- execute stm []
    rows <- fetchAllRowsMap stm
    return $ MB.catMaybes $ toTeka rows

toTeka :: [M.Map String SqlValue] -> [Maybe TekaUser]
toTeka rows = map (\m -> TekaUser
                    `liftM` (fromSql <$> M.lookup "id" m)
                    `ap` (decodeUtf8 . fromSql <$> M.lookup "ident" m)
                    `ap` (decodeUtf8 . fromSql <$> M.lookup "password" m)) rows

getDBConn :: ConnectInfo -> IO Connection
getDBConn dbconf = connectMySQL defaultMySQLConnectInfo {
                mysqlHost = connectHost dbconf,
                mysqlUser = connectUser dbconf,
                mysqlPassword = connectPassword dbconf,
                mysqlDatabase = connectDatabase dbconf,
                mysqlPort = (fromIntegral(connectPort dbconf) :: Int),
                mysqlUnixSocket = "/var/run/mysqld/mysqld.sock"
            }

sampleForm :: Form FileForm
sampleForm = renderBootstrap3 BootstrapBasicForm $ FileForm
    <$> fileAFormReq "Choose a file"
    <*> areq textField textSettings Nothing
    -- Add attributes like the placeholder and CSS classes.
    where textSettings = FieldSettings
            { fsLabel = "What's on the file?"
            , fsTooltip = Nothing
            , fsId = Nothing
            , fsName = Nothing
            , fsAttrs =
                [ ("class", "form-control")
                , ("placeholder", "File description")
                ]
            }

commentIds :: (Text, Text, Text)
commentIds = ("js-commentForm", "js-createCommentTextarea", "js-commentList")

データベースから取ってきたまんまだとMap String SqlValueで帰ってくるからそれをEntityもどきに入れ直してるだけ。

なんかうまい方法があったらだれかおしえて..



 

2017年10月5日木曜日

焼きあご塩らー麺たかはし

顎ってトビ魚


うまかったので書きました、色コユイけど塩です、結構濃厚で醤油のような味、ちょっと甘め。


汁がうまいので、痛風の人は、「全汁」禁止です...


行ってみて。