Skip to content

Instantly share code, notes, and snippets.

@jferris

jferris/Cli.hs Secret

Created Jan 20, 2014
Embed
What would you like to do?
Haskell implementation of FastOrderLine parser
import Control.Applicative ((<$>))
import Combinable (combineAll)
import LineParser (parseInput)
import Order (Order, orderWithDefaults, removeZeroQty, validate)
main :: IO ()
main = display . parse =<< getContents
parse :: String -> Either String [Order]
parse contents =
mapM validate
=<< removeZeroQty
. combineAll
<$> parseOrders currentUserId contents
display :: Either String [Order] -> IO ()
display (Left error) = putStrLn error
display (Right orders) = mapM_ print orders
parseOrders :: Int -> String -> Either String [Order]
parseOrders userId = parseInput linePattern match
where
match :: [String] -> Maybe Order
match (ref1:prnum:qty:ref3:ref4:[]) =
Just $ orderWithDefaults ref1 prnum (read qty) ref3 ref4 userId
match _ = Nothing
-- F1234/0/1|11-87-17|1|JOHN DOE|COMPANY
linePattern = "^(.+/\\d+/\\d+)\\|(\\d\\d-\\d\\d-\\d\\d)\\|(-?\\d+)\\|([^|]+)\\|([^|]+)$"
currentUserId = 6
module Combinable (Combinable, combine, combineAll, similar) where
import Data.Sequence ((<|), empty, findIndexL, fromList, Seq, adjust)
import qualified Data.Foldable as Foldable
class Combinable a where
similar :: Combinable a => a -> a -> Bool
combine :: Combinable a => a -> a -> a
combineAll :: Combinable a => [a] -> [a]
combineAll = Foldable.toList . Foldable.foldl combineOne empty . fromList
combineOne :: Combinable a => Seq a -> a -> Seq a
combineOne xs x =
case findIndexL (similar x) xs of
Just i -> adjust (combine x) i xs
Nothing -> x <| xs
F1234/0/1|11-87-17|1|JOHN DOE|COMPANY
F1234/0/1|11-87-17|1|JOHN DOE|COMPANY
F1234/0/1|11-87-38|1|JOHN DOE|COMPANY
F1234/0/1|11-87-39|1|JOHN DOE|COMPANY
F1234/0/1|11-87-39|-1|JOHN DOE|COMPANY
module LineParser (parseInput) where
import Text.Regex.PCRE ((=~), getAllTextSubmatches)
parseInput :: String -> ([String] -> Maybe a) -> String -> Either String [a]
parseInput pattern parser = mapEither (parser . matchLine pattern) . lines
matchLine :: String -> String -> [String]
matchLine pattern line = tail $ getAllTextSubmatches $ line =~ pattern
mapEither :: Show a => (a -> Maybe b) -> [a] -> Either String [b]
mapEither f = mapM (indexMaybeToEither f) . elemsWithIndex
where elemsWithIndex = zip [1..]
indexMaybeToEither :: Show a => (a -> Maybe b) -> (Int, a) -> Either String b
indexMaybeToEither f (index,input) =
case f input of
Nothing -> Left error
Just result -> Right result
where error = "Error on " ++ (show index) ++ ": " ++ (show input)
module Order (Order, orderWithDefaults, removeZeroQty, validate) where
import Combinable
data Order = Order {
vatRate :: Int
, lineVat :: Int
, productId :: Int
, price :: Int
, sellingUnit :: Int
, specialId :: Int
, checkoutref1 :: String
, prnum :: String
, qty :: Int
, checkoutref3 :: String
, checkoutref4 :: String
, userId :: Int
} deriving (Show)
instance Combinable Order where
combine a b = a { qty = qty a + qty b }
similar a b = key a == key b
key :: Order -> [String]
key order = map ($ order) [prnum, checkoutref3, checkoutref1]
orderWithDefaults :: String -> String -> Int -> String -> String -> Int -> Order
orderWithDefaults = Order defaultVatRate 0 0 0 1 0
removeZeroQty :: [Order] -> [Order]
removeZeroQty = filter $ (/= 0) . qty
validate :: Order -> Either String Order
validate order
| qty order < 0 =
Left "You have a negative quantity(s), please fix it, and retry."
| otherwise =
Right order
defaultVatRate = 5
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment