git.iko.soy/typeable/hexml
on master help sign in
Move to pure
b2408f1Neil Mitchell
gen/Lib.hs+1−1
compare with master
unifiedsplit
@@ -67,7 +67,7 @@ choices :: [Parser o ()] -> Parser o ()
67choices = foldr1 choice
67choices = foldr1 choice
68
68
69optional :: Parser o () -> Parser o ()
69optional :: Parser o () -> Parser o ()
70−optional x = choice x $ return ()
70+optional x = choice x $ pure ()
71
71
72
72
73---------------------------------------------------------------------
73---------------------------------------------------------------------
gen/Main.hs+2−2
@@ -28,13 +28,13 @@ main = do
28
28
29writeFileChanged :: FilePath -> String -> IO ()
29writeFileChanged :: FilePath -> String -> IO ()
30writeFileChanged file new = do
30writeFileChanged file new = do
31− old <- ifM (doesFileExist file) (readFile' file) (return "")
31+ old <- ifM (doesFileExist file) (readFile' file) (pure "")
32 when (old /= new) $
32 when (old /= new) $
33 writeFile file new
33 writeFile file new
34
34
35buildRule :: [FilePath] -> [FilePath] -> IO () -> IO ()
35buildRule :: [FilePath] -> [FilePath] -> IO () -> IO ()
36buildRule from to act = do
36buildRule from to act = do
37− let modTime x = ifM (doesFileExist x) (Just <$> getModificationTime x) (return Nothing)
37+ let modTime x = ifM (doesFileExist x) (Just <$> getModificationTime x) (pure Nothing)
38 from <- mapM modTime from
38 from <- mapM modTime from
39 to <- mapM modTime to
39 to <- mapM modTime to
40 when (any isNothing (from ++ to) || maximum from >= minimum to)
40 when (any isNothing (from ++ to) || maximum from >= minimum to)
src/Main.hs+4−4
@@ -44,12 +44,12 @@ main = do
44 attributes (head $ children doc) === [Attribute "id" "1", Attribute "extra" "2"]
44 attributes (head $ children doc) === [Attribute "id" "1", Attribute "extra" "2"]
45 map (`attributeBy` "id") (childrenBy doc "test") === map (fmap (Attribute "id")) [Just "1", Just "2", Just "4", Nothing]
45 map (`attributeBy` "id") (childrenBy doc "test") === map (fmap (Attribute "id")) [Just "1", Just "2", Just "4", Nothing]
46
46
47− Right _ <- return $ parse $ "<test " <> BS.unwords [BS.pack $ "x" ++ show i ++ "='value'" | i <- [1..10000]] <> " />"
47+ Right _ <- pure $ parse $ "<test " <> BS.unwords [BS.pack $ "x" ++ show i ++ "='value'" | i <- [1..10000]] <> " />"
48− Right _ <- return $ parse $ BS.unlines $ replicate 10000 "<test x='value' />"
48+ Right _ <- pure $ parse $ BS.unlines $ replicate 10000 "<test x='value' />"
49
49
50 let attrs = ["usd:jpy","test","extra","more","stuff","jpy:usd","xxx","xxxx"]
50 let attrs = ["usd:jpy","test","extra","more","stuff","jpy:usd","xxx","xxxx"]
51− Right doc <- return $ parse $ "<test " <> BS.unwords [x <> "='" <> x <> "'" | x <- attrs] <> ">middle</test>"
51+ Right doc <- pure $ parse $ "<test " <> BS.unwords [x <> "='" <> x <> "'" | x <- attrs] <> ">middle</test>"
52− [c] <- return $ childrenBy doc "test"
52+ [c] <- pure $ childrenBy doc "test"
53 forM_ attrs $ \a -> attributeBy c a === Just (Attribute a a)
53 forM_ attrs $ \a -> attributeBy c a === Just (Attribute a a)
54 forM_ ["missing","gone","nothing"] $ \a -> attributeBy c a === Nothing
54 forM_ ["missing","gone","nothing"] $ \a -> attributeBy c a === Nothing
55 putStrLn "\nSuccess"
55 putStrLn "\nSuccess"
src/Text/XML/Hexml.hs+8−8
@@ -90,11 +90,11 @@ parse src = do
90 if err /= nullPtr then do
90 if err /= nullPtr then do
91 bs <- BS.packCString =<< hexml_document_error doc
91 bs <- BS.packCString =<< hexml_document_error doc
92 hexml_document_free doc
92 hexml_document_free doc
93− return $ Left bs
93+ pure $ Left bs
94 else do
94 else do
95 node <- hexml_document_node doc
95 node <- hexml_document_node doc
96 doc <- newForeignPtr hexml_document_free_funptr doc
96 doc <- newForeignPtr hexml_document_free_funptr doc
97− return $ Right $ Node src0 doc node
97+ pure $ Right $ Node src0 doc node
98
98
99-- | Given a node, rerender it to something with an equivalent parse tree.
99-- | Given a node, rerender it to something with an equivalent parse tree.
100-- Mostly useful for debugging - if you want the real source document use 'outer' instead.
100-- Mostly useful for debugging - if you want the real source document use 'outer' instead.
@@ -103,7 +103,7 @@ render (Node src doc n) = unsafePerformIO $ withForeignPtr doc $ \d -> do
103 i <- hexml_node_render d n nullPtr 0
103 i <- hexml_node_render d n nullPtr 0
104 res <- BS.create (fromIntegral i) $ \ptr -> void $ hexml_node_render d n (castPtr ptr) i
104 res <- BS.create (fromIntegral i) $ \ptr -> void $ hexml_node_render d n (castPtr ptr) i
105 touchBS src
105 touchBS src
106− return res
106+ pure res
107
107
108applyStr :: BS.ByteString -> Str -> BS.ByteString
108applyStr :: BS.ByteString -> Str -> BS.ByteString
109applyStr bs Str{..} = BS.take (fromIntegral strLength) $ BS.drop (fromIntegral strStart) bs
109applyStr bs Str{..} = BS.take (fromIntegral strLength) $ BS.drop (fromIntegral strStart) bs
@@ -118,7 +118,7 @@ attrPeek :: BS.ByteString -> ForeignPtr CDocument -> Ptr CAttr -> Attribute
118attrPeek src doc a = unsafePerformIO $ withForeignPtr doc $ \_ -> do
118attrPeek src doc a = unsafePerformIO $ withForeignPtr doc $ \_ -> do
119 name <- applyStr src <$> peekElemOff (castPtr a) 0
119 name <- applyStr src <$> peekElemOff (castPtr a) 0
120 val <- applyStr src <$> peekElemOff (castPtr a) 1
120 val <- applyStr src <$> peekElemOff (castPtr a) 1
121− return $ Attribute name val
121+ pure $ Attribute name val
122
122
123-- | Get the name of a node, e.g. @\<test /\>@ produces @\"test\"@.
123-- | Get the name of a node, e.g. @\<test /\>@ produces @\"test\"@.
124name :: Node -> BS.ByteString
124name :: Node -> BS.ByteString
@@ -156,7 +156,7 @@ children (Node src doc n) = unsafePerformIO $ withForeignPtr doc $ \d ->
156 alloca $ \count -> do
156 alloca $ \count -> do
157 res <- hexml_node_children d n count
157 res <- hexml_node_children d n count
158 count <- fromIntegral <$> peek count
158 count <- fromIntegral <$> peek count
159− return [Node src doc $ plusPtr res $ i*szNode | i <- [0..count-1]]
159+ pure [Node src doc $ plusPtr res $ i*szNode | i <- [0..count-1]]
160
160
161-- | Get the attributes of this node.
161-- | Get the attributes of this node.
162attributes :: Node -> [Attribute]
162attributes :: Node -> [Attribute]
@@ -164,7 +164,7 @@ attributes (Node src doc n) = unsafePerformIO $ withForeignPtr doc $ \d ->
164 alloca $ \count -> do
164 alloca $ \count -> do
165 res <- hexml_node_attributes d n count
165 res <- hexml_node_attributes d n count
166 count <- fromIntegral <$> peek count
166 count <- fromIntegral <$> peek count
167− return [attrPeek src doc $ plusPtr res $ i*szAttr | i <- [0..count-1]]
167+ pure [attrPeek src doc $ plusPtr res $ i*szAttr | i <- [0..count-1]]
168
168
169-- | Get the direct children of this node which have a specific name.
169-- | Get the direct children of this node which have a specific name.
170-- A more efficient version of:
170-- A more efficient version of:
@@ -177,7 +177,7 @@ childrenBy (Node src doc n) str = go nullPtr
177 BS.unsafeUseAsCStringLen str $ \(bs, len) -> do
177 BS.unsafeUseAsCStringLen str $ \(bs, len) -> do
178 r <- hexml_node_child d n old bs $ fromIntegral len
178 r <- hexml_node_child d n old bs $ fromIntegral len
179 touchBS src
179 touchBS src
180− return $ if r == nullPtr then [] else Node src doc r : go r
180+ pure $ if r == nullPtr then [] else Node src doc r : go r
181
181
182-- | Get the first attribute of this node which has a specific name, if there is one.
182-- | Get the first attribute of this node which has a specific name, if there is one.
183-- A more efficient version of:
183-- A more efficient version of:
@@ -188,7 +188,7 @@ attributeBy (Node src doc n) str = unsafePerformIO $ withForeignPtr doc $ \d ->
188 BS.unsafeUseAsCStringLen str $ \(bs, len) -> do
188 BS.unsafeUseAsCStringLen str $ \(bs, len) -> do
189 r <- hexml_node_attribute d n bs $ fromIntegral len
189 r <- hexml_node_attribute d n bs $ fromIntegral len
190 touchBS src
190 touchBS src
191− return $ if r == nullPtr then Nothing else Just $ attrPeek src doc r
191+ pure $ if r == nullPtr then Nothing else Just $ attrPeek src doc r
192
192
193-- | Find the starting location of a node, the @<@ character.
193-- | Find the starting location of a node, the @<@ character.
194-- The first character will be reported as @(line 1,column 1)@, because thats
194-- The first character will be reported as @(line 1,column 1)@, because thats