├── .ghci ├── .github └── FUNDING.yml ├── .gitignore ├── LICENSE ├── README.md ├── Setup.hs ├── dynamic.cabal ├── src └── Dynamic.hs └── stack.yaml /.ghci: -------------------------------------------------------------------------------- 1 | :set -XOverloadedStrings 2 | :set prompt "> " 3 | :l src/Dynamic.hs 4 | import Data.Ord 5 | import Data.List 6 | default (Dynamic) 7 | -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | patreon: chrisdone 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Chris Done (c) 2019 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # dynamic 2 | 3 | Finally, dynamically typed programming in Haskell made easy! 4 | 5 | ## Introduction 6 | 7 | Tired of making data types in your Haskell programs just to read and 8 | manipulate basic JSON/CSV files? Tired of writing imports? Use 9 | `dynamic`, dynamically typed programming for Haskell! 10 | 11 | ## Load it up 12 | 13 | Launch `ghci`, the interactive REPL for Haskell. 14 | 15 | ``` haskell 16 | import Dynamic 17 | ``` 18 | 19 | Don't forget to enable `OverloadedStrings`: 20 | 21 | ``` haskell 22 | :set -XOverloadedStrings 23 | ``` 24 | 25 | Now you're ready for dynamicness! 26 | 27 | ## The Dynamic type 28 | 29 | In the `dynamic` package there is one type: `Dynamic`! 30 | 31 | What, you were expecting something more? Guffaw! 32 | 33 | ## Make dynamic values as easy as pie! 34 | 35 | Primitive values are easy via regular literals: 36 | 37 | ``` haskell 38 | > 1 39 | 1 40 | > "Hello, World!" 41 | "Hello, World!" 42 | ``` 43 | 44 | Arrays and objects have handy functions to make them: 45 | 46 | ``` haskell 47 | > fromList [1,2] 48 | [ 49 | 1, 50 | 2 51 | ] 52 | > fromDict [ ("k", 1), ("v", 2) ] 53 | { 54 | "k": 1, 55 | "v": 2 56 | } 57 | ``` 58 | 59 | Get object keys or array or string indexes via `!`: 60 | 61 | ``` haskell 62 | > fromDict [ ("k", 1), ("v", 2) ] ! "k" 63 | 1 64 | > fromList [1,2] ! 1 65 | 2 66 | > "foo" ! 2 67 | "o" 68 | ``` 69 | 70 | ## Web requests! 71 | 72 | ```json 73 | > chris <- getJson "https://api.github.com/users/chrisdone" [] 74 | > chris 75 | { 76 | "bio": null, 77 | "email": null, 78 | "public_gists": 176, 79 | "repos_url": "https://api.github.com/users/chrisdone/repos", 80 | "node_id": "MDQ6VXNlcjExMDE5", 81 | "following_url": "https://api.github.com/users/chrisdone/following{/other_user}", 82 | "location": "England", 83 | "url": "https://api.github.com/users/chrisdone", 84 | "gravatar_id": "", 85 | "blog": "https://chrisdone.com", 86 | "gists_url": "https://api.github.com/users/chrisdone/gists{/gist_id}", 87 | "following": 0, 88 | "hireable": null, 89 | "organizations_url": "https://api.github.com/users/chrisdone/orgs", 90 | "subscriptions_url": "https://api.github.com/users/chrisdone/subscriptions", 91 | "name": "Chris Done", 92 | "company": "FP Complete @fpco ", 93 | "updated_at": "2019-02-22T11:11:18Z", 94 | "created_at": "2008-05-21T10:29:09Z", 95 | "followers": 1095, 96 | "id": 11019, 97 | "public_repos": 144, 98 | "avatar_url": "https://avatars3.githubusercontent.com/u/11019?v=4", 99 | "type": "User", 100 | "events_url": "https://api.github.com/users/chrisdone/events{/privacy}", 101 | "starred_url": "https://api.github.com/users/chrisdone/starred{/owner}{/repo}", 102 | "login": "chrisdone", 103 | "received_events_url": "https://api.github.com/users/chrisdone/received_events", 104 | "site_admin": false, 105 | "html_url": "https://github.com/chrisdone", 106 | "followers_url": "https://api.github.com/users/chrisdone/followers" 107 | } 108 | ``` 109 | 110 | ## Trivially read CSV files! 111 | 112 | ``` haskell 113 | > fromCsvNamed "name,age,alive,partner\nabc,123,true,null\nabc,ok,true,true" 114 | [{ 115 | "alive": true, 116 | "age": 123, 117 | "partner": null, 118 | "name": "abc" 119 | },{ 120 | "alive": true, 121 | "age": "ok", 122 | "partner": true, 123 | "name": "abc" 124 | }] 125 | ``` 126 | 127 | ## Dynamically typed programming! 128 | 129 | Just write code like you do in Python or JavaScript: 130 | 131 | ```haskell 132 | > if chris!"followers" > 500 then chris!"public_gists" * 5 else chris!"name" 133 | 880 134 | ``` 135 | 136 | ## Experience the wonders of dynamic type errors! 137 | 138 | Try to treat non-numbers as numbers and you get the expected result: 139 | 140 | ``` haskell 141 | > map (\o -> o ! "age" * 2) $ fromCsvNamed "name,age,alive,partner\nabc,123,true,null\nabc,ok,true,true" 142 | [246,*** Exception: DynamicTypeError "Couldn't treat string as number: ok" 143 | ``` 144 | 145 | Laziness makes everything better! 146 | 147 | 148 | ``` haskell 149 | > map (*2) $ toList $ fromJson "[\"1\",true,123]" 150 | [2,*** Exception: DynamicTypeError "Can't treat bool as number." 151 | ``` 152 | 153 | Woops... 154 | 155 | ``` haskell 156 | > map (*2) $ toList $ fromJson "[\"1\",123]" 157 | [2,246] 158 | ``` 159 | 160 | That's better! 161 | 162 | Heterogenous lists are what life is about: 163 | 164 | ``` haskell 165 | > toCsv [ 1, "Chris" ] 166 | "1.0\r\nChris\r\n" 167 | ``` 168 | 169 | I can't handle it!!! 170 | 171 | ## Modifying and updating records 172 | 173 | Use `modify` or `set` to massage data into something more palatable. 174 | 175 | ``` haskell 176 | > modify "followers" (*20) chris 177 | { 178 | "bio": null, 179 | "email": null, 180 | "public_gists": 176, 181 | "repos_url": "https://api.github.com/users/chrisdone/repos", 182 | "node_id": "MDQ6VXNlcjExMDE5", 183 | "following_url": "https://api.github.com/users/chrisdone/following{/other_user}", 184 | "location": "England", 185 | "url": "https://api.github.com/users/chrisdone", 186 | "gravatar_id": "", 187 | "blog": "https://chrisdone.com", 188 | "gists_url": "https://api.github.com/users/chrisdone/gists{/gist_id}", 189 | "following": 0, 190 | "hireable": null, 191 | "organizations_url": "https://api.github.com/users/chrisdone/orgs", 192 | "subscriptions_url": "https://api.github.com/users/chrisdone/subscriptions", 193 | "name": "Chris Done", 194 | "company": "FP Complete @fpco ", 195 | "updated_at": "2019-02-22T11:11:18Z", 196 | "created_at": "2008-05-21T10:29:09Z", 197 | "followers": 21900, 198 | "id": 11019, 199 | "public_repos": 144, 200 | "avatar_url": "https://avatars3.githubusercontent.com/u/11019?v=4", 201 | "type": "User", 202 | "events_url": "https://api.github.com/users/chrisdone/events{/privacy}", 203 | "starred_url": "https://api.github.com/users/chrisdone/starred{/owner}{/repo}", 204 | "login": "chrisdone", 205 | "received_events_url": "https://api.github.com/users/chrisdone/received_events", 206 | "site_admin": false, 207 | "html_url": "https://github.com/chrisdone", 208 | "followers_url": 209 | "https://api.github.com/users/chrisdone/followers" 210 | } 211 | ``` 212 | 213 | ## List of numbers? 214 | 215 | The answer is: Yes, Haskell can do that! 216 | 217 | ``` haskell 218 | > [1.. 5] :: [Dynamic] 219 | [1,2,3,4,5] 220 | ``` 221 | 222 | ## Append things together 223 | 224 | Like in JavaScript, we try to do our best to make something out of appending... 225 | 226 | ``` haskell 227 | > "Wat" <> 1 <> "!" <> Null 228 | "Wat1!" 229 | ``` 230 | 231 | ## Suspicious? 232 | 233 | It's real! This code runs just fine: 234 | 235 | ``` haskell 236 | silly a = 237 | if a > 0 238 | then toJsonFile "out.txt" "Hi" 239 | else toJsonFile "out.txt" (5 + "a") 240 | ``` 241 | 242 | That passes [the dynamic typing test](https://stackoverflow.com/a/27791387). 243 | 244 | ## Mix and match your regular Haskell functions 245 | 246 | Here's an exporation of my Monzo (bank account) data. 247 | 248 | Load up the JSON output: 249 | 250 | ```haskell 251 | > monzo <- fromJsonFile "monzo.json" 252 | ``` 253 | 254 | Preview what's in it: 255 | 256 | ```haskell 257 | > take 100 $ show monzo 258 | "{\n \"transactions\": [\n {\n \"amount\": 10000,\n \"dedupe_id\": \"com.monzo.f" 259 | > toKeys monzo 260 | ["transactions"] 261 | ``` 262 | 263 | OK, just transactions. How many? 264 | 265 | ```haskell 266 | > length $ toList $ monzo!"transactions" 267 | 119 268 | ``` 269 | 270 | What keys do I get in each transaction? 271 | 272 | ```haskell 273 | > toKeys $ head $ toList $ monzo!"transactions" 274 | ["amount","dedupe_id","attachments","can_be_made_subscription","fees","created","category","settled","can_split_the_bill","can_add_to_tab","originator","currency","include_in_spending","merchant","can_be_excluded_from_breakdown","international","counterparty","scheme","local_currency","metadata","id","labels","updated","account_balance","is_load","account_id","notes","user_id","local_amount","description"] 275 | ``` 276 | 277 | What's in `amount`? 278 | 279 | ```haskell 280 | > (!"amount") $ head $ toList $ monzo!"transactions" 281 | 10000 282 | ``` 283 | 284 | Looks like pennies, let's divide that by 100. What's the total +/- sum 285 | of my last 5 transactions? 286 | 287 | ```haskell 288 | > sum $ map ((/100) . (!"amount")) $ take 5 $ toList $ monzo!"transactions" 289 | 468.65 290 | ``` 291 | 292 | What categories are there? 293 | 294 | ```haskell 295 | > nub $ map (!"category") $ toList $ monzo!"transactions" 296 | ["general","entertainment","groceries","eating_out","shopping","expenses","bills","personal_care","cash"] 297 | ``` 298 | 299 | How many transactions did I do in each category? Let's use Data.Map to 300 | histogram that. 301 | 302 | ```haskell 303 | > fromDict $ M.toList $ foldl (\cats cat -> M.insertWith (+) cat 1 cats) mempty $ map (!"category") $ toList $ monzo!"transactions" 304 | { 305 | "personal_care": 2, 306 | "entertainment": 8, 307 | "bills": 3, 308 | "general": 58, 309 | "groceries": 16, 310 | "shopping": 8, 311 | "expenses": 19, 312 | "eating_out": 4, 313 | "cash": 1 314 | } 315 | > 316 | ``` 317 | 318 | Cool! 319 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /dynamic.cabal: -------------------------------------------------------------------------------- 1 | name: dynamic 2 | version: 0.1.0 3 | synopsis: A dynamic type for Haskell 4 | description: Want to do dynamically typed programming in Haskell sometimes? Here you go! 5 | homepage: https://github.com/chrisdone/dynamic#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Chris Done 9 | maintainer: chrisdone@gmail.com 10 | copyright: 2019 Chris Done 11 | category: Development 12 | build-type: Simple 13 | extra-source-files: README.md 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | ghc-options: -Wall 19 | exposed-modules: Dynamic 20 | build-depends: base >= 4.7 && < 5, 21 | aeson, 22 | bytestring, 23 | aeson-pretty, 24 | cassava, 25 | containers, 26 | text, 27 | vector, 28 | unordered-containers, 29 | http-conduit 30 | default-language: Haskell2010 31 | 32 | source-repository head 33 | type: git 34 | location: https://github.com/chrisdone/dynamic 35 | -------------------------------------------------------------------------------- /src/Dynamic.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ViewPatterns #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE DeriveDataTypeable #-} 6 | {-# OPTIONS_GHC -Wall #-} 7 | 8 | -- | Support dynamic typing. 9 | 10 | module Dynamic 11 | ( Dynamic(..) 12 | -- * Accessors 13 | , (!) 14 | , set 15 | , modify 16 | , del 17 | -- * Input 18 | , fromJson 19 | , fromCsv 20 | , fromCsvNamed 21 | , fromJsonFile 22 | , fromCsvFile 23 | , fromCsvFileNamed 24 | , fromList 25 | , fromDict 26 | -- * Ouput 27 | , toJson 28 | , toCsv 29 | , toCsvNamed 30 | , toJsonFile 31 | , toCsvFile 32 | , toDouble 33 | , toInt 34 | , toBool 35 | , toList 36 | , toKeys 37 | , toElems 38 | -- * Web requests 39 | , get 40 | , post 41 | , getJson 42 | , postJson 43 | ) where 44 | 45 | import Control.Arrow ((***)) 46 | import Control.Exception 47 | import qualified Data.Aeson as Aeson 48 | import qualified Data.Aeson.Encode.Pretty as Aeson 49 | import Data.Bifunctor 50 | import Data.ByteString (ByteString) 51 | import qualified Data.ByteString.Lazy as L 52 | import qualified Data.Csv as Csv 53 | import Data.Data 54 | import Data.HashMap.Strict (HashMap) 55 | import qualified Data.HashMap.Strict as HM 56 | import Data.List 57 | import Data.Maybe 58 | import Data.String 59 | import Data.Text (Text) 60 | import qualified Data.Text as T 61 | import qualified Data.Text.Encoding as T 62 | import qualified Data.Text.IO as T 63 | import qualified Data.Text.Read as T 64 | import Data.Vector (Vector) 65 | import qualified Data.Vector as V 66 | import GHC.Generics 67 | import Network.HTTP.Simple 68 | 69 | -- | A dynamic error. 70 | data DynamicException 71 | = DynamicTypeError Text 72 | | ParseError Text 73 | | NoSuchKey Text 74 | | NoSuchIndex Int 75 | deriving (Show, Typeable) 76 | instance Exception DynamicException 77 | 78 | -- | The dynamic type. 79 | data Dynamic 80 | = Dictionary !(HashMap Text Dynamic) 81 | | Array !(Vector Dynamic) 82 | | String !Text 83 | | Double !Double 84 | | Bool !Bool 85 | | Null 86 | deriving (Eq, Typeable, Data, Generic, Ord) 87 | 88 | -------------------------------------------------------------------------------- 89 | -- Class instances 90 | 91 | -- | Dumps it to JSON. 92 | instance Show Dynamic where 93 | show = T.unpack . toJson 94 | 95 | -- | Converts everything to a double. 96 | instance Num Dynamic where 97 | (toDouble -> x) + (toDouble -> y) = Double (x + y) 98 | (toDouble -> x) * (toDouble -> y) = Double (x * y) 99 | abs = Double . abs . toDouble 100 | signum = Double . signum . toDouble 101 | fromInteger = Double . fromInteger 102 | negate = Double . negate . toDouble 103 | 104 | -- | Treats the dynamic as a double. 105 | instance Enum Dynamic where 106 | toEnum = Double . fromIntegral 107 | fromEnum = fromEnum . toDouble 108 | 109 | -- | Implemented via 'toDouble'. 110 | instance Real Dynamic where 111 | toRational = toRational . toDouble 112 | 113 | instance Fractional Dynamic where 114 | fromRational = Double . fromRational 115 | recip = Double . recip . toDouble 116 | 117 | -- | Implemented via 'Double'. 118 | instance Integral Dynamic where 119 | toInteger = toInteger . toInt 120 | quotRem x y = 121 | (Double . fromIntegral *** Double . fromIntegral) 122 | (quotRem (toInt x) (toInt y)) 123 | 124 | -- | Makes a 'String'. 125 | instance IsString Dynamic where 126 | fromString = String . T.pack 127 | 128 | -- | Does what you'd expect. 129 | instance Aeson.FromJSON Dynamic where 130 | parseJSON = 131 | \case 132 | Aeson.Array a -> Array <$> traverse Aeson.parseJSON a 133 | Aeson.Number sci -> pure (Double (realToFrac sci)) 134 | Aeson.Bool v -> pure (Bool v) 135 | Aeson.Null -> pure Null 136 | Aeson.Object hm -> fmap Dictionary (Aeson.parseJSON (Aeson.Object hm)) 137 | Aeson.String s -> pure (String s) 138 | 139 | -- | Pretty much a 1:1 correspondance. 140 | instance Aeson.ToJSON Dynamic where 141 | toJSON = 142 | \case 143 | Dictionary v -> Aeson.toJSON v 144 | Array v -> Aeson.toJSON v 145 | String t -> Aeson.toJSON t 146 | Double t -> Aeson.toJSON t 147 | Bool t -> Aeson.toJSON t 148 | Null -> Aeson.toJSON Aeson.Null 149 | 150 | -- | Produces an array representing a row of columns. 151 | instance Csv.FromRecord Dynamic where 152 | parseRecord xs = Array <$> traverse Csv.parseField xs 153 | 154 | -- | Produces a dictionary representing a row of columns. 155 | instance Csv.FromNamedRecord Dynamic where 156 | parseNamedRecord xs = 157 | Dictionary . HM.fromList . map (first T.decodeUtf8) . HM.toList <$> 158 | traverse Csv.parseField xs 159 | 160 | -- | Tries to figure out decimals, coerce true/false into 'Bool', and 161 | -- null into 'Null'. 162 | instance Csv.FromField Dynamic where 163 | parseField bs = 164 | case T.decimal text of 165 | Left {} -> 166 | case T.toLower (T.strip text) of 167 | "true" -> pure (Bool True) 168 | "false" -> pure (Bool False) 169 | "null" -> pure Null 170 | _ -> asString 171 | Right (v, _) -> pure v 172 | where 173 | text = T.decodeUtf8 bs 174 | asString = pure (String (T.decodeUtf8 bs)) 175 | 176 | -- | Renders the elements of containers, or else a singleton. 177 | instance Csv.ToRecord Dynamic where 178 | toRecord = 179 | \case 180 | Dictionary hm -> V.map Csv.toField (V.fromList (HM.elems hm)) 181 | Array vs -> V.map Csv.toField vs 182 | String s -> V.singleton (T.encodeUtf8 s) 183 | Double d -> V.singleton (Csv.toField d) 184 | Bool d -> V.singleton (Csv.toField (Bool d)) 185 | Null -> mempty 186 | 187 | -- | Just works on dictionaries. 188 | instance Csv.ToNamedRecord Dynamic where 189 | toNamedRecord = 190 | \case 191 | Dictionary hm -> 192 | HM.fromList (map (bimap T.encodeUtf8 Csv.toField) (HM.toList hm)) 193 | _ -> throw (TypeError "Can't make a CSV row out of a non-dictionary") 194 | 195 | -- | Identity for strings, else JSON output. 196 | instance Csv.ToField Dynamic where 197 | toField = 198 | \case 199 | String i -> T.encodeUtf8 i 200 | other -> L.toStrict (Aeson.encode other) 201 | 202 | -- | Nulls are identity, arrays/dicts join, string + double/bool 203 | -- append everything else is @toText x <> toText y@. 204 | instance Semigroup Dynamic where 205 | Null <> x = x 206 | x <> Null = x 207 | Array xs <> Array ys = Array (xs <> ys) 208 | Dictionary x <> Dictionary y = Dictionary (x <> y) 209 | String x <> String y = String (x <> y) 210 | String x <> Double y = String (x <> toText (Double y)) 211 | Double x <> String y = String (toText (Double x) <> y) 212 | String x <> Bool y = String (x <> toText (Bool y)) 213 | Bool x <> String y = String (toText (Bool x) <> y) 214 | -- Everything else 215 | x <> y = String (toText x <> toText y) 216 | 217 | -------------------------------------------------------------------------------- 218 | -- Accessors 219 | 220 | -- | @object ! key@ to access the field at key. 221 | (!) :: Dynamic -> Dynamic -> Dynamic 222 | (!) obj k = 223 | case obj of 224 | Dictionary mp -> 225 | case HM.lookup (toText k) mp of 226 | Nothing -> Null 227 | Just v -> v 228 | Array v -> 229 | case v V.!? toInt k of 230 | Nothing -> Null 231 | Just el -> el 232 | String str -> String (T.take 1 (T.drop (toInt k) str)) 233 | _ -> throw (DynamicTypeError "Can't index this type of value.") 234 | 235 | infixl 9 ! 236 | 237 | -- | @set key value object@ -- set the field's value. 238 | set :: Dynamic -> Dynamic -> Dynamic -> Dynamic 239 | set k v obj = 240 | case obj of 241 | Dictionary mp -> Dictionary (HM.insert (toText k) v mp) 242 | _ -> throw (DynamicTypeError "Not an object!") 243 | 244 | -- | @modify k f obj@ -- modify the value at key. 245 | modify :: Dynamic -> (Dynamic -> Dynamic) -> Dynamic -> Dynamic 246 | modify k f obj = 247 | case obj of 248 | Dictionary mp -> Dictionary (HM.adjust f (toText k) mp) 249 | _ -> throw (DynamicTypeError "Not an object!") 250 | 251 | -- | @del k obj@ -- delete the key k in obj. 252 | del :: Dynamic -> Dynamic -> Dynamic 253 | del k obj = 254 | case obj of 255 | Dictionary mp -> Dictionary (HM.delete (toText k) mp) 256 | _ -> throw (DynamicTypeError "Not an object!") 257 | 258 | -------------------------------------------------------------------------------- 259 | -- Output 260 | 261 | toString :: Dynamic -> String 262 | toString = T.unpack . toText 263 | 264 | toByteString :: Dynamic -> ByteString 265 | toByteString = T.encodeUtf8 . toText 266 | 267 | -- | Convert to string if string, or else JSON encoding. 268 | toText :: Dynamic -> Text 269 | toText = 270 | \case 271 | String s -> s 272 | orelse -> toJson orelse 273 | 274 | -- | Convert a dynamic value to a Double. 275 | toDouble :: Dynamic -> Double 276 | toDouble = 277 | \case 278 | String t -> 279 | case T.double t of 280 | Left {} -> 281 | throw (DynamicTypeError ("Couldn't treat string as number: " <> t)) 282 | Right (v, _) -> v 283 | Double d -> d 284 | Bool {} -> throw (DynamicTypeError "Can't treat bool as number.") 285 | Null -> 0 286 | Dictionary {} -> 287 | throw (DynamicTypeError "Can't treat dictionary as number.") 288 | Array {} -> throw (DynamicTypeError "Can't treat array as number.") 289 | 290 | -- | Convert a dynamic value to an Int. 291 | toInt :: Dynamic -> Int 292 | toInt = floor . toDouble 293 | 294 | -- | Produces a JSON representation of the string. 295 | toJson :: Dynamic -> Text 296 | toJson = T.decodeUtf8 . L.toStrict . Aeson.encodePretty 297 | 298 | -- | Produces a JSON representation of the string. 299 | toJsonFile :: FilePath -> Dynamic -> IO () 300 | toJsonFile fp = L.writeFile fp . Aeson.encodePretty 301 | 302 | -- | Produces a JSON representation of the string. 303 | toCsv :: [Dynamic] -> Text 304 | toCsv = T.decodeUtf8 . L.toStrict . Csv.encode 305 | 306 | -- | Produces a JSON representation of the string. 307 | toCsvFile :: FilePath -> [Dynamic] -> IO () 308 | toCsvFile fp = L.writeFile fp . Csv.encode 309 | 310 | -- | Produces a JSON representation of the string. 311 | toCsvNamed :: [Dynamic] -> Text 312 | toCsvNamed xs = rows xs 313 | where 314 | rows = T.decodeUtf8 . L.toStrict . Csv.encodeByName (makeHeader xs) 315 | makeHeader rs = 316 | case rs of 317 | (Dictionary hds:_) -> V.fromList (map T.encodeUtf8 (HM.keys hds)) 318 | _ -> mempty 319 | 320 | -- | Convert to a boolean. 321 | toBool :: Dynamic -> Bool 322 | toBool = 323 | \case 324 | Dictionary m -> not (HM.null m) 325 | Array v -> not (V.null v) 326 | Bool b -> b 327 | Double 0 -> False 328 | Double {} -> True 329 | Null -> False 330 | String text -> 331 | case T.toLower (T.strip text) of 332 | "true" -> True 333 | "false" -> False 334 | _ -> not (T.null text) 335 | 336 | -- | Convert to a list. 337 | toList :: Dynamic -> [Dynamic] 338 | toList = 339 | \case 340 | Array v -> V.toList v 341 | Dictionary kvs -> 342 | map 343 | (\(k, v) -> Dictionary (HM.fromList [("key", String k), ("value", v)])) 344 | (HM.toList kvs) 345 | rest -> [rest] 346 | 347 | -- | Get all the keys. 348 | toKeys :: Dynamic -> [Dynamic] 349 | toKeys = 350 | \case 351 | Array v -> V.toList v 352 | Dictionary kvs -> map String (HM.keys kvs) 353 | rest -> [rest] 354 | 355 | -- | Get all the elems. 356 | toElems :: Dynamic -> [Dynamic] 357 | toElems = 358 | \case 359 | Array v -> V.toList v 360 | Dictionary kvs -> HM.elems kvs 361 | rest -> [rest] 362 | 363 | -------------------------------------------------------------------------------- 364 | -- Input 365 | 366 | -- | Read JSON into a Dynamic. 367 | fromJson :: Text -> Dynamic 368 | fromJson = 369 | fromMaybe (throw (ParseError "Unable to parse JSON.")) . 370 | Aeson.decode . L.fromStrict . T.encodeUtf8 371 | 372 | -- | Read CSV into a list of rows with columns (don't use column names). 373 | fromCsv :: Text -> [[Dynamic]] 374 | fromCsv = 375 | V.toList . 376 | either (const (throw (ParseError "Unable to parse CSV."))) id . 377 | Csv.decode Csv.NoHeader . L.fromStrict . T.encodeUtf8 378 | 379 | -- | Read CSV into a list of rows (use column names). 380 | fromCsvNamed :: Text -> [Dynamic] 381 | fromCsvNamed = 382 | V.toList . 383 | either (const (throw (ParseError "Unable to parse CSV."))) snd . 384 | Csv.decodeByName . L.fromStrict . T.encodeUtf8 385 | 386 | -- | Same as 'fromJson' but from a file. 387 | fromJsonFile :: FilePath -> IO Dynamic 388 | fromJsonFile = fmap fromJson . T.readFile 389 | 390 | -- | Same as 'fromCsv' but from a file. 391 | fromCsvFile :: FilePath -> IO [[Dynamic]] 392 | fromCsvFile = fmap fromCsv . T.readFile 393 | 394 | -- | Same as 'fromCsvFileNamed' but from a file. 395 | fromCsvFileNamed :: FilePath -> IO [Dynamic] 396 | fromCsvFileNamed = fmap fromCsvNamed . T.readFile 397 | 398 | -- | Convert a list of dynamics to a dynamic list. 399 | fromList :: [Dynamic] -> Dynamic 400 | fromList = Array . V.fromList 401 | 402 | -- | Convert a list of key/pairs to a dynamic dictionary. 403 | fromDict :: [(Dynamic, Dynamic)] -> Dynamic 404 | fromDict hm = Dictionary (HM.fromList (map (bimap toText id) hm)) 405 | 406 | -------------------------------------------------------------------------------- 407 | -- Web helpers 408 | 409 | -- | HTTP GET request for text content. 410 | get :: 411 | Dynamic 412 | -> [(Dynamic, Dynamic)] -- ^ Headers. 413 | -> IO Text 414 | get url headers = do 415 | response <- 416 | httpBS 417 | (foldl' 418 | (\r (k, v) -> 419 | addRequestHeader (fromString (toString k)) (toByteString v) r) 420 | (addRequestHeader 421 | "User-Agent" 422 | "haskell-dynamic" 423 | (fromString (toString url))) 424 | headers) 425 | pure (T.decodeUtf8 (getResponseBody response)) 426 | 427 | -- | HTTP GET request for text content. 428 | getJson :: 429 | Dynamic 430 | -> [(Dynamic, Dynamic)] -- ^ Headers. 431 | -> IO Dynamic 432 | getJson url headers = fmap fromJson (get url headers) 433 | 434 | -- | HTTP POST request for text content. 435 | post :: 436 | Dynamic -- ^ URL. 437 | -> [(Dynamic, Dynamic)] -- ^ Headers. 438 | -> Dynamic -- ^ Body. 439 | -> IO Text 440 | post url headers body = do 441 | response <- 442 | httpBS 443 | (foldl' 444 | (\r (k, v) -> 445 | addRequestHeader (fromString (toString k)) (toByteString v) r) 446 | (addRequestHeader 447 | "User-Agent" 448 | "haskell-dynamic" 449 | (setRequestMethod 450 | "POST" 451 | (setRequestBodyJSON body (fromString (toString url))))) 452 | headers) 453 | pure (T.decodeUtf8 (getResponseBody response)) 454 | 455 | -- | HTTP POST request for JSON content. 456 | postJson :: 457 | Dynamic -- ^ URL. 458 | -> [(Dynamic, Dynamic)] -- ^ Headers. 459 | -> Dynamic -- ^ Body. 460 | -> IO Dynamic 461 | postJson url headers body = fmap fromJson (post url headers body) 462 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # resolver: ghcjs-0.1.0_ghc-7.10.2 15 | # 16 | # The location of a snapshot can be provided as a file or url. Stack assumes 17 | # a snapshot provided as a file might change, whereas a url resource does not. 18 | # 19 | # resolver: ./custom-snapshot.yaml 20 | # resolver: https://example.com/snapshots/2018-01-01.yaml 21 | resolver: lts-12.12 22 | 23 | # User packages to be built. 24 | # Various formats can be used as shown in the example below. 25 | # 26 | # packages: 27 | # - some-directory 28 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 29 | # - location: 30 | # git: https://github.com/commercialhaskell/stack.git 31 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 32 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 33 | # subdirs: 34 | # - auto-update 35 | # - wai 36 | packages: 37 | - . 38 | # Dependency packages to be pulled from upstream that are not in the resolver 39 | # using the same syntax as the packages field. 40 | # (e.g., acme-missiles-0.3) 41 | # extra-deps: [] 42 | 43 | # Override default flag values for local packages and extra-deps 44 | # flags: {} 45 | 46 | # Extra package databases containing global packages 47 | # extra-package-dbs: [] 48 | 49 | # Control whether we use the GHC we find on the path 50 | # system-ghc: true 51 | # 52 | # Require a specific version of stack, using version ranges 53 | # require-stack-version: -any # Default 54 | # require-stack-version: ">=1.8" 55 | # 56 | # Override the architecture used by stack, especially useful on Windows 57 | # arch: i386 58 | # arch: x86_64 59 | # 60 | # Extra directories used by stack for building 61 | # extra-include-dirs: [/path/to/dir] 62 | # extra-lib-dirs: [/path/to/dir] 63 | # 64 | # Allow a newer minor version of GHC than the snapshot specifies 65 | # compiler-check: newer-minor 66 | --------------------------------------------------------------------------------