handwriting (empty) → 0.1.0.0
raw patch · 8 files changed
+472/−0 lines, 8 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, containers, directory, filepath, handwriting, lens, lens-aeson, random, split, text, transformers, wreq
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- app/Main.hs +54/−0
- handwriting.cabal +57/−0
- src/Network/Handwriting.hs +98/−0
- src/Network/Internal/Model.hs +124/−0
- src/Network/Internal/Utilities.hs +105/−0
- test/Spec.hs +2/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Ismail Mustafa (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Ismail Mustafa nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++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+OWNER 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Network.Handwriting++import System.Environment (getEnv)++import Data.ByteString.Lazy (writeFile, ByteString)+import Prelude hiding (writeFile) +import System.Directory (getCurrentDirectory)+import System.FilePath ((</>))+import System.Random (newStdGen, randomR)+import Data.Text (unpack)++main :: IO ()+main = do+ -- Credentials+ key <- getEnv "KEY"+ secret <- getEnv "SECRET"+ let creds = Credentials key secret++ -- Get all handwritings+ handwritings <- getHandwritings creds++ -- Generate random number in range of handwritings+ g <- newStdGen+ let rand = randomR (0, length handwritings - 1) g++ -- Select random handwriting font+ let id = unpack $ handwritingId $ handwritings !! fst rand+ handwriting <- getHandwriting creds id+ print handwriting++ -- Generate image+ let params = defaultImageParams {format = PNG, + hId = Just "31SF81NG00ES",+ size = Just 30,+ color = Just (242,38,19),+ lineSpacing = Just 2,+ lineSpacingVariance = Just 0.2,+ wordSpacingVariance = Just 0.4,+ randomSeed = Randomize}+ imageByteString <- renderImage creds params "Hello World!"++ -- Write image to current directory+ writeHandwritingFile imageByteString "image.png"++writeHandwritingFile :: ByteString -> String -> IO ()+writeHandwritingFile image name = do+ dir <- getCurrentDirectory+ let imageDir = dir </> name+ writeFile imageDir image++
+ handwriting.cabal view
@@ -0,0 +1,57 @@+name: handwriting+version: 0.1.0.0+synopsis: API Client for the handwriting.io API.+description: Please see README.md+homepage: http://github.com/ismailmustafa/handwriting-haskell#readme+license: BSD3+license-file: LICENSE+author: Ismail Mustafa+maintainer: ismailmustafa@rocketmail.com+copyright: 2015 Ismail Mustafa+category: Network+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Network.Handwriting+ , Network.Internal.Model+ , Network.Internal.Utilities+ build-depends: base >= 4.7 && < 5+ , wreq+ , lens-aeson+ , lens+ , bytestring+ , containers+ , aeson+ , text+ , split+ , transformers+ default-language: Haskell2010++executable handwriting-exe+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , handwriting+ , text+ , directory+ , bytestring+ , filepath+ , random+ default-language: Haskell2010++test-suite handwriting-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , handwriting+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/ismailmustafa/handwriting-haskell
+ src/Network/Handwriting.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE OverloadedStrings #-}++-------------------------------------------------------------------------------+-- |+-- Module : Network.Handwriting+-- Copyright : (C) 2016 Ismail Mustafa+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ismail Mustafa <ismailmustafa@rocketmail.com+-- Stability : provisional+-- Portability : OverloadedStrings+--+-- API Client for the handwriting.io API.+--+-------------------------------------------------------------------------------++module Network.Handwriting+ ( getHandwritings,+ getHandwriting,+ Credentials(..),+ Handwriting(..),+ ImageParams(..),+ Format(..),+ PDFUnits(..),+ RandomSeed(..),+ Color,+ defaultImageParams,+ renderImage+ ) where++import Control.Lens ((&), (?~), (^.), toListOf)+import Data.Aeson.Lens (_Array)+import Data.ByteString.Char8 (pack)+import qualified Data.ByteString.Lazy.Char8 as BSL+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import Data.List (intercalate, minimum)+import Data.List.Split (splitOn)+import Network.Wreq+import Numeric (showHex, showFFloat)++import Network.Internal.Model+import Network.Internal.Utilities++baseUrl :: String+baseUrl = "https://api.handwriting.io/"++opts :: Credentials -> Options+opts c = defaults & auth ?~ basicAuth (pack $ keyToken c) (pack $ secretToken c)++-- | Get a single handwriting by id.+--+-- > import Network.Handwriting+-- > creds :: Credentials+-- > creds = Credentials "key" "secret"+-- > +-- > main :: IO ()+-- > main = do+-- > handwritings <- getHandwritings creds "31SF81NG00ES"+--+getHandwriting :: Credentials -> String -> IO Handwriting+getHandwriting c hId = do+ response <- getWith (opts c) $ baseUrl <> "handwritings/" <> hId+ jsonResponse <- asValue response+ return $ jsonToHandwriting $ jsonResponse ^. responseBody++-- | Get a list of all Handwritings.+--+-- > import Network.Handwriting+-- > creds :: Credentials+-- > creds = Credentials "key" "secret"+-- > +-- > main :: IO ()+-- > main = do+-- > handwritings <- getHandwritings creds+--+getHandwritings :: Credentials -> IO [Handwriting]+getHandwritings c = do+ response <- getWith (opts c) $ baseUrl <> "handwritings"+ jsonResponse <- asValue response+ return $ jsonToHandwriting <$> toListOf (responseBody . _Array . traverse) jsonResponse++-- | Get a handwriting image as either a PDF or PNG.+--+-- > import Network.Handwriting+-- > creds :: Credentials+-- > creds = Credentials "key" "secret"+-- > +-- > main :: IO ()+-- > main = do+-- > let params = defaultImageParams {format = PDF}+-- > imageByteString <- renderImage creds params "Hello World!"+--+renderImage :: Credentials -> ImageParams -> String -> IO BSL.ByteString+renderImage c ip s = do+ let endpointString = processImageParams ip s+ let endpoint = mconcat [baseUrl, "render/", processImageParams ip s]+ response <- getWith (opts c) endpoint+ return $ response ^. responseBody
+ src/Network/Internal/Model.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}++-------------------------------------------------------------------------------+-- |+-- Module : Network.Internal.Model+-- Copyright : (C) 2016 Ismail Mustafa+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ismail Mustafa <ismailmustafa@rocketmail.com+-- Stability : provisional+-- Portability : OverloadedStrings+--+-- Model definitions for the API wrapper.+--+-------------------------------------------------------------------------------++module Network.Internal.Model+ ( Credentials(..),+ Handwriting(..),+ ImageParams(..),+ Color(..),+ Format(..),+ PDFUnits(..),+ RandomSeed(..),+ defaultImageParams+ ) where++import Data.Aeson (FromJSON)+import Data.Monoid ((<>), mconcat)+import Data.Text+import Data.Word (Word8)+import GHC.Generics++{-| Credentials that take and key and secret token.+-}+data Credentials = + Credentials { keyToken :: String+ , secretToken :: String+ } deriving Show++{-| Handwriting data type that contains all the information+ about a specific handwriting style.+-}+data Handwriting = Handwriting { + handwritingId :: Text + , title :: Text + , dateCreated :: Text + , dateModified :: Text + , ratingNeatness :: Double+ , ratingCursivity :: Double+ , ratingEmbellishment :: Double+ , ratingCharacterWidth :: Double+ } deriving (Generic)++{-| Pretty print the handwriting data type.+-}+instance Show Handwriting where+ show (Handwriting a b c d e f g h) = "{"+ <> mconcat [" Handwriting Id: ", show a, "\n"] + <> mconcat [" Title: ", show b, "\n"]+ <> mconcat [" Date Created: ", show c, "\n"]+ <> mconcat [" Date Modified: ", show d, "\n"]+ <> mconcat [" Rating Neatness: ", show e, "\n"]+ <> mconcat [" Rating Cursivity: ", show f, "\n"]+ <> mconcat [" Rating Embellishment: ", show g, "\n"]+ <> mconcat ["Rating CharacterWidth: ", show h, "\n"]+ <> "}"++{-| Handwriting JSON instance.+-}+instance FromJSON Handwriting++{-| Color type representing (R,G,B).+-}+type Color = (Word8, Word8, Word8)++{-| Format determines Rendered image format in either + png or pdf.+-}+data Format = PNG | PDF deriving (Show)++{-| RandomSeed is used to specify is every rendered+ image called with the same parameters should render+ differently or the same every time.+-}+data RandomSeed = Randomize | Repeatable deriving (Show)++{-| PDFUnits is used to specify measurements when rendering+ a PDF.+-}+data PDFUnits = Points | Inches deriving (Show)++{-| Optional image parameters that dictate different+ properties of the rendered image.+-}+data ImageParams = ImageParams {+ format :: Format+ , width :: Maybe Double+ , height :: Maybe Double+ , hId :: Maybe String+ , size :: Maybe Double+ , color :: Maybe Color+ , lineSpacing :: Maybe Double+ , lineSpacingVariance :: Maybe Double+ , wordSpacingVariance :: Maybe Double+ , randomSeed :: RandomSeed+ , pdfUnits :: PDFUnits+ } deriving (Show)++{-| Default image parameters provided for convenience.+-}+defaultImageParams :: ImageParams+defaultImageParams = ImageParams {+ format = PNG+ , width = Nothing+ , height = Nothing+ , hId = Just "2D5S46A80003"+ , size = Nothing+ , color = Nothing+ , lineSpacing = Nothing+ , lineSpacingVariance = Nothing+ , wordSpacingVariance = Nothing+ , randomSeed = Randomize+ , pdfUnits = Inches+ }
+ src/Network/Internal/Utilities.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings #-}++-------------------------------------------------------------------------------+-- |+-- Module : Network.Internal.Utilities+-- Copyright : (C) 2016 Ismail Mustafa+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ismail Mustafa <ismailmustafa@rocketmail.com+-- Stability : provisional+-- Portability : OverloadedStrings+--+-- Helper functions that don't blong anywhere else.+--+-------------------------------------------------------------------------------++module Network.Internal.Utilities+ ( jsonToHandwriting,+ processImageParams+ ) where++import Control.Lens ((^?))+import Data.Aeson (Value)+import Data.Aeson.Lens (key, _String, _Double)+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import Network.Wreq+import Numeric (showHex, showFFloat)++import Network.Internal.Model++{-| Convert a json object to a handwriting data type.+-}+jsonToHandwriting :: Value -> Handwriting+jsonToHandwriting json =+ Handwriting { handwritingId = s $ json ^? (key "id" . _String)+ , title = s $ json ^? (key "title" . _String)+ , dateCreated = s $ json ^? (key "date_created" . _String)+ , dateModified = s $ json ^? (key "date_modified" . _String)+ , ratingNeatness = d $ json ^? (key "rating_neatness" . _Double)+ , ratingCursivity = d $ json ^? (key "rating_cursivity" . _Double)+ , ratingEmbellishment = d $ json ^? (key "rating_embellishment" . _Double)+ , ratingCharacterWidth = d $ json ^? (key "rating_character_width" . _Double)+ }+ where s = fromMaybe ""+ d = fromMaybe 0++{-| Takes in image parameters and the text to render and generates+ a properly formatted endpoint.+-}+processImageParams :: ImageParams -> String -> String+processImageParams ip s = mconcat [hFormat, handId, hSize, hColor, + hText, hWidth, hHeight,+ hLineSpace, hLineSpaceVar,+ hWordSpaceVar, hRandomSeed]+ where hFormat = case format ip of {PNG -> "png";PDF -> "pdf"}+ hUnits = case format ip of {PNG -> "px";PDF -> case pdfUnits ip of {Points -> "pt";Inches -> "in" }}+ handId = fromMaybe "" $ ("?handwriting_id="<>) <$> hId ip + hSize = fromMaybe "" $ (\x -> "&handwriting_size=" <> show x <> hUnits) <$> size ip+ hColor = handleColor (format ip) $ color ip+ hText = "&text=" <> s+ hWidth = fromMaybe "" $ (\x -> "&width=" <> show x <> hUnits) <$> width ip+ hHeight = fromMaybe "&height=auto" $ (\x -> "&height=" <> show x <> hUnits) <$> height ip+ hLineSpace = fromMaybe "" $ (("&line_spacing="<>) . show) <$> lineSpacing ip + hLineSpaceVar = fromMaybe "" $ (("&line_spacing_variance="<>) . show) <$> lineSpacingVariance ip + hWordSpaceVar = fromMaybe "" $ (("&word_spacing_variance="<>) . show) <$> wordSpacingVariance ip + hRandomSeed = "&random_seed=" <> case randomSeed ip of {Randomize -> "-1" ; Repeatable -> "1"}++{-| Convert RGB to either hex or png depending on output format.+-}+handleColor :: Format -> Maybe Color -> String+handleColor format color = case format of+ PNG -> fromMaybe "" $ toHex <$> color+ PDF -> fromMaybe "" $ toCMYK <$> color++{-| Convert RGB to Hex.+-}+toHex :: Color -> String+toHex (r,g,b) = "&handwriting_color=" <> showHex r "" <> showHex g "" + <> showHex b ""++{-| Limit double values to 3 significant figures.+-}+sigFigs :: Double -> String+sigFigs floatNum = showFFloat (Just 3) floatNum ""+++{-| Convert RGB to CMYK.+-}+toCMYK :: Color -> String+toCMYK color = "&handwriting_color=" <> "(" <> sigFigs c <> "," <> sigFigs m + <> "," <> sigFigs y <> "," <> sigFigs k + <> ")"+ where (c0,m0,y0) = convertRGBtoCMY color+ k = minimum [c0,m0,y0]+ c = ( c0 - k ) / ( 1 - k )+ m = ( m0 - k ) / ( 1 - k )+ y = ( y0 - k ) / ( 1 - k )++{-| Convert RGB to CMY.+-}+convertRGBtoCMY :: Color -> (Double,Double,Double)+convertRGBtoCMY (r,g,b) = (c, m, y)+ where c = 1 - (fromIntegral r / 255)+ m = 1 - (fromIntegral g / 255)+ y = 1 - (fromIntegral b / 255)
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"