concrete-haskell 0.1.0.9 → 0.1.0.10
raw patch · 5 files changed
+116/−106 lines, 5 filesdep ~QuickCheckdep ~bytestringdep ~bzlib
Dependency ranges changed: QuickCheck, bytestring, bzlib, containers, directory, filepath, hashable, megaparsec, mtl, process, scientific, tar, text, time, unordered-containers, uuid, vector, zip, zlib
Files
- concrete-haskell.cabal +77/−77
- src/Data/Concrete/Parsers/JSON.hs +3/−4
- src/Data/Concrete/Parsers/Utils.hs +30/−21
- src/Data/Concrete/Utils.hs +4/−3
- utils/IngestCommunications.hs +2/−1
concrete-haskell.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: concrete-haskell-version: 0.1.0.9+version: 0.1.0.10 synopsis: Library for the Concrete data format. description: Concrete is a Thrift-based data specification designed for Natural Language Processing (NLP) applications. This library provides a Haskell interface to code generated from the latest release of Concrete. It also has a number of utilities for converting various formats (JSON, CSV, XML, etc) to Concrete Communication objects. category: Data@@ -22,29 +22,29 @@ default-extensions: RecordWildCards build-depends: base >=4.6 && <5- , bytestring- , bzlib- , containers- , directory- , filepath- , hashable- , megaparsec >=5.3.0- , mtl+ , bytestring ==0.10.8.1+ , bzlib ==0.5.0.5+ , containers ==0.5.7.1+ , directory ==1.3.0.0+ , filepath ==1.4.1.1+ , hashable ==1.2.6.1+ , megaparsec ==5.3.1+ , mtl ==2.2.1 , network ==2.6.3.2 , optparse-generic ==1.2.2 , path-io ==1.2.2- , process- , QuickCheck- , scientific- , tar- , text+ , process ==1.4.3.0+ , QuickCheck ==2.9.2+ , scientific ==0.3.5.1+ , tar ==0.5.0.3+ , text ==1.2.2.2 , thrift ==0.10.0- , time- , unordered-containers- , uuid- , vector- , zip- , zlib+ , time ==1.6.0.1+ , unordered-containers ==0.2.8.0+ , uuid ==1.3.13+ , vector ==0.10.12.2+ , zip ==0.1.11+ , zlib ==0.6.1.2 exposed-modules: Data.Concrete Data.Concrete.Services.ActiveLearnerClientService@@ -182,29 +182,29 @@ utils build-depends: base >=4.6 && <5- , bytestring- , bzlib- , containers- , directory- , filepath- , hashable- , megaparsec >=5.3.0- , mtl+ , bytestring ==0.10.8.1+ , bzlib ==0.5.0.5+ , containers ==0.5.7.1+ , directory ==1.3.0.0+ , filepath ==1.4.1.1+ , hashable ==1.2.6.1+ , megaparsec ==5.3.1+ , mtl ==2.2.1 , network ==2.6.3.2 , optparse-generic ==1.2.2 , path-io ==1.2.2- , process- , QuickCheck- , scientific- , tar- , text+ , process ==1.4.3.0+ , QuickCheck ==2.9.2+ , scientific ==0.3.5.1+ , tar ==0.5.0.3+ , text ==1.2.2.2 , thrift ==0.10.0- , time- , unordered-containers- , uuid- , vector- , zip- , zlib+ , time ==1.6.0.1+ , unordered-containers ==0.2.8.0+ , uuid ==1.3.13+ , vector ==0.10.12.2+ , zip ==0.1.11+ , zlib ==0.6.1.2 , concrete-haskell other-modules: InspectCommunication@@ -217,29 +217,29 @@ default-extensions: RecordWildCards build-depends: base >=4.6 && <5- , bytestring- , bzlib- , containers- , directory- , filepath- , hashable- , megaparsec >=5.3.0- , mtl+ , bytestring ==0.10.8.1+ , bzlib ==0.5.0.5+ , containers ==0.5.7.1+ , directory ==1.3.0.0+ , filepath ==1.4.1.1+ , hashable ==1.2.6.1+ , megaparsec ==5.3.1+ , mtl ==2.2.1 , network ==2.6.3.2 , optparse-generic ==1.2.2 , path-io ==1.2.2- , process- , QuickCheck- , scientific- , tar- , text+ , process ==1.4.3.0+ , QuickCheck ==2.9.2+ , scientific ==0.3.5.1+ , tar ==0.5.0.3+ , text ==1.2.2.2 , thrift ==0.10.0- , time- , unordered-containers- , uuid- , vector- , zip- , zlib+ , time ==1.6.0.1+ , unordered-containers ==0.2.8.0+ , uuid ==1.3.13+ , vector ==0.10.12.2+ , zip ==0.1.11+ , zlib ==0.6.1.2 , concrete-haskell other-modules: IngestCommunications@@ -250,28 +250,28 @@ main-is: tests/UnitTests.hs build-depends: base >=4.6 && <5- , bytestring- , bzlib- , containers- , directory- , filepath- , hashable- , megaparsec >=5.3.0- , mtl+ , bytestring ==0.10.8.1+ , bzlib ==0.5.0.5+ , containers ==0.5.7.1+ , directory ==1.3.0.0+ , filepath ==1.4.1.1+ , hashable ==1.2.6.1+ , megaparsec ==5.3.1+ , mtl ==2.2.1 , network ==2.6.3.2 , optparse-generic ==1.2.2 , path-io ==1.2.2- , process- , QuickCheck- , scientific- , tar- , text+ , process ==1.4.3.0+ , QuickCheck ==2.9.2+ , scientific ==0.3.5.1+ , tar ==0.5.0.3+ , text ==1.2.2.2 , thrift ==0.10.0- , time- , unordered-containers- , uuid- , vector- , zip- , zlib+ , time ==1.6.0.1+ , unordered-containers ==0.2.8.0+ , uuid ==1.3.13+ , vector ==0.10.12.2+ , zip ==0.1.11+ , zlib ==0.6.1.2 , concrete-haskell default-language: Haskell2010
src/Data/Concrete/Parsers/JSON.hs view
@@ -25,6 +25,7 @@ , manyTill , anyChar , runParser+ , try , some , char , choice@@ -99,11 +100,9 @@ arrayEntryP = pathArrayEntryRule $ do jsonP- return () -arrayP = pathArrayRule $ do- c <- brackets (arrayEntryP `sepBy` comma)- return ()+arrayP = pathArrayRule $ do + (try (brackets space)) <|> ((brackets (arrayEntryP `sepBy` comma)) >> return ()) pairP = do key <- stringLiteral
src/Data/Concrete/Parsers/Utils.hs view
@@ -28,15 +28,7 @@ import Data.Maybe (fromJust) import Text.Printf (printf) -substr :: T.Text -> Int -> Int -> String-substr t s e = T.unpack res- where- (_, start) = T.splitAt (fromIntegral s) t- res = T.take (fromIntegral $ e - s) start--makeId :: [(Text, Text)] -> Text -> Int -> Text-makeId ss i n = foldr (\ (a, b) x -> T.replace (T.concat ["${", a, "}"]) b x) i (("", (pack . show) n):ss)-+-- | Wraps a rule that corresponds to a single Communication communicationRule :: (Communication -> Communication) -> CommunicationParser a -> CommunicationParser a communicationRule tr p = do offset <- (fromIntegral . stateTokensProcessed) <$> getParserState @@ -62,6 +54,18 @@ clearState return o +-- | Extracts a sub-string from a text object+substr :: T.Text -> Int -> Int -> String+substr t s e = T.unpack res+ where+ (_, start) = T.splitAt (fromIntegral s) t+ res = T.take (fromIntegral $ e - s) start++-- | Performs variable substitution on an ID string+makeId :: [(Text, Text)] -> Text -> Int -> Text+makeId ss i n = foldr (\ (a, b) x -> T.replace (T.concat ["${", a, "}"]) b x) i (("", (pack . show) n):ss)++-- | Resets the "Communication-building" state inside the parser clearState :: CommunicationParser () clearState = do bs <- get@@ -72,61 +76,64 @@ put s return () ---pathArrayRule :: CommunicationParser a -> CommunicationParser a---pathArrayRule p = p- +-- | Wraps a rule corresponding to an array-like object, pushing a dummy+-- numeric component onto the path at the start, and popping at the end pathArrayRule :: CommunicationParser a -> CommunicationParser a pathArrayRule p = do pushPathComponent (show (-1))- r <- p+ (m, r) <- match p popPathComponent return r --- pathArrayEntryRule :: CommunicationParser a -> CommunicationParser a--- pathArrayEntryRule p = p-+-- | Wraps a rule corresponding to an array-like entry, incrementing the+-- top-level path component pathArrayEntryRule :: CommunicationParser a -> CommunicationParser a pathArrayEntryRule p = do incrementPathComponent p +-- | Wraps a rule corresponding to a dictionary-like object, pushing a+-- dummy string component onto the path, and popping at the end pathDictionaryRule :: CommunicationParser a -> CommunicationParser a pathDictionaryRule p = do pushPathComponent "PLACEHOLDER" (m, r) <- match p- t' <- popPathComponent+ popPathComponent return r +-- | Wraps a rule corresponding to a key in a dictionary-like object, modifying+-- the current head of the stack pathDictionaryKeyRule :: CommunicationParser String -> CommunicationParser String pathDictionaryKeyRule p = do t' <- p modifyPathComponent (\x -> t') return "" +-- | Push a string component onto the path pushPathComponent :: String -> CommunicationParser () pushPathComponent s = do Bookkeeper{..} <- get- --liftIO $ print ("starting component") -- , s, path) modify (\ bs -> bs { path=s:path }) return () +-- | Pop the top-level component from the path popPathComponent :: CommunicationParser String popPathComponent = do Bookkeeper{..} <- get let (p:ps) = path- --liftIO $ print ("ending component", p) --, ps) modify (\ bs -> bs { path=ps }) return p +-- | Modify the top-level path component modifyPathComponent :: (String -> String) -> CommunicationParser () modifyPathComponent f = do Bookkeeper{..} <- get let (p:ps) = path p' = f p- --liftIO $ print ("modifying component", p, "to", p') -- , ps) modify (\ bs -> bs { path=p':ps }) return () +-- | Increment the top-level path component as an integer incrementPathComponent :: CommunicationParser Int incrementPathComponent = do Bookkeeper{..} <- get@@ -135,6 +142,7 @@ modify (\ bs -> bs { path=(show p'):(tail path) }) return p' +-- | Wraps a rule corresponding to a Communication Section sectionRule :: (Section -> Section) -> CommunicationParser a -> CommunicationParser a sectionRule t p = do s <- (fromIntegral . stateTokensProcessed) <$> getParserState@@ -151,7 +159,8 @@ else put $ bs { communication=communication { communication_sectionList=(cons section) <$> (communication_sectionList communication) } } return v- ++-- | A data structure that is positioned inside a document and whose boundaries can be adjusted class Located a where getTextSpan :: a -> TextSpan setTextSpan :: TextSpan -> a -> a
src/Data/Concrete/Utils.hs view
@@ -190,9 +190,10 @@ res = T.take (fromIntegral $ e - s) start showCommunication :: Communication -> T.Text-showCommunication c = T.concat [C.communication_id c, " ", C.communication_type c, "\n", " Content:", "\n", T.intercalate "\n" sects, "\n"]+showCommunication c = T.concat [C.communication_id c, " ", C.communication_type c, "\n Content sections:", "\n", T.intercalate "\n" contentSects, "\n Metadata sections: ", metadataText, "\n"] where ss = L.concat $ L.map V.toList (maybeToList (C.communication_sectionList c)) t = (fromJust . C.communication_text) c- sects = L.map (showSection t) ((L.filter (\x -> section_kind x == "content")) ss)- + contentSects = L.map (showSection t) ((L.filter (\x -> section_kind x == "content")) ss)+ metadataSects = L.map (fromMaybe "?" . C.section_label) ((L.filter (\x -> section_kind x /= "content")) ss)+ metadataText = T.intercalate ", " metadataSects
utils/IngestCommunications.hs view
@@ -60,5 +60,6 @@ return $ StoreService.store con (Nothing, Nothing, Nothing) -> return $ writeCommunication stdout _ -> error "Specify either an output file, a host and port, or nothing (for stdout)"- cs <- ingest cb cp (decodeUtf8 ih) (contentSectionTypes ps) (commId ps) (commType ps)+ cs <- ingest (putStrLn . unpack . CU.showCommunication) cp (decodeUtf8 ih) (contentSectionTypes ps) (commId ps) (commType ps) + --cs <- ingest print cp (decodeUtf8 ih) (contentSectionTypes ps) (commId ps) (commType ps) return ()