git.iko.soy/project-m36
on master help sign in
change toText/fromText for Text to restore quoting

-this fixes ConstructedAtom Text display to adds quotes around all strings -this requires some special-casing for CSV import/export to prevent double double-quotes

commit3e3e94ddf3d6a508c518e03e3c27bb1533a69761 authorAgentM <agentm@themactionfaction.com> dateThu 24 Mar 2016, 13:03 (11 years ago) parent536b19f
3 files changed+15−6
compare with master
unifiedsplit
ProjectM36/Base.hs+1−4 ProjectM36/Relation/Parse/CSV.hs+9−1 ProjectM36/Relation/Show/CSV.hs+5−1
ProjectM36/Base.hs+1−4
@@ -39,7 +39,7 @@ class (Read a,
3939 fromText :: (Atomable a) => Text -> Either String a
4040 fromText t = case readMaybe (unpack t) of
4141 Just v -> Right v
42− Nothing -> Left "parse error"
42+ Nothing -> Left ("Parse error: " ++ (unpack t))
4343
4444 toText :: a -> Text
4545 toText a = pack $ show a
@@ -47,9 +47,6 @@ class (Read a,
4747instance Atomable Int
4848instance Atomable Double
4949instance Atomable Text where
50− --no need to require quoted strings
51− fromText t = Right t
52− toText t = t
5350instance Atomable Day
5451instance Atomable UTCTime
5552instance Atomable ByteString where
ProjectM36/Relation/Parse/CSV.hs+9−1
@@ -7,6 +7,7 @@ import Data.Char (ord)
77import qualified Data.ByteString.Lazy as BS
88import ProjectM36.Base
99import ProjectM36.Relation
10+import ProjectM36.DataTypes.Primitive
1011import ProjectM36.Error
1112import Data.Text.Encoding (decodeUtf8)
1213import qualified ProjectM36.Attribute as A
@@ -25,6 +26,13 @@ data CsvImportError = CsvParseError String |
2526csvDecodeOptions :: DecodeOptions
2627csvDecodeOptions = DecodeOptions {decDelimiter = fromIntegral (ord ',')}
2728
29+--special case from Text- outer quotes are *not* required in CSV, so we have to add them to make it parseable
30+makeAtomFromCSVText :: AttributeName -> AtomType -> T.Text -> Either RelationalError Atom
31+makeAtomFromCSVText attrName aType textIn = makeAtomFromText attrName aType $ if aType == textAtomType then
32+ ("\"" `T.append` textIn `T.append` "\"")
33+ else
34+ textIn
35+
2836csvAsRelation :: BS.ByteString -> Attributes -> Either CsvImportError Relation
2937csvAsRelation inString attrs = case parse (csvWithHeader csvDecodeOptions) inString of
3038 Fail _ _ err -> Left (CsvParseError err)
@@ -36,7 +44,7 @@ csvAsRelation inString attrs = case parse (csvWithHeader csvDecodeOptions) inStr
3644 attrNameSet = S.fromList (V.toList attrNames)
3745 headerSet = S.fromList (V.toList strHeader)
3846 makeTupleList :: HM.HashMap AttributeName String -> [Either CsvImportError Atom]
39− makeTupleList tupMap = V.toList $ V.map (\attr -> either (Left . AttributeMappingError) Right $ makeAtomFromText (A.attributeName attr) (A.atomType attr) (T.pack $ tupMap HM.! (A.attributeName attr))) attrs
47+ makeTupleList tupMap = V.toList $ V.map (\attr -> either (Left . AttributeMappingError) Right $ makeAtomFromCSVText (A.attributeName attr) (A.atomType attr) (T.pack $ tupMap HM.! (A.attributeName attr))) attrs
4048 case attrNameSet == headerSet of
4149 False -> Left $ HeaderAttributeMismatchError (S.difference attrNameSet headerSet)
4250 True -> do
ProjectM36/Relation/Show/CSV.hs+5−1
@@ -2,6 +2,7 @@
22{-# OPTIONS_GHC -fno-warn-orphans #-}
33module ProjectM36.Relation.Show.CSV where
44import ProjectM36.Base
5+import Data.Typeable (cast)
56import ProjectM36.Attribute
67import Data.Csv
78import ProjectM36.Tuple
@@ -40,4 +41,7 @@ newtype RecordAtom = RecordAtom {unAtom :: Atom}
4041
4142instance ToField RecordAtom where
4243 toField (RecordAtom (ConstructedAtom dConsName _ atomList)) = TE.encodeUtf8 $ dConsName `T.append` T.intercalate " " (map (\(Atom x) -> toText x) atomList)
43− toField (RecordAtom (Atom atomVal)) = (TE.encodeUtf8 . toText) atomVal
44+ toField (RecordAtom (Atom atomVal)) = case cast atomVal of
45+ Just texto -> TE.encodeUtf8 texto --squelch extraneous quotes for text type- the CSV library will add them if necessary
46+ Nothing -> (TE.encodeUtf8 . toText) atomVal
47+