diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,12 +3,12 @@ This is a command line interface to the [eros library](https://github.com/pharpend/eros). -# Usage - v.0.4.0.0 +# Usage - v.0.5.0.0 -This is a usage guide for version 0.4.0.0. There will be more up-to-date usage +This is a usage guide for version 0.5.0.0. There will be more up-to-date usage guides as more versions come, hopefully. -To install, run `cabal install eros-client-0.4.0.0`. +To install, run `cabal install eros-client-0.5.0.0`. The only way to interact with the library, for the time being is through the client I built, `erosc`. It accepts input in Javascript Object Notation (JSON) @@ -35,12 +35,37 @@ "type": "string" } }, + "options": { + "type": "object", + "description": "Extraneous options for erosc.", + "required": false, + "properties": { + "pretty": { + "type": "boolean", + "description": "Whether to pretty-print the output. Defaults to `true'.", + "required": false + }, + "quiet": { + "type": "boolean", + "description": "Suppress output to stdout. Defauts to `false'.", + "required": false + }, + "output-files": { + "type": "array", + "description": "A list of output file paths. Will overwrite existing files", + "required": false, + "items": { + "type": "string" + } + } + } + } } } ``` -That is the up-to-date schema, as of version 0.4.0.0 . It is liable to -change. If the version you downloaded is greater than 0.4.0.0, make sure to +That is the up-to-date schema, as of version 0.5.0.0 . It is liable to +change. If the version you downloaded is greater than 0.5.0.0, make sure to check the schema (it is distributed with the package) to make sure it is up to date. The schema is located in `res/schemata/erosc-input.json`. @@ -106,17 +131,6 @@ If you have any ideas, don't hesitate to contact me. ## Planned features - -### `erosc` ⟶ `eros-server` - -As it stands, `erosc` is tedious and a bit difficult to use. I plan on rewriting -`erosc` to act as an HTTP[s] server, using Happstack, using acid-state as a RAM -cloud. This will be the fastest and easiest to maintain solution. - -I will still include an offline client, but it won't be the focus of -development. - -### More options I need to add more filtering options, such as phraselist-specific thresholds, custom phraselists, and, well, just more stuff. diff --git a/eros-client.cabal b/eros-client.cabal --- a/eros-client.cabal +++ b/eros-client.cabal @@ -1,13 +1,10 @@ name: eros-client -version: 0.4.0.0 +version: 0.5.0.0 synopsis: A command-line interface to the eros library. description: This is a command-line interface to the . - It is terrible at the moment, and will be deprecated before version 0.5.0.0, - so it isn't a huge priority. - license: BSD3 license-file: LICENSE author: Peter Harpending @@ -20,7 +17,7 @@ cabal-version: >=1.10 extra-source-files: README.md - res/erosc-dummy-inputs/*.json + res/dummy-inputs/*.json res/schemata/*.json executable erosc @@ -30,11 +27,13 @@ , base >=4.7 && <4.8 , bytestring , containers - , eros ==0.4.0.0 + , eros ==0.5.0.0 , text hs-source-dirs: src/ - main-is: Main.lhs - other-modules: Erosc.Processor + main-is: Main.hs + other-modules: + Text.Eros.Client + , Text.Eros.Client.JSON default-language: Haskell2010 ghc-options: -Wall diff --git a/res/dummy-inputs/input0.json b/res/dummy-inputs/input0.json new file mode 100644 --- /dev/null +++ b/res/dummy-inputs/input0.json @@ -0,0 +1,7 @@ +{ + "text": "Fuck you, you fucking fuck! Fucking bitch tits milf sex sluts!", + "eros-lists": [ + "gambling", + "pornography" + ] +} diff --git a/res/erosc-dummy-inputs/input0.json b/res/erosc-dummy-inputs/input0.json deleted file mode 100644 --- a/res/erosc-dummy-inputs/input0.json +++ /dev/null @@ -1,7 +0,0 @@ -{ - "text": "Fuck you, you fucking fuck! Fucking bitch tits milf sex sluts!", - "eros-lists": [ - "gambling", - "pornography" - ] -} diff --git a/res/schemata/erosc-input.json b/res/schemata/erosc-input.json --- a/res/schemata/erosc-input.json +++ b/res/schemata/erosc-input.json @@ -16,5 +16,30 @@ "type": "string" } }, + "options": { + "type": "object", + "description": "Extraneous options for erosc.", + "required": false, + "properties": { + "pretty": { + "type": "boolean", + "description": "Whether to pretty-print the output. Defaults to `true'.", + "required": false + }, + "quiet": { + "type": "boolean", + "description": "Suppress output to stdout. Defauts to `false'.", + "required": false + }, + "output-files": { + "type": "array", + "description": "A list of output file paths. Will overwrite existing files. Empty by default.", + "required": false, + "items": { + "type": "string" + } + } + } + } } } diff --git a/src/Erosc/Processor.hs b/src/Erosc/Processor.hs deleted file mode 100644 --- a/src/Erosc/Processor.hs +++ /dev/null @@ -1,94 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} - --- |This is the module which actually processes the marshals the --- data. As far as erosc goes, this is the meat & potatoes. --- --- Basically, Main.hs was getting to be too long, so I created this --- file. --- --- Copyright (c) 2014, Peter Harpending . All --- Rights Reserved. --- --- I'm supposed to say "All Rights Reserved," but this is actuallly --- BSD-licensed. So, really you can do whatever you want with --- this. Have fun! - -module Erosc.Processor where - --- One of these days, I'm going to figure out how to cut down on these --- imports. -import Control.Applicative -import Control.Monad (mzero) -import Data.Aeson hiding (encode) -import Data.Aeson.Encode.Pretty -import qualified Data.ByteString.Lazy as LzByte -import qualified Data.Text.Lazy as LzText -import Text.Eros - --- |Okay, here's a function that actually does something. It takes an --- 'Input' type, and process it. -processInput :: Input -> IO Output -processInput (Input txt lists) = do - outLists <- mapM listPair lists - return $ Output outLists - where - listPair :: ErosList -> IO (ErosList, Score) - listPair ls = do - pmap <- loadPhraseMap ls - let scr = messageScore txt pmap - return (ls, scr) - --- |This will print JSON in a pretty matter, using 2-space indents. I --- have no idea why 4-space indents are the default. -encode :: ToJSON a => a -> LzByte.ByteString -encode = encodePretty' defConfig { confIndent = 2 - } - --- |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 Input = Input { 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 Input where - parseJSON (Object v) = Input - <$> 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 Output = Output { elScore :: [(ErosList, Score)] } - --- |Pretty self-explanatory -instance ToJSON ErosList where - toJSON el = case erosNameByList el of - Just nom -> toJSON nom - Nothing -> "There's probably a bug in the JSON parsing \ - \library Eros uses. You should file a bug \ - \report at https://github.com/pharpend/eros/issues." - --- |Pretty self-explanatory -instance ToJSON (ErosList, Score) where - toJSON (el, sc) = object [ "eros-list" .= el - , "score" .= sc - ] - --- |Pretty self-explanatory -instance ToJSON Output where - toJSON (Output elm) = toJSON elm - --- |It's convenient to think of Scores as Scores, although, they are --- truly ints. -type Score = Int diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,38 @@ +module Main where + +import Data.Aeson +import qualified Data.ByteString.Lazy as B +import qualified Text.Eros.Client as Erosc +import qualified Text.Eros.Client.JSON as ErosJson +import System.Exit +import qualified System.IO as Io + + +-- |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 =<< B.hGetContents Io.stdin + +-- |attempt to 'eitherDecode' the user input +runBtStr :: B.ByteString -> IO () +runBtStr inputBt = do + let eitherJson = (eitherDecode inputBt) :: Either String Erosc.ClientInput + case eitherJson of + Left msg -> B.hPutStr Io.stderr (encode msg) >> exitFailure + Right ecInput -> runInput ecInput + +-- |This takes the 'Erosc.ClientInput' thing and processes it. +runInput :: Erosc.ClientInput -> IO () +runInput ipt = do + result <- Erosc.processClientInput ipt + let conf = Erosc.configuration ipt + outfpaths = Erosc.outputFiles conf + jsonText = ErosJson.encode result conf + writeOutputs = mapM_ (\fpath -> B.writeFile fpath jsonText) outfpaths + if (Erosc.quiet conf) + then B.hPutStr Io.stdout jsonText >> writeOutputs >> exitSuccess + else writeOutputs >> exitSuccess + diff --git a/src/Main.lhs b/src/Main.lhs deleted file mode 100644 --- a/src/Main.lhs +++ /dev/null @@ -1,78 +0,0 @@ -|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 - diff --git a/src/Text/Eros/Client.hs b/src/Text/Eros/Client.hs new file mode 100644 --- /dev/null +++ b/src/Text/Eros/Client.hs @@ -0,0 +1,45 @@ +module Text.Eros.Client where + +import Data.Text.Lazy (Text) +import Text.Eros + +-- |Okay, here's a function that actually does something. It takes an +-- 'ClientInput' type, and process it. +processClientInput :: ClientInput -> IO ClientOutput +processClientInput (ClientInput txt lists _) = do + outLists <- mapM listPair lists + return $ ClientOutput outLists + where + listPair :: ErosList -> IO (ErosList, Score) + listPair ls = do + pmap <- loadPhraseMap ls + let scr = messageScore txt pmap + return (ls, scr) + +-- |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 ClientInput = ClientInput { text :: Text + , erosLists :: [ErosList] + , configuration :: ClientConf + } + +-- |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 ClientOutput = ClientOutput { elScore :: [(ErosList, Score)] + } + +-- |Configuration for the client +data ClientConf = ClientConf { pretty :: Bool + , quiet :: Bool + , outputFiles :: [FilePath] + } + +-- |No configuration. +nullConf :: ClientConf +nullConf = ClientConf True False [] + +-- |It's convenient to think of Scores as Scores, although, they are +-- truly ints. +type Score = Int diff --git a/src/Text/Eros/Client/JSON.hs b/src/Text/Eros/Client/JSON.hs new file mode 100644 --- /dev/null +++ b/src/Text/Eros/Client/JSON.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module Text.Eros.Client.JSON where + +import Control.Applicative +import Control.Monad (mzero) +import Data.Aeson hiding (encode) +import qualified Data.Aeson as Aeson +import Data.Aeson.Encode.Pretty +import qualified Data.ByteString.Lazy as B +import qualified Data.Text.Lazy as L +import Text.Eros +import Text.Eros.Client + +-- |This will print JSON in a pretty matter, using 2-space indents. I +-- have no idea why 4-space indents are the default. +encode :: ToJSON a => a -> ClientConf -> B.ByteString +encode val conf = case (pretty conf) of + True -> encodePretty' defConfig { confIndent = 2 } val + _ -> Aeson.encode val + +-- |THIS is pretty self-explanatory +instance FromJSON ErosList where + parseJSON (String s) = case erosListByName (L.fromStrict s) of + Just list -> return list + Nothing -> mzero + parseJSON _ = mzero + +instance FromJSON ClientConf where + parseJSON (Object v) = ClientConf + <$> v .:? "pretty" .!= False + <*> v .:? "quiet" .!= False + <*> v .:? "output-files" .!= [] + parseJSON _ = mzero + + +-- |This is pretty self-explanatory +instance FromJSON ClientInput where + parseJSON (Object v) = ClientInput + <$> v .: "text" + <*> v .: "eros-lists" + <*> v .:? "options" .!= nullConf + parseJSON _ = mzero + +-- |Pretty self-explanatory +instance ToJSON ErosList where + toJSON el = case erosNameByList el of + Just nom -> toJSON nom + Nothing -> "There's probably a bug in the JSON parsing \ + \library Eros uses. You should file a bug \ + \report at https://github.com/pharpend/eros/issues." + +-- |Pretty self-explanatory +instance ToJSON (ErosList, Score) where + toJSON (el, sc) = object [ "eros-list" .= el + , "score" .= sc + ] + +-- |Pretty self-explanatory +instance ToJSON ClientOutput where + toJSON (ClientOutput elm) = toJSON elm