dynamic (empty) → 0.0.1
raw patch · 5 files changed
+642/−0 lines, 5 filesdep +aesondep +aeson-prettydep +basesetup-changed
Dependencies added: aeson, aeson-pretty, base, bytestring, cassava, containers, text, unordered-containers, vector
Files
- LICENSE +30/−0
- README.md +201/−0
- Setup.hs +2/−0
- dynamic.cabal +33/−0
- src/Dynamic.hs +376/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Chris Done (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,201 @@+# dynamic++Finally, dynamically typed programming in Haskell made easy!++## Introduction++Tired of making data types in your Haskell programs just to read and+manipulate basic JSON/CSV files? Tired of writing imports? Use+`dynamic`, dynamically typed programming for Haskell!++## Load it up++Launch `ghci`, the interactive REPL for Haskell.++> import Dynamic++Now you're ready for dynamicness!++## Make dynamic values as easy as pie!++Primitive values are easy via regular literals:++``` haskell+> 1+1+> "Hello, World!"+"Hello, World!"+```++Arrays and objects have handy functions to make them:++``` haskell+> fromList [1,2]+[+ 1,+ 2+]+> fromDict [ ("k", 1), ("v", 2) ]+{+ "k": 1,+ "v": 2+}+```++Get object keys or array or string indexes via `!`:++``` haskell+> fromDict [ ("k", 1), ("v", 2) ] ! "k"+1+> fromList [1,2] ! 1+2+> "foo" ! 2+"o"+```++## Web requests!++```json+> chris <- getJson "https://api.github.com/users/chrisdone"+> chris+{+ "bio": null,+ "email": null,+ "public_gists": 176,+ "repos_url": "https://api.github.com/users/chrisdone/repos",+ "node_id": "MDQ6VXNlcjExMDE5",+ "following_url": "https://api.github.com/users/chrisdone/following{/other_user}",+ "location": "England",+ "url": "https://api.github.com/users/chrisdone",+ "gravatar_id": "",+ "blog": "https://chrisdone.com",+ "gists_url": "https://api.github.com/users/chrisdone/gists{/gist_id}",+ "following": 0,+ "hireable": null,+ "organizations_url": "https://api.github.com/users/chrisdone/orgs",+ "subscriptions_url": "https://api.github.com/users/chrisdone/subscriptions",+ "name": "Chris Done",+ "company": "FP Complete @fpco ",+ "updated_at": "2019-02-22T11:11:18Z",+ "created_at": "2008-05-21T10:29:09Z",+ "followers": 1095,+ "id": 11019,+ "public_repos": 144,+ "avatar_url": "https://avatars3.githubusercontent.com/u/11019?v=4",+ "type": "User",+ "events_url": "https://api.github.com/users/chrisdone/events{/privacy}",+ "starred_url": "https://api.github.com/users/chrisdone/starred{/owner}{/repo}",+ "login": "chrisdone",+ "received_events_url": "https://api.github.com/users/chrisdone/received_events",+ "site_admin": false,+ "html_url": "https://github.com/chrisdone",+ "followers_url": "https://api.github.com/users/chrisdone/followers"+}+```++## Trivially read CSV files!++``` haskell+> fromCsvNamed "name,age,alive,partner\nabc,123,true,null\nabc,ok,true,true"+[{+ "alive": true,+ "age": 123,+ "partner": null,+ "name": "abc"+},{+ "alive": true,+ "age": "ok",+ "partner": true,+ "name": "abc"+}]+```++## Dynamically typed programming!++Just write code like you do in Python or JavaScript:++```haskell+> if chris!"followers" > 500 then chris!"public_gists" * 5 else chris!"name"+880+```++## Experience the wonders of dynamic type errors!++Try to treat non-numbers as numbers and you get the expected result:++``` haskell+> map (\o -> o ! "age" * 2) $ fromCsvNamed "name,age,alive,partner\nabc,123,true,null\nabc,ok,true,true"+[246,*** Exception: DynamicTypeError "Couldn't treat string as number: ok"+```++Laziness makes everything better!+++``` haskell+> map (*2) $ toList $ fromJson "[\"1\",true,123]"+[2,*** Exception: DynamicTypeError "Can't treat bool as number."+```++Woops...++``` haskell+> map (*2) $ toList $ fromJson "[\"1\",123]"+[2,246]+```++That's better!++## Modifying and updating records++Use `modify` or `set` to massage data into something more palatable.++``` haskell+> modify "followers" (*20) chris+{+ "bio": null,+ "email": null,+ "public_gists": 176,+ "repos_url": "https://api.github.com/users/chrisdone/repos",+ "node_id": "MDQ6VXNlcjExMDE5",+ "following_url": "https://api.github.com/users/chrisdone/following{/other_user}",+ "location": "England",+ "url": "https://api.github.com/users/chrisdone",+ "gravatar_id": "",+ "blog": "https://chrisdone.com",+ "gists_url": "https://api.github.com/users/chrisdone/gists{/gist_id}",+ "following": 0,+ "hireable": null,+ "organizations_url": "https://api.github.com/users/chrisdone/orgs",+ "subscriptions_url": "https://api.github.com/users/chrisdone/subscriptions",+ "name": "Chris Done",+ "company": "FP Complete @fpco ",+ "updated_at": "2019-02-22T11:11:18Z",+ "created_at": "2008-05-21T10:29:09Z",+ "followers": 21900,+ "id": 11019,+ "public_repos": 144,+ "avatar_url": "https://avatars3.githubusercontent.com/u/11019?v=4",+ "type": "User",+ "events_url": "https://api.github.com/users/chrisdone/events{/privacy}",+ "starred_url": "https://api.github.com/users/chrisdone/starred{/owner}{/repo}",+ "login": "chrisdone",+ "received_events_url": "https://api.github.com/users/chrisdone/received_events",+ "site_admin": false,+ "html_url": "https://github.com/chrisdone",+ "followers_url":+ "https://api.github.com/users/chrisdone/followers"+}+```++## List of numbers?++The answer is: Yes, Haskell can do that!++``` haskell+> [1.. 5] :: [Dynamic]+[1,2,3,4,5]+```++## Coming soon++Monoid instances so we can append `Dynamic`s together!
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ dynamic.cabal view
@@ -0,0 +1,33 @@+name: dynamic+version: 0.0.1+synopsis: A dynamic type for Haskell+description: Want to do dynamically typed programming in Haskell sometimes? Here you go!+homepage: https://github.com/chrisdone/dynamic#readme+license: BSD3+license-file: LICENSE+author: Chris Done+maintainer: chrisdone@gmail.com+copyright: 2019 Chris Done+category: Development+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ ghc-options: -Wall+ exposed-modules: Dynamic+ build-depends: base >= 4.7 && < 5,+ aeson,+ bytestring,+ aeson-pretty,+ cassava,+ containers,+ text,+ vector,+ unordered-containers+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/chrisdone/dynamic
+ src/Dynamic.hs view
@@ -0,0 +1,376 @@+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# OPTIONS_GHC -Wall #-}++-- | Support dynamic typing.++module Dynamic+ ( Dynamic(..)+ -- * Accessors+ , (!)+ , set+ , modify+ -- * Input+ , fromJson+ , fromCsv+ , fromCsvNamed+ , fromJsonFile+ , fromCsvFile+ , fromCsvFileNamed+ , fromList+ , fromDict+ -- * Ouput+ , toJson+ , toCsv+ , toCsvNamed+ , toJsonFile+ , toCsvFile+ , toDouble+ , toInt+ , toBool+ , toList+ , toKeys+ , toElems+ -- * Web requests+ , get+ , getJson+ , postJson+ ) where++import Control.Arrow ((***))+import Control.Exception+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Encode.Pretty as Aeson+import Data.Bifunctor+import qualified Data.ByteString.Lazy as L+import qualified Data.Csv as Csv+import Data.Data+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM+import Data.Maybe+import Data.String+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T+import qualified Data.Text.Read as T+import Data.Vector (Vector)+import qualified Data.Vector as V+import GHC.Generics+import Network.HTTP.Simple++-- | A dynamic error.+data DynamicException+ = DynamicTypeError Text+ | ParseError Text+ | NoSuchKey Text+ | NoSuchIndex Int+ deriving (Show, Typeable)+instance Exception DynamicException++-- | The dynamic type.+data Dynamic+ = Dictionary !(HashMap Text Dynamic)+ | Array !(Vector Dynamic)+ | String !Text+ | Double !Double+ | Bool !Bool+ | Null+ deriving (Eq, Typeable, Data, Generic, Ord)++--------------------------------------------------------------------------------+-- Class instances++instance Show Dynamic where+ show = T.unpack . toJson++instance Num Dynamic where+ (toDouble -> x) + (toDouble -> y) = Double (x + y)+ (toDouble -> x) * (toDouble -> y) = Double (x * y)+ abs = Double . abs . toDouble+ signum = Double . signum . toDouble+ fromInteger = Double . fromInteger+ negate = Double . negate . toDouble++instance Enum Dynamic where+ toEnum = Double . fromIntegral+ fromEnum = fromEnum . toDouble++instance Real Dynamic where+ toRational = toRational . toDouble++instance Integral Dynamic where+ toInteger = toInteger . toInt+ quotRem x y =+ (Double . fromIntegral *** Double . fromIntegral)+ (quotRem (toInt x) (toInt y))++instance IsString Dynamic where+ fromString = String . T.pack++instance Aeson.FromJSON Dynamic where+ parseJSON =+ \case+ Aeson.Array a -> Array <$> traverse Aeson.parseJSON a+ Aeson.Number sci -> pure (Double (realToFrac sci))+ Aeson.Bool v -> pure (Bool v)+ Aeson.Null -> pure Null+ Aeson.Object hm -> fmap Dictionary (Aeson.parseJSON (Aeson.Object hm))+ Aeson.String s -> pure (String s)++instance Aeson.ToJSON Dynamic where+ toJSON =+ \case+ Dictionary v -> Aeson.toJSON v+ Array v -> Aeson.toJSON v+ String t -> Aeson.toJSON t+ Double t -> Aeson.toJSON t+ Bool t -> Aeson.toJSON t+ Null -> Aeson.toJSON Aeson.Null++instance Csv.FromRecord Dynamic where+ parseRecord xs = Array <$> traverse Csv.parseField xs++instance Csv.FromNamedRecord Dynamic where+ parseNamedRecord xs =+ Dictionary . HM.fromList . map (first T.decodeUtf8) . HM.toList <$>+ traverse Csv.parseField xs++instance Csv.FromField Dynamic where+ parseField bs =+ case T.decimal text of+ Left {} ->+ case T.toLower (T.strip text) of+ "true" -> pure (Bool True)+ "false" -> pure (Bool False)+ "null" -> pure Null+ _ -> asString+ Right (v, _) -> pure v+ where+ text = T.decodeUtf8 bs+ asString = pure (String (T.decodeUtf8 bs))++instance Csv.ToRecord Dynamic where+ toRecord =+ \case+ Dictionary hm -> V.map Csv.toField (V.fromList (HM.elems hm))+ Array vs -> V.map Csv.toField vs+ String s -> V.singleton (T.encodeUtf8 s)+ Double d -> V.singleton (Csv.toField d)+ Bool d -> V.singleton (Csv.toField (Bool d))+ Null -> mempty++instance Csv.ToNamedRecord Dynamic where+ toNamedRecord =+ \case+ Dictionary hm ->+ HM.fromList (map (bimap T.encodeUtf8 Csv.toField) (HM.toList hm))+ _ -> throw (TypeError "Can't make a CSV row out of a non-dictionary")++instance Csv.ToField Dynamic where+ toField =+ \case+ String i -> T.encodeUtf8 i+ other -> L.toStrict (Aeson.encode other)++--------------------------------------------------------------------------------+-- Accessors++-- | object!key to access the field at key.+(!) :: Dynamic -> Dynamic -> Dynamic+(!) obj k =+ case obj of+ Dictionary mp ->+ case HM.lookup (toText k) mp of+ Nothing -> Null+ Just v -> v+ Array v ->+ case v V.!? toInt k of+ Nothing -> Null+ Just el -> el+ String str -> String (T.take 1 (T.drop (toInt k) str))+ _ -> throw (DynamicTypeError "Can't index this type of value.")++infixr 9 !++-- | set key value object -- set the field's value.+set :: Dynamic -> Dynamic -> Dynamic -> Dynamic+set k v obj =+ case obj of+ Dictionary mp -> Dictionary (HM.insert (toText k) v mp)+ _ -> throw (DynamicTypeError "Not an object!")++-- | modify k f obj -- modify the value at key.+modify :: Dynamic -> (Dynamic -> Dynamic) -> Dynamic -> Dynamic+modify k f obj =+ case obj of+ Dictionary mp -> Dictionary (HM.adjust f (toText k) mp)+ _ -> throw (DynamicTypeError "Not an object!")++--------------------------------------------------------------------------------+-- Output++-- | Convert to string if string, or else JSON encoding.+toText :: Dynamic -> Text+toText =+ \case+ String s -> s+ orelse -> toJson orelse++-- | Convert a dynamic value to a Double.+toDouble :: Dynamic -> Double+toDouble =+ \case+ String t ->+ case T.double t of+ Left {} ->+ throw (DynamicTypeError ("Couldn't treat string as number: " <> t))+ Right (v, _) -> v+ Double d -> d+ Bool {} -> throw (DynamicTypeError "Can't treat bool as number.")+ Null -> 0+ Dictionary {} ->+ throw (DynamicTypeError "Can't treat dictionary as number.")+ Array {} -> throw (DynamicTypeError "Can't treat array as number.")++-- | Convert a dynamic value to an Int.+toInt :: Dynamic -> Int+toInt = floor . toDouble++-- | Produces a JSON representation of the string.+toJson :: Dynamic -> Text+toJson = T.decodeUtf8 . L.toStrict . Aeson.encodePretty++-- | Produces a JSON representation of the string.+toJsonFile :: FilePath -> Dynamic -> IO ()+toJsonFile fp = L.writeFile fp . Aeson.encodePretty++-- | Produces a JSON representation of the string.+toCsv :: [Dynamic] -> Text+toCsv = T.decodeUtf8 . L.toStrict . Csv.encode++-- | Produces a JSON representation of the string.+toCsvFile :: FilePath -> [Dynamic] -> IO ()+toCsvFile fp = L.writeFile fp . Csv.encode++-- | Produces a JSON representation of the string.+toCsvNamed :: [Dynamic] -> Text+toCsvNamed xs = rows xs+ where+ rows = T.decodeUtf8 . L.toStrict . Csv.encodeByName (makeHeader xs)+ makeHeader rs =+ case rs of+ (Dictionary hds:_) -> V.fromList (map T.encodeUtf8 (HM.keys hds))+ _ -> mempty++-- | Convert to a boolean.+toBool :: Dynamic -> Bool+toBool =+ \case+ Dictionary m -> not (HM.null m)+ Array v -> not (V.null v)+ Bool b -> b+ Double 0 -> False+ Double {} -> True+ Null -> False+ String text ->+ case T.toLower (T.strip text) of+ "true" -> True+ "false" -> False+ _ -> not (T.null text)++-- | Convert to a list.+toList :: Dynamic -> [Dynamic]+toList =+ \case+ Array v -> V.toList v+ Dictionary kvs ->+ map+ (\(k, v) -> Dictionary (HM.fromList [("key", String k), ("value", v)]))+ (HM.toList kvs)+ rest -> [rest]++-- | Get all the keys.+toKeys :: Dynamic -> [Dynamic]+toKeys =+ \case+ Array v -> V.toList v+ Dictionary kvs -> map String (HM.keys kvs)+ rest -> [rest]++-- | Get all the elems.+toElems :: Dynamic -> [Dynamic]+toElems =+ \case+ Array v -> V.toList v+ Dictionary kvs -> HM.elems kvs+ rest -> [rest]++--------------------------------------------------------------------------------+-- Input++fromJson :: Text -> Dynamic+fromJson =+ fromMaybe (throw (ParseError "Unable to parse JSON.")) .+ Aeson.decode . L.fromStrict . T.encodeUtf8++fromCsv :: Text -> [[Dynamic]]+fromCsv =+ V.toList .+ either (const (throw (ParseError "Unable to parse CSV."))) id .+ Csv.decode Csv.NoHeader . L.fromStrict . T.encodeUtf8++fromCsvNamed :: Text -> [Dynamic]+fromCsvNamed =+ V.toList .+ either (const (throw (ParseError "Unable to parse CSV."))) snd .+ Csv.decodeByName . L.fromStrict . T.encodeUtf8++fromJsonFile :: FilePath -> IO Dynamic+fromJsonFile = fmap fromJson . T.readFile++fromCsvFile :: FilePath -> IO [[Dynamic]]+fromCsvFile = fmap fromCsv . T.readFile++fromCsvFileNamed :: FilePath -> IO [Dynamic]+fromCsvFileNamed = fmap fromCsvNamed . T.readFile++fromList :: [Dynamic] -> Dynamic+fromList = Array . V.fromList++fromDict :: [(Dynamic, Dynamic)] -> Dynamic+fromDict hm = Dictionary (HM.fromList (map (bimap toText id) hm))++--------------------------------------------------------------------------------+-- Helpers++-- | HTTP request for text content.+get :: Dynamic -> IO Text+get url = do+ response <-+ httpBS+ (addRequestHeader+ "User-Agent"+ "haskell-dynamic"+ (fromString (T.unpack (toText url))))+ pure (T.decodeUtf8 (getResponseBody response))++-- | HTTP request for text content.+getJson :: Dynamic -> IO Dynamic+getJson = fmap fromJson . get++-- | HTTP request for text content.+postJson :: Dynamic -> Dynamic -> IO Text+postJson url body = do+ response <-+ httpBS+ (addRequestHeader+ "User-Agent"+ "haskell-dynamic"+ (setRequestMethod+ "POST"+ (setRequestBodyJSON body (fromString (T.unpack (toText url))))))+ pure (T.decodeUtf8 (getResponseBody response))