Commit 103e3fb1793355da3ec3e0a3be4be9d816060959 - bytor

+5

-0

.gitignore less more

	1	*~
	2	dist
	3	dist-newstyle
	4	cabal.sandbox.config
	5	.cabal-sandbox

+12

-0

LICENSE less more

	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.

+6

-0

bytor/Main.hs less more

	1	module Main where
	2
	3	import qualified Bytor
	4
	5	main :: IO ()
	6	main = Bytor.main

+49

-0

bytor.cabal less more

	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

+15

-0

src/Bytor/Config.hs less more

	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

+8

-0

src/Bytor/Draw.hs less more

	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)]

+24

-0

src/Bytor/Event.hs less more

	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

+32

-0

src/Bytor/Main.hs less more

	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 ()

+103

-0

src/Bytor/Parse.hs less more

	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)

+67

-0

src/Bytor/Types.hs less more

	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)

+3

-0

src/Bytor.hs less more

	1	module Bytor (module Bytor.Main) where
	2
	3	import Bytor.Main