1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
module T19695 where
import Prelude
import Control.Monad (liftM)
import Control.Monad.Trans.RWS.Lazy
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.IO.Class (MonadIO (..))
import Data.ByteString (ByteString)
import Data.Monoid (Any (..))
import Data.String (IsString (..))
import Data.Char (toUpper, toLower, isAlpha)
import Data.List (intersperse)
import qualified Data.Map as Map
import GHC.Generics
type Handler = ReaderT () IO
type MForm = RWST (Maybe ([(String, Text)], ()), (), ()) Any [Int]
type Text = ByteString
data FormResult a = FormMissing
| FormFailure [Text]
| FormSuccess a
deriving Show
instance Functor FormResult where
fmap _ FormMissing = FormMissing
fmap _ (FormFailure errs) = FormFailure errs
fmap f (FormSuccess a) = FormSuccess $ f a
instance Applicative FormResult where
pure = FormSuccess
(FormSuccess f) <*> (FormSuccess g) = FormSuccess $ f g
(FormFailure x) <*> (FormFailure y) = FormFailure $ x ++ y
(FormFailure x) <*> _ = FormFailure x
_ <*> (FormFailure y) = FormFailure y
_ <*> _ = FormMissing
instance Monoid m => Monoid (FormResult m) where
mempty = pure mempty
instance Semigroup m => Semigroup (FormResult m) where
x <> y = (<>) <$> x <*> y
mreq :: MonadIO m => String -> MForm m (FormResult Text, ())
mreq v = mhelper v (\_ _ -> FormFailure ["fail"]) FormSuccess
mcountry :: MonadIO m => String -> MForm m (FormResult CountryCode, ())
mcountry v = mhelper v (\_ _ -> FormFailure ["fail"]) go where
go t = let
fanl f x= (f x , x)
m = Map.fromList $ map (fanl $ fromString . countryNameFromCode) [minBound..maxBound]
in maybe (FormFailure ["fail"]) FormSuccess $ Map.lookup t m
askParams :: Monad m => MForm m (Maybe [(String, Text)])
askParams = do
(x, _, _) <- ask
return $ liftM fst x
mhelper
:: MonadIO m
=> String
-> (() -> () -> FormResult b)
-> (Text -> FormResult b)
-> MForm m (FormResult b, ())
mhelper v onMissing onFound = do
tell (Any True)
mp <- askParams
(res, x) <- case mp of
Nothing -> return (FormMissing, ())
Just p -> do
return $ case lookup v p of
Nothing -> (onMissing () (), ())
Just t -> (onFound t, ())
return (res, x)
data ShippingForm = ShippingForm
{ shCustomerName :: CountryCode
, shCountry :: CountryCode
, shPostalCode :: CountryCode
, shAddress1 :: CountryCode
, shAddress2 :: CountryCode
, shCity :: CountryCode
, shCountyState :: CountryCode
, shContact :: CountryCode
, shTelephone :: CountryCode
, shNotificationEmail :: CountryCode
, shNotificationCountryCode :: CountryCode
, shNoOfPackages :: CountryCode
, shWeight :: CountryCode
, shGenerateCustomData :: CountryCode
, shTaxId :: CountryCode
, shServiceCode :: CountryCode
} deriving Show
data Match = Match
shippingForm :: Maybe ShippingForm
-> MForm Handler (FormResult ShippingForm)
shippingForm _ = do
customerName <- mcountry "Customer Name"
country <- mcountry "Country"
postalCode <- mcountry "Postal/Zip Code"
address1 <- mcountry "Address 1"
address2 <- mcountry "Address 2"
city <- mcountry "City"
countyState <- mcountry "County/State"
contact <- mcountry "Contact"
telephone <- mcountry "Telephone"
notificationEmail <- mcountry "Notification Email"
notificationText <- mcountry "Notification Text"
noOfPackages <- mcountry "No of Packages"
weight <- mcountry "Weight"
generateCustomData <- mcountry "Custom Data"
taxId <- mcountry "EORI"
serviceCode <- mcountry "Service"
return (ShippingForm <$> fst customerName
<*> fst country
<*> fst postalCode
<*> fst address1
<*> fst address2
<*> fst city
<*> fst countyState
<*> fst contact
<*> fst telephone
<*> fst notificationEmail
<*> fst notificationText
<*> fst noOfPackages
<*> fst weight
<*> fst generateCustomData
<*> fst taxId
<*> fst serviceCode
)
data CountryCode = CC
deriving (Eq,Read,Show,Enum,Bounded,Ord,Generic)
countryNameFromCode:: CountryCode -> String
countryNameFromCode CC = "CC"
|
