diff --git a/eros.cabal b/eros.cabal --- a/eros.cabal +++ b/eros.cabal @@ -1,5 +1,5 @@ name: eros -version: 0.2.0.1 +version: 0.2.1.0 synopsis: A text censorship library. description: A Haskell library for censoring text, using @@ -97,8 +97,9 @@ , eros , text hs-source-dirs: src/erosc/ - main-is: Main.hs + main-is: Main.lhs default-language: Haskell2010 + ghc-options: -Wall source-repository head type: git diff --git a/src/erosc/Main.hs b/src/erosc/Main.hs deleted file mode 100644 --- a/src/erosc/Main.hs +++ /dev/null @@ -1,98 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} - --- |This is the main module for the eros client. This is not the meat & --- potatoes of the program, but this is the bread & butter. --- -module Main where - -import Control.Applicative -import Control.Monad (mzero) -import Data.Aeson -import Data.Aeson.Encode.Pretty -import qualified Data.ByteString.Lazy as LzByte -import qualified Data.Text.Lazy as LzText -import qualified Data.Text.Lazy.IO as LazyIO -import qualified Data.Map as M -import qualified System.IO as StdIO -import Text.Eros.Message -import Text.Eros.Phrase (mkMap) -import Text.Eros.Phraselist - --- |It's convenient to think of Scores as Scores, although, they are truly ints. -type Score = Int - --- |We represent the input data in its own data type. This is needed --- for JSON parsing, but it will also be useful down the road, when I --- allow input that isn't JSON. -data EroscInput = EroscInput { text :: LzText.Text - , erosLists :: [ErosList] - } - --- |This is pretty self-explanatory -instance FromJSON ErosList where - parseJSON (String s) = case erosListByName (LzText.fromStrict s) of - Just list -> return list - Nothing -> mzero - parseJSON _ = mzero - --- |This is pretty self-explanatory -instance FromJSON EroscInput where - parseJSON (Object v) = EroscInput - <$> v .: "text" - <*> v .: "eros-lists" - parseJSON _ = mzero - --- |This is the output data type. I will make an instance of ToJSON --- for this data type. Again, at the start, only JSON input and output --- is existent. -data EroscOutput = EroscOutput { elScore :: [(ErosList, Score)] } - --- |Pretty self-explanatory -instance ToJSON ErosList where - toJSON el = case erosNameByList el of - Just nom -> toJSON nom - Nothing -> "Well, something got fucked up." - --- |Pretty self-explanatory -instance ToJSON (ErosList, Score) where - toJSON (el, sc) = object [ "eros-list" .= el - , "score" .= sc - ] - --- |Pretty self-explanatory -instance ToJSON EroscOutput where - toJSON (EroscOutput elm) = toJSON elm - -erosEncode :: ToJSON a => a -> LzByte.ByteString -erosEncode = encodePretty' defConfig { confIndent = 2 - } - -main :: IO () -main = do - -- take the json from stdin, try to decode it - inputBt <- LzByte.hGetContents StdIO.stdin - let eitherJson = (eitherDecode inputBt) :: Either String EroscInput - -- if by chance, it isn't decoded, the program shall flip its shit - case eitherJson of - Left msg -> fail msg - Right ecInput -> runInput ecInput - -runInput :: EroscInput -> IO () -runInput ipt = do - result <- processInput ipt - let jsonText = erosEncode result - LzByte.hPutStr StdIO.stdout jsonText - -processInput :: EroscInput -> IO EroscOutput -processInput (EroscInput txt lists) = do - outLists <- mapM listPair lists - return $ EroscOutput outLists - where - listPair :: ErosList -> IO (ErosList, Score) - listPair ls = do - pmap <- loadPhraseMap ls - let scr = messageScore txt pmap - return (ls, scr) - - diff --git a/src/erosc/Main.lhs b/src/erosc/Main.lhs new file mode 100644 --- /dev/null +++ b/src/erosc/Main.lhs @@ -0,0 +1,78 @@ +|This is the main module for the eros client. This is not the meat & +potatoes of the program, but this is the bread & butter. + +> module Main where + + +So, here are our imports. I would like to only have IO inputs, however +the import of 'Data.Aeson' is needed in order to keep the +'Erosc.Processor' module pure. + +Essentially, I was faced with either making this module be tainted by +purity, or have the other module be pure. + +My qualified imports are a bit obnoxious. Even though they aren't +needed, I find that using qualified names makes the code a bit less +confusing. That is, @LzByte.hGetContents@ is a lot more informative +than just @hGetContents@. + +> import Data.Aeson as Aeson +> import qualified Data.ByteString.Lazy as LzByte +> import Erosc.Processor as Erosc +> import qualified System.IO as StdIO + + +|Eventually, I'll need this data type when I use command line +arguments. For the moment, it's just a dummy type. So, enjoy it. + +> data EroscOpts = EroscOpts + +|So, this is the main function. Whoop de doo. It sends the contents +of 'StdIO.stdin' to runBtStr. + +Eventually, I'll add in command line argument parsing, and then we'll +have a use for the 'EroscOptions' type. + +> main :: IO () +> main = runBtStr =<< LzByte.hGetContents StdIO.stdin + +|This function takes the input (presumably 'StdIO.stdin'), and tries +to decode it. + +If it successfully decodes the input into the 'Erosc.Input' type, +it sends the newfound decoded input to 'runInput', which sends it to +the processor. + +If it can't, the program will throw a tantrum and shit itself. + +> runBtStr :: LzByte.ByteString -> IO () +> runBtStr inputBt = do +> let eitherJson = (Aeson.eitherDecode inputBt) :: Either String Erosc.Input +> case eitherJson of +> Left msg -> fail msg +> Right ecInput -> runInput ecInput + + +There is an astonishing quantity of bureaucracy in this program. You +have to go through like 5 functions before you get to a function that +actually does something useful. + +|Okay, so, we're getting closer to the part of the program that +actually does stuff (or further away, depending on the location from +whence you come). + +'runInput' takes the 'Erosc.Input' object (I do hate that word), and +sends it to some function in 'Erosc' that actually mutates the +data. Well, it doesn't mutate it, obviously, because this is Haskell, +but you get the idea. + +@result@ needs to be '(<-)'d because 'Erosc.processInput' needs to +read the phraselist JSON file. This is a result of poor library design +on my part. I will fix this in a future release. + +> runInput :: Erosc.Input -> IO () +> runInput ipt = do +> result <- Erosc.processInput ipt +> let jsonText = Erosc.encode result +> LzByte.hPutStr StdIO.stdout jsonText +