gdritter repos bytor / master
Some stumbling efforts towards a program Getty Ritter 7 years ago
11 changed file(s) with 324 addition(s) and 0 deletion(s). Collapse all Expand all
1 *~
2 dist
3 dist-newstyle
4 cabal.sandbox.config
5 .cabal-sandbox
1 Copyright (c) 2016, Getty Ritter
2 All rights reserved.
3
4 Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
5
6 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
7
8 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
9
10 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
11
12 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1 module Main where
2
3 import qualified Bytor
4
5 main :: IO ()
6 main = Bytor.main
1 name: bytor
2 version: 0.1.0.0
3 -- synopsis:
4 -- description:
5 license: BSD3
6 license-file: LICENSE
7 author: Getty Ritter <gdritter@galois.com>
8 maintainer: Getty Ritter <gdritter@galois.com>
9 copyright: ©2016 Getty Ritter
10 -- category:
11 build-type: Simple
12 cabal-version: >= 1.14
13
14 library
15 hs-source-dirs: src
16 exposed-modules: Bytor
17 , Bytor.Main
18 , Bytor.Types
19 , Bytor.Event
20 , Bytor.Draw
21 default-extensions: OverloadedStrings,
22 ScopedTypeVariables
23 ghc-options: -Wall
24 build-depends: base >=4.7 && <4.10
25 , brick
26 , vty
27 , microlens-platform
28 , text
29 , bytestring
30 , containers
31 , data-default
32 , unordered-containers
33 , hsemail
34 , config-ini
35 , attoparsec
36 , directory
37 , time
38 , courriel
39 default-language: Haskell2010
40
41 executable bytor
42 hs-source-dirs: bytor
43 main-is: Main.hs
44 default-extensions: OverloadedStrings,
45 ScopedTypeVariables
46 ghc-options: -Wall -threaded
47 build-depends: base >=4.7 && <4.10
48 , bytor
49 default-language: Haskell2010
1 module Config where
2
3 import Data.Ini.Config
4 import qualified Data.Text as T
5
6 data Config = Config
7 { localConfig :: LocalConfig
8 } deriving (Eq, Show)
9
10 data LocalConfig
11 {
12 } deriving (Eq, Show)
13
14 parseConfig :: IniParser Config
15 parseConfig = section "local" $ do
1 module Bytor.Draw where
2
3 import qualified Brick as B
4
5 import Bytor.Types
6
7 drawMain :: State -> [B.Widget Cursor]
8 drawMain st = [B.txt (_stMessage st)]
1 module Bytor.Event where
2
3 import qualified Brick as B
4 import qualified Data.Map.Strict as Map
5 import qualified Data.Text as T
6 import qualified Graphics.Vty as Vty
7 import Lens.Micro.Platform
8
9 import Bytor.Types
10
11 handleEvent :: State -> B.BrickEvent Cursor Event -> B.EventM Cursor (B.Next State)
12 handleEvent st (B.VtyEvent (Vty.EvKey (Vty.KChar c) mods)) = do
13 let kc = KeyCode c $
14 case mods of
15 [Vty.MMeta] -> Meta
16 [Vty.MCtrl] -> Ctrl
17 _ -> None
18 case Map.lookup kc (st^.stConfiguration.confKeymap) of
19 Just action -> runAction st action
20 Nothing -> B.continue (st & stMessage .~ T.pack (show (mods, c)))
21 handleEvent st _ = B.continue st
22
23 runAction :: State -> Action -> B.EventM Cursor (B.Next State)
24 runAction st Quit = B.halt st
1 module Bytor.Main where
2
3 import qualified Brick as B
4 import qualified Control.Concurrent.Chan as Chan
5 import qualified Data.Default as Def
6 import Data.Monoid (mempty)
7 import qualified Graphics.Vty as Vty
8 import qualified Network.Courriel.Parse as Courriel
9
10 import Data.Attoparsec.ByteString (IResult(..))
11
12 import Bytor.Draw
13 import Bytor.Event
14 import Bytor.Types
15
16 app :: B.App State Event Cursor
17 app = B.App
18 { B.appDraw = \ st -> drawMain st -- [B.txt (_stMessage st)]
19 , B.appChooseCursor = B.showFirstCursor
20 , B.appHandleEvent = handleEvent
21 , B.appStartEvent = return
22 , B.appAttrMap = \ _ -> B.attrMap mempty []
23 }
24
25
26 main :: IO ()
27 main = do
28 rs <- Courriel.readBox "/home/gdritter/.mail/INBOX/cur"
29 mapM_ print [ Courriel.getSubject em | (_, Right em) <- rs ]
30 -- eventChan <- Chan.newChan
31 -- _ <- B.customMain (Vty.mkVty Def.def) (Just eventChan) app emptyState
32 return ()
1 module Bytor.Parse where
2
3 import Control.Applicative
4 import Control.Monad (void)
5 import Data.ByteString (ByteString)
6 import qualified Data.ByteString as B
7 import Data.Attoparsec.ByteString (Parser)
8 import qualified Data.Attoparsec.ByteString as Atto
9 import Data.Sequence (Seq)
10 import Data.Time.Clock (UTCTime)
11 import Data.Word (Word8)
12 import System.Directory (listDirectory)
13
14 import Bytor.Types
15
16 pPhrase :: Parser ByteString
17 pPhrase = undefined
18
19 pMailbox :: Parser Mailbox
20 pMailbox = nameAddr <|> (Mailbox Nothing <$> pAddrSpec)
21 where nameAddr =
22 Mailbox <$> (Just <$> pPhrase)
23 <*> (Atto.word8 60 *> pAddrSpec <* Atto.word8 62)
24
25 pDotAtom :: Parser ByteString
26 pDotAtom = Atto.takeWhile (\ c -> atext c || c == 46)
27
28 pAddrSpec :: Parser Address
29 pAddrSpec = Address <$> pLocalPart <*> (Atto.word8 64 *> pDomain)
30 where pLocalPart = pDotAtom
31 pDomain = pDotAtom
32
33 atext :: Word8 -> Bool
34 atext c = c < 128 && c /= 40 && c /= 41
35 && c /= 58 && c /= 59
36 && c /= 60 && c /= 62
37 && c /= 64 && c /= 91
38 && c /= 92 && c /= 93
39 && c /= 34
40
41 newtype MessageId = MessageId { _fromMessageId :: ByteString }
42 deriving (Eq, Show, Read)
43
44 getSubject :: RawEmail -> ByteString
45 getSubject RawEmail { reHeaders = hs } =
46 head [ subj | HeaderSubject subj <- hs ]
47
48 data RawEmail = RawEmail
49 { reHeaders :: [Header]
50 , reBodies :: [ByteString]
51 } deriving (Eq, Show)
52
53 readBox :: FilePath -> IO [(FilePath, Either String RawEmail)]
54 readBox fp = do
55 paths <- listDirectory fp
56 let files = [ fp ++ "/" ++ p | p <- paths ]
57 raws <- sequence [ (,) f `fmap` B.readFile f | f <- files ]
58 return [ (f, Atto.parseOnly pEmail r) | (f, r) <- raws ]
59
60 pEmail :: Parser RawEmail
61 pEmail = do
62 headers <- Atto.manyTill pHeader pCrlf
63 body <- pBody
64 return (RawEmail headers [body])
65
66 pHeader :: Parser Header
67 pHeader = do
68 name <- Atto.takeWhile1 (\ c -> c /= 58 && not (isSpace c))
69 void $ Atto.word8 58
70 case name of
71 "OrigDate" -> HeaderOther "arglbargl" <$> foldingHeader
72 "Subject" -> HeaderSubject <$> foldingHeader
73 "Comments" -> HeaderComments <$> foldingHeader
74 "Keywords" -> HeaderKeywords <$> foldingHeader
75 _ -> HeaderOther name <$> foldingHeader
76
77 pDateTime :: Parser UTCTime
78 pDateTime = undefined
79
80 foldingHeader :: Parser ByteString
81 foldingHeader = do
82 skipSpace
83 line <- Atto.takeTill (== 10)
84 void $ Atto.word8 10
85 next <- Atto.peekWord8'
86 if isSpace next
87 then skipSpace *> (B.append line <$> foldingHeader)
88 else return line
89
90 skipSpace :: Parser ()
91 skipSpace = void $ Atto.takeWhile isSpace
92
93 isSpace :: (Num a, Eq a) => a -> Bool
94 isSpace c = c == 32 || c == 9
95
96 pCrlf :: Parser ()
97 pCrlf = void (Atto.word8 10)
98
99 pBody :: Parser ByteString
100 pBody = B.concat <$> Atto.many' (pText <* pCrlf)
101
102 pText :: Parser ByteString
103 pText = Atto.takeWhile (\ c -> c /= 10 && c /= 13)
1 {-# LANGUAGE TemplateHaskell #-}
2
3 module Bytor.Types where
4
5 import Data.Map.Strict (Map)
6 import qualified Data.Map.Strict as Map
7 import Data.Sequence (Seq)
8 import qualified Data.Sequence as Seq
9 import Data.ByteString (ByteString)
10 import Data.Text (Text)
11 import Data.Time.Clock (UTCTime)
12 import Lens.Micro.Platform (makeLenses)
13 import Network.Courriel.Types
14
15 data Modifier
16 = None
17 | Ctrl
18 | Meta
19 deriving (Eq, Show, Read, Ord)
20
21 data KeyCode = KeyCode
22 { _kcChar :: Char
23 , _kcMod :: Modifier
24 } deriving (Eq, Show, Read, Ord)
25
26 makeLenses ''KeyCode
27
28 data Action
29 = Quit
30 deriving (Eq, Show, Read)
31
32 data Config = Config
33 { _confKeymap :: Map KeyCode Action
34 } deriving (Eq, Show, Read)
35
36 defaultKeymap :: Map KeyCode Action
37 defaultKeymap = Map.fromList
38 [ (KeyCode 'q' Ctrl, Quit)
39 ]
40
41 makeLenses ''Config
42
43 newtype Mbox = Mbox { _mbEmails :: Seq Email }
44 deriving (Eq, Show, Read)
45
46 makeLenses ''Mailbox
47
48 data State = State
49 { _stConfiguration :: Config
50 , _stMailboxes :: Mbox
51 , _stMessage :: Text
52 } deriving (Eq, Show, Read)
53
54 emptyState :: State
55 emptyState = State
56 { _stConfiguration = Config defaultKeymap
57 , _stMailboxes = Mbox Seq.empty
58 , _stMessage = "Hello"
59 }
60
61 makeLenses ''State
62
63 data Cursor = Cursor
64 deriving (Eq, Show, Ord)
65
66 data Event = Event
67 deriving (Eq, Show, Ord)
1 module Bytor (module Bytor.Main) where
2
3 import Bytor.Main