├── Setup.hs ├── img ├── loadingView.png ├── rssfeedView.png └── selectioinView.png ├── .gitignore ├── rss.yml ├── cli-rss-reader.cabal ├── Main.hs └── README.md /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /img/loadingView.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lotz84/cli-rss-reader/HEAD/img/loadingView.png -------------------------------------------------------------------------------- /img/rssfeedView.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lotz84/cli-rss-reader/HEAD/img/rssfeedView.png -------------------------------------------------------------------------------- /img/selectioinView.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lotz84/cli-rss-reader/HEAD/img/selectioinView.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | *.dyn_o 8 | *.dyn_hi 9 | .hpc 10 | .hsenv 11 | .cabal-sandbox/ 12 | cabal.sandbox.config 13 | *.prof 14 | *.aux 15 | *.hp 16 | .stack-work/ 17 | -------------------------------------------------------------------------------- /rss.yml: -------------------------------------------------------------------------------- 1 | - 2 | title: flip map 3 | url : http://lotz84.github.io/feed.xml 4 | - 5 | title: Planet Haskell 6 | url : http://planet.haskell.org/rss20.xml 7 | - 8 | title: reddit - Haskell 9 | url : https://www.reddit.com/r/haskell/.rss 10 | -------------------------------------------------------------------------------- /cli-rss-reader.cabal: -------------------------------------------------------------------------------- 1 | name: cli-rss-reader 2 | version: 0.1.0.0 3 | license: BSD3 4 | author: Tatsuya Hirose 5 | maintainer: tatsuya.hirose.0804@gmail.com 6 | build-type: Simple 7 | cabal-version: >=1.10 8 | 9 | executable cli-rss-reader 10 | main-is: Main.hs 11 | build-depends: base >=4.8 && <4.9 12 | , process >=1.2 && <1.3 13 | , mtl >=2.2 && <2.3 14 | , transformers >=0.4 && <0.5 15 | , http-conduit >=2.1 && <2.2 16 | , lens >=4.12 && <4.13 17 | , yaml-light >=0.1 && <0.2 18 | , yaml-light-lens >=0.3 && <0.4 19 | , xml-conduit >=1.4 && <2.0 20 | , xml-lens >=0.1 && <0.2 21 | , vty >=5.2 && <5.3 22 | ghc-options: -threaded 23 | default-language: Haskell2010 24 | -------------------------------------------------------------------------------- /Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | import Control.Concurrent 4 | import Control.Concurrent.MVar 5 | import Control.Monad.Except 6 | import Control.Monad.IO.Class 7 | import Control.Monad.Reader 8 | import Data.Text.Lens 9 | import Data.Yaml.YamlLight 10 | import Data.Yaml.YamlLight.Lens 11 | import Graphics.Vty 12 | import Network.HTTP.Conduit 13 | import System.Process 14 | import Text.XML 15 | import Text.XML.Lens 16 | import qualified Text.XML.Lens as XML 17 | 18 | data RSS = RSS { _title :: String, _url :: String } deriving Show 19 | 20 | getRSSList :: IO [RSS] 21 | getRSSList = do 22 | yaml <- parseYamlFile "rss.yml" 23 | let y2r y = do 24 | title <- y ^? key "title" . _Yaml 25 | url <- y ^? key "url" . _Yaml 26 | return $ RSS title url 27 | return $ yaml ^.. each . folding y2r 28 | 29 | data AppException = AppEscape 30 | 31 | type App = ExceptT AppException (ReaderT Vty IO) 32 | 33 | runApp :: Vty -> App a -> IO (Either AppException a) 34 | runApp vty = (flip runReaderT vty) . runExceptT 35 | 36 | selectionView :: [RSS] -> Int -> App RSS 37 | selectionView rssList selecting = do 38 | vty <- ask 39 | let header = string (defAttr `withStyle` underline) "閲覧するRSSを選択してください" 40 | tableStyle n = if n == selecting then defAttr `withStyle` reverseVideo else defAttr 41 | table = vertCat $ map (\(rss, n) -> string (tableStyle n) (_title rss)) $ zip rssList [0..] 42 | pic = picForImage $ header <-> table 43 | liftIO $ update vty pic 44 | e <- liftIO $ nextEvent vty 45 | case e of 46 | EvKey KEsc _ -> throwError AppEscape 47 | EvKey KEnter _ -> return $ rssList !! selecting 48 | EvKey (KChar 'j') _ -> selectionView rssList (min (length rssList - 1) (selecting + 1)) 49 | EvKey (KChar 'k') _ -> selectionView rssList (max 0 (selecting - 1)) 50 | _ -> selectionView rssList selecting 51 | 52 | loadingView :: RSS -> App Document 53 | loadingView rss = do 54 | vty <- ask 55 | result <- liftIO $ newEmptyMVar 56 | liftIO . forkIO $ do 57 | body <- simpleHttp (_url rss) 58 | let doc = parseLBS_ def body 59 | putMVar result doc 60 | liftIO . ($ 0) . fix $ \loop n -> do 61 | let gauge = string defAttr $ "Downloading" ++ take n (repeat '.') 62 | pic = picForImage gauge 63 | update vty pic 64 | threadDelay 200000 65 | doc <- tryTakeMVar result 66 | case doc of 67 | Nothing -> loop (n+1) 68 | Just doc -> return doc 69 | 70 | data RSSFeedViewAction = RSSFeedViewBack | RSSFeedViewPreview String 71 | 72 | rssfeedView :: Document -> Int -> App RSSFeedViewAction 73 | rssfeedView doc selecting = do 74 | vty <- ask 75 | let title = maybe "no title" id $ doc ^? root ./ el "channel" ./ el "title" . XML.text . unpacked 76 | items = doc ^.. root ./ el "channel" ./ el "item" ./ el "title" . XML.text .unpacked 77 | header = string (defAttr `withStyle` underline) $ title 78 | tableStyle n = if n == selecting then defAttr `withStyle` reverseVideo else defAttr 79 | table = vertCat $ map (\(item, n) -> string (tableStyle n) item) $ zip items [0..] 80 | pic = picForImage $ header <-> table 81 | liftIO $ update vty pic 82 | e <- liftIO $ nextEvent vty 83 | case e of 84 | EvKey KEsc _ -> return RSSFeedViewBack 85 | EvKey KEnter _ -> do 86 | let url = (!! selecting) $ doc ^.. root ./ el "channel" ./ el "item" ./ el "link" . XML.text . unpacked 87 | return $ RSSFeedViewPreview url 88 | EvKey (KChar 'j') _ -> rssfeedView doc (min (length items - 1) (selecting + 1)) 89 | EvKey (KChar 'k') _ -> rssfeedView doc (max 0 (selecting - 1)) 90 | _ -> rssfeedView doc selecting 91 | 92 | previewView :: String -> App () 93 | previewView url = do 94 | liftIO $ createProcess $ shell $ "open " ++ url 95 | return () 96 | 97 | main :: IO () 98 | main = do 99 | vty <- standardIOConfig >>= mkVty 100 | rssList <- getRSSList 101 | runApp vty . forever $ do 102 | rss <- selectionView rssList 0 103 | doc <- loadingView rss 104 | fix $ \loop -> do 105 | act <- rssfeedView doc 0 106 | case act of 107 | RSSFeedViewBack -> return () 108 | RSSFeedViewPreview url -> previewView url >> loop 109 | shutdown vty 110 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Vtyを使って作る簡単なRSSリーダー 2 | [vty](https://hackage.haskell.org/package/vty)はテキストベースのUIを作れるようになるライブラリです。頑張ればvimのようなものを作れるようになります（がんばれば！） 3 | 4 | このvtyを使って簡単なRSSリーダーを作ったので簡単に解説してみたいと思います。完成したものはこのレポジトリを`git clone`して`cabal install && cabal run`をすれば試すことができます。 5 | 6 | ## HelloWorld 7 | まずはVtyの基本的な例です。実際に手元で動かしてみてください！ 8 | 9 | ```haskell 10 | import Graphics.Vty 11 | 12 | main = do 13 | vty <- standardIOConfig >>= mkVty 14 | update vty . picForImage $ string (defAttr `withForeColor` green) "Hello vty" 15 | e <- nextEvent vty 16 | shutdown vty 17 | print e 18 | ``` 19 | 20 | `cabal install vty` を忘れずに！この例は[Graphics.Vty](https://hackage.haskell.org/package/vty/docs/Graphics-Vty.html)に載っているものをもう少し簡略化したものです。まず 21 | 22 | ```haskell 23 | vty <- standardIOConfig >>= mkVty 24 | ``` 25 | 26 | で操作の対象になる`Vty`型の値`vty`を作成します。UIに関する処理はこの`vty`を通じて行っていきます。 27 | 28 | ```haskell 29 | update vty . picForImage $ string (defAttr `withForeColor` green) "Hello vty" 30 | ``` 31 | 32 | `string (defAttr 'withForeColor' green) "Hello vty"`で文字色が緑で"Hello vty"と書かれた`Image`を作成し`picForImage`を使って`Picture`に変換したあと`update vty`で画面に描画しています。 33 | 34 | ```haskell 35 | e <- nextEvent vty 36 | ``` 37 | 38 | で何らかのイベントを待ち、イベントが来たら 39 | 40 | ```haskell 41 | shutdown vty 42 | ``` 43 | 44 | で`vty`を安全に終了して 45 | 46 | ```haskell 47 | print e 48 | ``` 49 | 50 | で最後に起こったイベントを表示する、と言った流れです。 51 | 52 | ## アプリを設計する 53 | Hello World を見て分かるようにVtyを使ったプログラムでは最初に`mkVty`で作ったVtyの値を色んな所で使いまわします。なのでアプリでは最初に作った`Vty`の値を`Reader`モナドに入れて引き回すようにするのがいいでしょう。またプログラムが予期せぬ処理で終わってしまうことも考えて`Except`モナドの中にも入れましょう。もちろん`Vty`をアップデートするのに`IO`モナドの中である必要もあります。扱いたい文脈が3つも出てきてしまったわけですがこんな時は慌てずにモナド交換子を使いましょう。以下のように型を作ります。 54 | 55 | ```haskell 56 | import Control.Monad.Except 57 | import Control.Monad.Reader 58 | import Control.Monad.IO.Class 59 | 60 | data AppException = AppEscape 61 | 62 | type App = ExceptT AppException (ReaderT Vty IO) 63 | 64 | runApp :: Vty -> App a -> IO (Either AppException a) 65 | runApp vty = (flip runReaderT vty) . runExceptT 66 | ``` 67 | 68 | `AppException`はアプリが吐くエラーの種類で、必要であれば追加していきます。`App`の値を作って`runApp`で実行するという寸法です。 69 | 70 | ## 画面を設計する 71 | それでは実際にRSSリーダーを作っていきましょう。画面は 72 | 73 | * 登録してるRSSを選択する(selectionView) 74 | * RSSを取ってくる(loadingView) 75 | * 記事を選択する(rssfeedView) 76 | * 記事を読む(previewView) 77 | 78 | の四つにしましょう。とりあえず型だけ実装してしまいます。 79 | 80 | ```haskell 81 | data RSS = RSS { _title :: String, _url :: String } deriving Show 82 | 83 | selectionView :: [RSS] -> Int -> App RSS 84 | selectionView _ _ = throwError AppEscape 85 | 86 | loadingView :: RSS -> App Document 87 | loadingView _ = throwError AppEscape 88 | 89 | data RSSFeedViewAction = RSSFeedViewBack | RSSFeedViewPreview String 90 | 91 | rssfeedView :: Document -> Int -> App RSSFeedViewAction 92 | rssfeedView _ _ = throwError AppEscape 93 | 94 | previewView :: String -> App () 95 | previewView _ = throwError AppEscape 96 | ``` 97 | 98 | データの流れを意識して画面遷移だけを先に実装してしまいます。 99 | 100 | ```haskell 101 | main :: IO () 102 | main = do 103 | vty <- standardIOConfig >>= mkVty 104 | rssList <- getRSSList 105 | runApp vty . forever $ do 106 | rss <- selectionView rssList 0 107 | doc <- loadingView rss 108 | fix $ \loop -> do 109 | act <- rssfeedView doc 0 110 | case act of 111 | RSSFeedViewBack -> return () 112 | RSSFeedViewPreview url -> previewView url >> loop 113 | shutdown vty 114 | ``` 115 | 116 | `main`関数はこれで完成です！注目すべきは`main`の中の`runApp`の部分です。モナドの計算だけを使って画面遷移を記述しています。 117 | 118 | ## 登録されてるRSSを取得する 119 | RSSの登録はローカルのYamlファイルに記述していくことにしましょう。 120 | 121 | ```yaml 122 | - 123 | title: flip map 124 | url : http://lotz84.github.io/feed.xml 125 | - 126 | title: Planet Haskell 127 | url : http://planet.haskell.org/rss20.xml 128 | - 129 | title: reddit - Haskell 130 | url : https://www.reddit.com/r/haskell/.rss 131 | ``` 132 | 133 | Yamlのアクセスには[yaml-light](https://hackage.haskell.org/package/yaml-light), [yaml-light-lens](https://hackage.haskell.org/package/yaml-light-lens)を使います 134 | 135 | ```haskell 136 | import Data.Yaml.YamlLight 137 | import Data.Yaml.YamlLight.Lens 138 | 139 | getRSSList :: IO [RSS] 140 | getRSSList = do 141 | yaml <- parseYamlFile "rss.yml" 142 | let y2r y = do 143 | title <- y ^? key "title" . _Yaml 144 | url <- y ^? key "url" . _Yaml 145 | return $ RSS title url 146 | return $ yaml ^.. each . folding y2r 147 | ``` 148 | 149 | `y2r`は`YamlLight`から独自に定義した`RSS`に変換する関数です。この関数は失敗するかもしれないのですが`folding`を使うことで失敗した値を排除しています 150 | 151 | ## RSSの選択画面 152 | selectionViewの中身を実装していきましょう 153 | 154 | ![](img/selectioinView.png) 155 | 156 | ```haskell 157 | selectionView :: [RSS] -> Int -> App RSS 158 | selectionView rssList selecting = do 159 | vty <- ask 160 | let header = string (defAttr `withStyle` underline) "閲覧するRSSを選択してください" 161 | tableStyle n = if n == selecting then defAttr `withStyle` reverseVideo else defAttr 162 | table = vertCat $ map (\(rss, n) -> string (tableStyle n) (_title rss)) $ zip rssList [0..] 163 | pic = picForImage $ header <-> table 164 | liftIO $ update vty pic 165 | e <- liftIO $ nextEvent vty 166 | case e of 167 | EvKey KEsc _ -> throwError AppEscape 168 | EvKey KEnter _ -> return $ rssList !! selecting 169 | EvKey (KChar 'j') _ -> selectionView rssList (min (length rssList - 1) (selecting + 1)) 170 | EvKey (KChar 'k') _ -> selectionView rssList (max 0 (selecting - 1)) 171 | _ -> selectionView rssList selecting 172 | ``` 173 | 174 | やっていることは単純で選択されている項目だけ色を反転しているだけです。`j`と`k`を押されると選択が上下に移動します。`Enter`が押されるとその時選択されている値が返却されます。 175 | 176 | ## ローディング画面 177 | RSSを取得してくる画面を実装していきましょう 178 | 179 | ![](img/loadingView.png) 180 | 181 | RSSが選択されたらその情報をWebまで取りに行き返ってきたXMLをパースしなければいけません。物によっては時間がかかるのでローディング画面を出してあげたほうが親切だと思います。しかしデータの処理とローディングのアニメーションは直列に書くことはできないので情報を取得してくるところは非同期で書くことにしましょう。XMLのパースには[xml-conduit](https://hackage.haskell.org/package/xml-conduit)を使います 182 | 183 | ```haskell 184 | import Control.Concurrent 185 | import Control.Concurrent.MVar 186 | import Network.HTTP.Conduit 187 | import Text.XML 188 | 189 | loadingView :: RSS -> App Document 190 | loadingView rss = do 191 | vty <- ask 192 | result <- liftIO $ newEmptyMVar 193 | liftIO . forkIO $ do 194 | body <- simpleHttp (_url rss) 195 | let doc = parseLBS_ def body 196 | putMVar result doc 197 | liftIO . ($ 0) . fix $ \loop n -> do 198 | let gauge = string defAttr $ "Downloading" ++ take n (repeat '.') 199 | pic = picForImage gauge 200 | update vty pic 201 | threadDelay 200000 202 | doc <- tryTakeMVar result 203 | case doc of 204 | Nothing -> loop (n+1) 205 | Just doc -> return doc 206 | ``` 207 | 208 | `result`に値が入るまで`.`の個数を増やしつつループしているだけですね 209 | 210 | ##記事の選択画面 211 | ![](img/rssfeedView.png) 212 | 213 | "RSSの選択画面"と処理はほとんど同じです。違うのはデータが入っているのが`Document`型の値なのでパースする必要があるところです。XMLのパースには[xml-lens](https://hackage.haskell.org/package/xml-lens)を使います 214 | 215 | ```haskell 216 | import Data.Text.Lens 217 | import Text.XML.Lens 218 | import qualified Text.XML.Lens as XML 219 | 220 | rssfeedView :: Document -> Int -> App RSSFeedViewAction 221 | rssfeedView doc selecting = do 222 | vty <- ask 223 | let title = maybe "no title" id $ doc ^? root ./ el "channel" ./ el "title" . XML.text . unpacked 224 | items = doc ^.. root ./ el "channel" ./ el "item" ./ el "title" . XML.text .unpacked 225 | header = string (defAttr `withStyle` underline) $ title 226 | tableStyle n = if n == selecting then defAttr `withStyle` reverseVideo else defAttr 227 | table = vertCat $ map (\(item, n) -> string (tableStyle n) item) $ zip items [0..] 228 | pic = picForImage $ header <-> table 229 | liftIO $ update vty pic 230 | e <- liftIO $ nextEvent vty 231 | case e of 232 | EvKey KEsc _ -> return RSSFeedViewBack 233 | EvKey KEnter _ -> do 234 | let url = (!! selecting) $ doc ^.. root ./ el "channel" ./ el "item" ./ el "link" . XML.text . unpacked 235 | return $ RSSFeedViewPreview url 236 | EvKey (KChar 'j') _ -> rssfeedView doc (min (length items - 1) (selecting + 1)) 237 | EvKey (KChar 'k') _ -> rssfeedView doc (max 0 (selecting - 1)) 238 | _ -> rssfeedView doc selecting 239 | ``` 240 | 241 | この実装はよく考えると毎フレームXMLをパースすることになるので少し効率が悪いですね！予め必要な情報だけ持ったデータ構造に変換してやればもう少し動作が早くなりそうです（今のままでも十分速いですが） 242 | 243 | ## 閲覧画面とまとめ 244 | 245 | ```haskell 246 | import System.Process 247 | 248 | previewView :: String -> App () 249 | previewView url = do 250 | liftIO $ createProcess $ shell $ "open " ++ url 251 | return () 252 | ``` 253 | 254 | 最後は閲覧画面です。が、ターミナル上でWebページを表示するのはかなり大変そうなので外部のアプリに委譲することにします。 255 | 256 | 以上が簡単な解説です。完成したコードは110行しかなくずいぶん簡潔に書くことができました。完成したコードは[ここ](https://github.com/lotz84/cli-rss-reader/blob/master/Main.hs)から見ることができます。質問＆コメントあれば[issue](https://github.com/lotz84/cli-rss-reader/issues)までお願いします。Starもお願いします！ 257 | --------------------------------------------------------------------------------