derulo (empty) → 0.0.0

raw patch · 8 files changed

+573/−0 lines, 8 filesdep +basedep +derulodep +doctestsetup-changed

Dependencies added: base, derulo, doctest

Files

CHANGELOG.markdown +7/−0
LICENSE.markdown +21/−0
README.markdown +3/−0
Setup.hs +4/−0
derulo.cabal +49/−0
executables/Main.hs +5/−0
library/Derulo.hs +480/−0
tests/Main.hs +4/−0

+ CHANGELOG.markdown view

@@ -0,0 +1,7 @@+# Change log
+
+Derulo uses [Semantic Versioning][].
+The change log is available through the [releases on GitHub][].
+
+[Semantic Versioning]: http://semver.org/spec/v2.0.0.html
+[releases on GitHub]: https://github.com/tfausak/derulo/releases

+ LICENSE.markdown view

@@ -0,0 +1,21 @@+# [The MIT License](https://opensource.org/licenses/MIT)
+
+Copyright 2017 Taylor Fausak
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the "Software"), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to do
+so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

+ README.markdown view

@@ -0,0 +1,3 @@+# Derulo
+
+Derulo parses and renders JSON simply.

+ Setup.hs view

@@ -0,0 +1,4 @@+import qualified Distribution.Simple as Cabal++main :: IO ()+main = Cabal.defaultMain

+ derulo.cabal view

@@ -0,0 +1,49 @@+-- This file has been generated from package.yaml by hpack version 0.17.1.+--+-- see: https://github.com/sol/hpack++name:           derulo+version:        0.0.0+synopsis:       Parse and render JSON simply.+description:    Derulo parses and renders JSON simply.+category:       JSON+maintainer:     Taylor Fausak+license:        MIT+license-file:   LICENSE.markdown+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    CHANGELOG.markdown+    README.markdown++library+  hs-source-dirs:+      library+  ghc-options: -Wall+  build-depends:+      base >=4.9.1 && <4.10+  exposed-modules:+      Derulo+  default-language: Haskell2010++executable derulo+  main-is: Main.hs+  hs-source-dirs:+      executables+  ghc-options: -Wall -rtsopts -threaded+  build-depends:+      base >=4.9.1 && <4.10+    , derulo+  default-language: Haskell2010++test-suite test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      tests+  ghc-options: -Wall -rtsopts -threaded+  build-depends:+      base >=4.9.1 && <4.10+    , doctest >=0.11.4 && <0.12+  default-language: Haskell2010

+ executables/Main.hs view

@@ -0,0 +1,5 @@+import qualified Data.Maybe as Maybe+import qualified Derulo++main :: IO ()+main = interact (Derulo.showJSON . Maybe.fromJust . Derulo.readJSON)

+ library/Derulo.hs view

@@ -0,0 +1,480 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}++-- | Derulo parses and renders JSON simply. It aims to provide an RFC 7159+-- compliant parser and renderer without incurring any dependencies. It is+-- intended to be used either for learning or in situations where dependencies+-- are unwanted. In normal usage, prefer a faster, more robust library like+-- [Aeson](https://hackage.haskell.org/package/aeson).+--+-- Derulo does not export any identifiers that conflict with the prelude and+-- can be imported unqualified.+--+-- >>> import Derulo+--+-- Use 'readJSON' to parse a 'String' into a 'JSON' value.+--+-- >>> readJSON " null "+-- Just Null+--+-- Use 'showJSON' to render a 'JSON' value as a 'String'.+--+-- >>> showJSON Null+-- "null"+module Derulo where++import qualified Control.Monad as Monad+import qualified Data.Data as Data+import qualified Data.Functor as Functor+import qualified Data.List as List+import qualified Data.Maybe as Maybe+import qualified GHC.Generics as Generics+import qualified Text.ParserCombinators.ReadP as ReadP++-- * Types+-- | A JSON value as described by RFC 7159.+data JSON+  = Null+  | Boolean Bool+  | Number Integer+           Integer+  | String String+  | Array [JSON]+  | Object [(String, JSON)]+  deriving (Data.Data, Eq, Generics.Generic, Ord, Read, Show, Data.Typeable)++-- * Parsing+-- | Parses a string as JSON.+--+-- >>> readJSON "null"+-- Just Null+--+-- >>> readJSON "true"+-- Just (Boolean True)+-- >>> readJSON "false"+-- Just (Boolean False)+--+-- >>> readJSON "0e0"+-- Just (Number 0 0)+-- >>> readJSON "12e34"+-- Just (Number 12 34)+-- >>> readJSON "-12e-34"+-- Just (Number (-12) (-34))+--+-- >>> readJSON "\"\""+-- Just (String "")+-- >>> readJSON "\"js\""+-- Just (String "js")+-- >>> readJSON "\"\\\"\\\\\\b\\f\\n\\r\\t\""+-- Just (String "\"\\\b\f\n\r\t")+-- >>> readJSON "\"\\u001f\""+-- Just (String "\US")+--+-- >>> readJSON "[]"+-- Just (Array [])+-- >>> readJSON "[null]"+-- Just (Array [Null])+-- >>> readJSON "[true,false]"+-- Just (Array [Boolean True,Boolean False])+--+-- >>> readJSON "{}"+-- Just (Object [])+-- >>> readJSON "{\"\":null}"+-- Just (Object [("",Null)])+-- >>> readJSON "{\"t\":true,\"f\":false}"+-- Just (Object [("t",Boolean True),("f",Boolean False)])+readJSON :: String -> Maybe JSON+readJSON string = runParser pJSON string++pJSON :: ReadP.ReadP JSON+pJSON = do+  pWhitespaces+  value <- pValue+  ReadP.eof+  pure value++pValue :: ReadP.ReadP JSON+pValue = ReadP.choice [pNull, pBoolean, pNumber, pString, pArray, pObject]++pNull :: ReadP.ReadP JSON+pNull = do+  pSymbol "null"+  pure Null++pBoolean :: ReadP.ReadP JSON+pBoolean = pTrue ReadP.+++ pFalse++pTrue :: ReadP.ReadP JSON+pTrue = do+  pSymbol "true"+  pure (Boolean True)++pFalse :: ReadP.ReadP JSON+pFalse = do+  pSymbol "false"+  pure (Boolean False)++pNumber :: ReadP.ReadP JSON+pNumber = do+  integer <- pInteger+  (fraction, precision) <- ReadP.option (0, 0) pFraction+  power <- ReadP.option 0 pPower+  pWhitespaces+  let mantissa = integer * 10 ^ precision + negateIf (integer <= 0) fraction+  let magnitude = power - precision+  pure (Number mantissa magnitude)++pInteger :: ReadP.ReadP Integer+pInteger = pZero ReadP.+++ pNonZero++pZero :: ReadP.ReadP Integer+pZero = do+  ReadP.optional (ReadP.char '-')+  Functor.void (ReadP.char '0')+  pure 0++pNonZero :: ReadP.ReadP Integer+pNonZero = do+  sign <- ReadP.option '+' (ReadP.char '-')+  first <- ReadP.satisfy isNonZeroDigit+  rest <- ReadP.munch isDecimalDigit+  case fromDecimal (first : rest) of+    Nothing -> ReadP.pfail+    Just nonZero -> pure (negateIf (sign == '-') nonZero)++pFraction :: ReadP.ReadP (Integer, Integer)+pFraction = do+  Functor.void (ReadP.char '.')+  digits <- ReadP.munch1 isDecimalDigit+  case fromDecimal digits of+    Nothing -> ReadP.pfail+    Just fraction -> pure (fraction, List.genericLength digits)++pPower :: ReadP.ReadP Integer+pPower = do+  Functor.void (ReadP.char 'E' ReadP.+++ ReadP.char 'e')+  sign <- ReadP.option '+' (ReadP.char '+' ReadP.+++ ReadP.char '-')+  digits <- ReadP.munch1 isDecimalDigit+  case fromDecimal digits of+    Nothing -> ReadP.pfail+    Just magnitude -> pure (negateIf (sign == '-') magnitude)++pString :: ReadP.ReadP JSON+pString = do+  string <-+    ReadP.between+      (ReadP.char '"')+      (ReadP.char '"')+      (do characters <- ReadP.many pCharacter+          pure (String characters))+  pWhitespaces+  pure string++pCharacter :: ReadP.ReadP Char+pCharacter = pLiteral ReadP.+++ pEscape++pLiteral :: ReadP.ReadP Char+pLiteral = ReadP.satisfy isLiteral++pEscape :: ReadP.ReadP Char+pEscape = do+  Functor.void (ReadP.char '\\')+  escape <- ReadP.get+  case escape of+    '"' -> pure '"'+    '/' -> pure '/'+    '\\' -> pure '\\'+    'b' -> pure '\b'+    'f' -> pure '\f'+    'n' -> pure '\n'+    'r' -> pure '\r'+    't' -> pure '\t'+    'u' -> do+      digits <- ReadP.count 4 (ReadP.satisfy isHexadecimalDigit)+      case fromHexadecimal digits of+        Nothing -> ReadP.pfail+        Just point -> pure (toEnum (fromIntegral point))+    _ -> ReadP.pfail++pArray :: ReadP.ReadP JSON+pArray =+  ReadP.between+    (pSymbol "[")+    (pSymbol "]")+    (do values <- ReadP.sepBy pValue (pSymbol ",")+        pure (Array values))++pObject :: ReadP.ReadP JSON+pObject =+  ReadP.between+    (pSymbol "{")+    (pSymbol "}")+    (do pairs <- ReadP.sepBy pPair (pSymbol ",")+        pure (Object pairs))++pPair :: ReadP.ReadP (String, JSON)+pPair = do+  String key <- pString+  pSymbol ":"+  value <- pValue+  pure (key, value)++-- * Rendering+-- | Renders JSON as a string.+--+-- >>> showJSON Null+-- "null"+--+-- >>> showJSON (Boolean True)+-- "true"+-- >>> showJSON (Boolean False)+-- "false"+--+-- >>> showJSON (Number 0 0)+-- "0e0"+-- >>> showJSON (Number 12 34)+-- "12e34"+-- >>> showJSON (Number (-12) (-34))+-- "-12e-34"+--+-- >>> showJSON (String "")+-- "\"\""+-- >>> showJSON (String "js")+-- "\"js\""+-- >>> showJSON (String "\"\\\b\f\n\r\t")+-- "\"\\\"\\\\\\b\\f\\n\\r\\t\""+-- >>> showJSON (String "\x1f")+-- "\"\\u001f\""+--+-- >>> showJSON (Array [])+-- "[]"+-- >>> showJSON (Array [Null])+-- "[null]"+-- >>> showJSON (Array [Boolean True, Boolean False])+-- "[true,false]"+--+-- >>> showJSON (Object [])+-- "{}"+-- >>> showJSON (Object [("", Null)])+-- "{\"\":null}"+-- >>> showJSON (Object [("t", Boolean True), ("f", Boolean False)])+-- "{\"t\":true,\"f\":false}"+showJSON :: JSON -> String+showJSON json = sJSON json ""++sJSON :: JSON -> ShowS+sJSON json =+  case json of+    Null -> sNull+    Boolean boolean -> sBoolean boolean+    Number mantissa magnitude -> sNumber mantissa magnitude+    String string -> sString string+    Array array -> sArray array+    Object object -> sObject object++sNull :: ShowS+sNull = showString "null"++sBoolean :: Bool -> ShowS+sBoolean boolean =+  if boolean+    then sTrue+    else sFalse++sTrue :: ShowS+sTrue = showString "true"++sFalse :: ShowS+sFalse = showString "false"++sNumber :: Integer -> Integer -> ShowS+sNumber mantissa magnitude = shows mantissa . showChar 'e' . shows magnitude++sString :: String -> ShowS+sString string =+  sSeparatedBetween (showChar '"') (showChar '"') id sCharacter string++sCharacter :: Char -> ShowS+sCharacter character =+  case character of+    '"' -> showString "\\\""+    '\\' -> showString "\\\\"+    '\b' -> showString "\\b"+    '\f' -> showString "\\f"+    '\n' -> showString "\\n"+    '\r' -> showString "\\r"+    '\t' -> showString "\\t"+    _ ->+      if isControl character+        then showString "\\u" .+             showString+               (padLeft+                  4+                  '0'+                  (toHexadecimal (fromIntegral (fromEnum character))))+        else showChar character++sArray :: [JSON] -> ShowS+sArray array =+  sSeparatedBetween (showChar '[') (showChar ']') (showChar ',') sJSON array++sObject :: [(String, JSON)] -> ShowS+sObject object =+  sSeparatedBetween (showChar '{') (showChar '}') (showChar ',') sPair object++sPair :: (String, JSON) -> ShowS+sPair (key, value) = sString key . showChar ':' . sJSON value++-- * Helpers+fromBase :: Integer -> (Char -> Maybe Integer) -> String -> Maybe Integer+fromBase b f s =+  Monad.foldM+    (\n c -> do+       d <- f c+       pure (b * n + d))+    0+    s++fromDecimal :: String -> Maybe Integer+fromDecimal s = fromBase 10 fromDecimalDigit s++fromDecimalDigit :: Char -> Maybe Integer+fromDecimalDigit c =+  case c of+    '0' -> Just 0+    '1' -> Just 1+    '2' -> Just 2+    '3' -> Just 3+    '4' -> Just 4+    '5' -> Just 5+    '6' -> Just 6+    '7' -> Just 7+    '8' -> Just 8+    '9' -> Just 9+    _ -> Nothing++fromHexadecimal :: String -> Maybe Integer+fromHexadecimal s = fromBase 16 fromHexadecimalDigit s++fromHexadecimalDigit :: Char -> Maybe Integer+fromHexadecimalDigit c =+  case c of+    'A' -> Just 10+    'B' -> Just 11+    'C' -> Just 12+    'D' -> Just 13+    'E' -> Just 14+    'F' -> Just 15+    'a' -> Just 10+    'b' -> Just 11+    'c' -> Just 12+    'd' -> Just 13+    'e' -> Just 14+    'f' -> Just 15+    _ -> fromDecimalDigit c++isControl :: Char -> Bool+isControl c = '\x00' <= c && c <= '\x1f'++isDecimalDigit :: Char -> Bool+isDecimalDigit c = '0' <= c && c <= '9'++isHexadecimalDigit :: Char -> Bool+isHexadecimalDigit c =+  isDecimalDigit c || 'A' <= c && c <= 'F' || 'a' <= c && c <= 'f'++isLiteral :: Char -> Bool+isLiteral c = not (c == '"' || c == '\\' || isControl c)++isNonZeroDigit :: Char -> Bool+isNonZeroDigit c = '1' <= c && c <= '9'++isWhitespace :: Char -> Bool+isWhitespace c = c == '\t' || c == '\n' || c == '\r' || c == ' '++negateIf :: Bool -> Integer -> Integer+negateIf p n =+  if p+    then negate n+    else n++pSymbol :: String -> ReadP.ReadP ()+pSymbol s = do+  Functor.void (ReadP.string s)+  pWhitespaces++pWhitespaces :: ReadP.ReadP ()+pWhitespaces = Functor.void (ReadP.munch isWhitespace)++padLeft :: Integer -> a -> [a] -> [a]+padLeft n x ys = reverse (padRight n x (reverse ys))++padRight :: Integer -> a -> [a] -> [a]+padRight n x ys =+  if n <= 0+    then ys+    else case ys of+           [] -> x : padRight (n - 1) x ys+           y:zs -> y : padRight (n - 1) x zs++runParser :: ReadP.ReadP a -> String -> Maybe a+runParser p s =+  Maybe.listToMaybe+    (Maybe.mapMaybe+       (\(x, t) ->+          if null t+            then Just x+            else Nothing)+       (ReadP.readP_to_S p s))++sBetween :: ShowS -> ShowS -> (anything -> ShowS) -> anything -> ShowS+sBetween left right render it = left . render it . right++sSeparated :: ShowS -> (element -> ShowS) -> [element] -> ShowS+sSeparated separator render elements =+  case elements of+    [] -> id+    [element] -> render element+    element:rest ->+      render element . separator . sSeparated separator render rest++sSeparatedBetween ::+     ShowS -> ShowS -> ShowS -> (element -> ShowS) -> [element] -> ShowS+sSeparatedBetween left right separator render elements =+  sBetween left right (sSeparated separator render) elements++toBase :: Integer -> (Integer -> Maybe Char) -> Integer -> String+toBase b f n =+  if n == 0+    then [Maybe.fromJust (f n)]+    else reverse (toBase' b f n)++toBase' :: Integer -> (Integer -> Maybe Char) -> Integer -> String+toBase' b f n =+  case quotRem n b of+    (0, 0) -> ""+    (q, r) -> Maybe.fromJust (f r) : toBase' b f q++toHexadecimal :: Integer -> String+toHexadecimal n = toBase 16 toHexadecimalDigit n++toHexadecimalDigit :: Integer -> Maybe Char+toHexadecimalDigit n =+  case n of+    0 -> Just '0'+    1 -> Just '1'+    2 -> Just '2'+    3 -> Just '3'+    4 -> Just '4'+    5 -> Just '5'+    6 -> Just '6'+    7 -> Just '7'+    8 -> Just '8'+    9 -> Just '9'+    10 -> Just 'a'+    11 -> Just 'b'+    12 -> Just 'c'+    13 -> Just 'd'+    14 -> Just 'e'+    15 -> Just 'f'+    _ -> Nothing

+ tests/Main.hs view

@@ -0,0 +1,4 @@+import qualified Test.DocTest as Doctest++main :: IO ()+main = Doctest.doctest ["library"]