Commits

David Lazar  committed 2cc17ff

Move source code to the src directory.

  • Participants
  • Parent commits e4118cc

Comments (0)

Files changed (7)

File Data/Generics/K.hs

------------------------------------------------------------------------------
--- |
--- Module      :  Data.Generics.K
--- Copyright   :  (c) David Lazar, 2011
--- License     :  MIT
---
--- Maintainer  :  lazar6@illinois.edu
--- Stability   :  experimental
--- Portability :  unknown
---
--- Convert K terms to and from 'Data' values.
------------------------------------------------------------------------------
-
-module Data.Generics.K
-    ( toK
-    , fromK
-    ) where
-
-import Data.Generics.K.ToK (toK)
-import Data.Generics.K.FromK (fromK)

File Data/Generics/K/FromK.hs

-{-# LANGUAGE ScopedTypeVariables #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Data.Generics.K.FromK
--- Copyright   :  (c) David Lazar, 2011
--- License     :  MIT
---
--- Maintainer  :  lazar6@illinois.edu
--- Stability   :  experimental
--- Portability :  unknown
---
--- Convert K terms to 'Data' values.
------------------------------------------------------------------------------
-
-module Data.Generics.K.FromK where
-
-import Data.Char (chr)
-import Data.Generics
-import Text.Printf
-import Language.K.Core.Syntax
-import Language.Haskell.Exts.Syntax -- Issue 198 (see below)
-import Control.Monad.Instances -- fix for earlier versions of base
-
-fromK :: (Data a) => K -> a
-fromK = defaultFromK
-    `extR` kToInt
-    `extR` kToInteger
-    `extR` kToBool
-    `extR` kToString
-    `extR` kToChar
-    `extR` kToLiteral -- Issue 198 (see below)
-    `extR` kToExp
-
-kToExp :: K -> Exp
-kToExp (KApp (KLabel (Syntax "ListExp" : _)) ks) = fromConstrK (toConstr (List [])) ks
-kToExp k = defaultFromK k
-
--- Workaround for Issue 198 in K.
-kToLiteral :: K -> Literal
-kToLiteral (KApp (KLabel (Syntax "IntLit" : _)) [KApp (KInt i) []]) = Int i
-kToLiteral (KApp (KLabel (Syntax "StringLit" : _)) [KApp (KString s) []]) = String s
-kToLiteral k = defaultFromK k
-
-kToInt :: K -> Int
-kToInt (KApp (KInt i) []) = fromIntegral i
-
-kToInteger :: K -> Integer
-kToInteger (KApp (KInt i) []) = i
-
-kToBool :: K -> Bool
-kToBool (KApp (KBool b) []) = b
-
-kToString :: K -> String
-kToString (KApp (KString s) []) = s
-
-kToChar :: K -> Char
-kToChar (KApp (KInt i) []) = chr (fromIntegral i)
-
-defaultFromK :: forall a. (Data a) => K -> a
-defaultFromK (KApp (KLabel ((Syntax conStr) : _)) ks) =
-    let dataType = dataTypeOf (undefined :: a)
-        -- TODO: better error handling:
-        con = either error id $ str2con dataType conStr
-    in fromConstrK con ks
-
-
--- There's probably a better way to do this:
-data KS x = KS { ks :: [K] , unKS :: x }
-
-fromConstrK :: (Data a) => Constr -> [K] -> a
-fromConstrK c ks = unKS $ gunfold s z c
-    where
-        s :: forall b r. Data b => KS (b -> r) -> KS r
-        s (KS (k:ks) f) = KS ks (f $ fromK k)
-
-        z :: forall r. r -> KS r
-        z = KS ks
-
--- | Turn the given string into a constructor of the requested result type,
--- returning 'Left' if the string doesn't represent a constructor of this
--- data type.
-str2con :: DataType -> String -> Either String Constr
-str2con dataType conName =
-    case readConstr dataType conName of
-        Just con -> Right con
-        Nothing  -> Left failString
-    where failString   = printf formatString (show conName) (show dataType)
-          formatString = "Failed to parse %s as a constructor of type %s."

File Data/Generics/K/ToK.hs

------------------------------------------------------------------------------
--- |
--- Module      :  Data.Generics.K.ToK
--- Copyright   :  (c) David Lazar, 2011
--- License     :  MIT
---
--- Maintainer  :  lazar6@illinois.edu
--- Stability   :  experimental
--- Portability :  unknown
---
--- Convert 'Data' values to K terms.
------------------------------------------------------------------------------
-
-module Data.Generics.K.ToK where
-
-import Data.Char (ord)
-import Data.Generics
-import Language.K.Core.Syntax
-import Language.Haskell.Exts.Syntax -- Issue 198 (see below)
-
-toK :: (Data a) => a -> K
-toK = defaultToK
-    `extQ` stringToK
-
-stringToK :: String -> K
-stringToK s = KApp (KString s) []
-
-defaultToK :: (Data a) => a -> K
-defaultToK a = KApp (toKLabel a) (gmapQ toK a)
-
-toKLabel :: (Data a) => a -> KLabel
-toKLabel = defaultToKLabel
-    `extQ` KInt         -- Integer
-    `extQ` KBool        -- Bool
-    `extQ` intToKLabel  -- Int
-    `extQ` charToKLabel -- Char
-    `extQ` literalToKLabel -- Issue 198 (see below)
-    `extQ` expToKLabel
-
-expToKLabel :: Exp -> KLabel
-expToKLabel (List es) = KLabel [Syntax "ListExp", Hole]
-expToKLabel e = defaultToKLabel e
-
--- Workaround for Issue 198 in K.
-literalToKLabel :: Literal -> KLabel
-literalToKLabel (Int _) = KLabel [Syntax "IntLit", Hole]
-literalToKLabel (String _) = KLabel [Syntax "StringLit", Hole]
-literalToKLabel l = defaultToKLabel l
-
-intToKLabel :: Int -> KLabel
-intToKLabel = KInt . fromIntegral
-
-charToKLabel :: Char -> KLabel
-charToKLabel = KInt . fromIntegral . ord
-
-defaultToKLabel :: (Data a) => a -> KLabel
-defaultToKLabel a = KLabel $ Syntax ctor : replicate (glength a) Hole
-    where ctor = showConstr . toConstr $ a

File generic-k.cabal

 Cabal-version:      >=1.2
 
 Library
+  Hs-source-dirs:   src
+
   Exposed-modules:
     Data.Generics.K
     Data.Generics.K.ToK

File src/Data/Generics/K.hs

+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Generics.K
+-- Copyright   :  (c) David Lazar, 2011
+-- License     :  MIT
+--
+-- Maintainer  :  lazar6@illinois.edu
+-- Stability   :  experimental
+-- Portability :  unknown
+--
+-- Convert K terms to and from 'Data' values.
+-----------------------------------------------------------------------------
+
+module Data.Generics.K
+    ( toK
+    , fromK
+    ) where
+
+import Data.Generics.K.ToK (toK)
+import Data.Generics.K.FromK (fromK)

File src/Data/Generics/K/FromK.hs

+{-# LANGUAGE ScopedTypeVariables #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Generics.K.FromK
+-- Copyright   :  (c) David Lazar, 2011
+-- License     :  MIT
+--
+-- Maintainer  :  lazar6@illinois.edu
+-- Stability   :  experimental
+-- Portability :  unknown
+--
+-- Convert K terms to 'Data' values.
+-----------------------------------------------------------------------------
+
+module Data.Generics.K.FromK where
+
+import Data.Char (chr)
+import Data.Generics
+import Text.Printf
+import Language.K.Core.Syntax
+import Language.Haskell.Exts.Syntax -- Issue 198 (see below)
+import Control.Monad.Instances -- fix for earlier versions of base
+
+fromK :: (Data a) => K -> a
+fromK = defaultFromK
+    `extR` kToInt
+    `extR` kToInteger
+    `extR` kToBool
+    `extR` kToString
+    `extR` kToChar
+    `extR` kToLiteral -- Issue 198 (see below)
+    `extR` kToExp
+
+kToExp :: K -> Exp
+kToExp (KApp (KLabel (Syntax "ListExp" : _)) ks) = fromConstrK (toConstr (List [])) ks
+kToExp k = defaultFromK k
+
+-- Workaround for Issue 198 in K.
+kToLiteral :: K -> Literal
+kToLiteral (KApp (KLabel (Syntax "IntLit" : _)) [KApp (KInt i) []]) = Int i
+kToLiteral (KApp (KLabel (Syntax "StringLit" : _)) [KApp (KString s) []]) = String s
+kToLiteral k = defaultFromK k
+
+kToInt :: K -> Int
+kToInt (KApp (KInt i) []) = fromIntegral i
+
+kToInteger :: K -> Integer
+kToInteger (KApp (KInt i) []) = i
+
+kToBool :: K -> Bool
+kToBool (KApp (KBool b) []) = b
+
+kToString :: K -> String
+kToString (KApp (KString s) []) = s
+
+kToChar :: K -> Char
+kToChar (KApp (KInt i) []) = chr (fromIntegral i)
+
+defaultFromK :: forall a. (Data a) => K -> a
+defaultFromK (KApp (KLabel ((Syntax conStr) : _)) ks) =
+    let dataType = dataTypeOf (undefined :: a)
+        -- TODO: better error handling:
+        con = either error id $ str2con dataType conStr
+    in fromConstrK con ks
+
+
+-- There's probably a better way to do this:
+data KS x = KS { ks :: [K] , unKS :: x }
+
+fromConstrK :: (Data a) => Constr -> [K] -> a
+fromConstrK c ks = unKS $ gunfold s z c
+    where
+        s :: forall b r. Data b => KS (b -> r) -> KS r
+        s (KS (k:ks) f) = KS ks (f $ fromK k)
+
+        z :: forall r. r -> KS r
+        z = KS ks
+
+-- | Turn the given string into a constructor of the requested result type,
+-- returning 'Left' if the string doesn't represent a constructor of this
+-- data type.
+str2con :: DataType -> String -> Either String Constr
+str2con dataType conName =
+    case readConstr dataType conName of
+        Just con -> Right con
+        Nothing  -> Left failString
+    where failString   = printf formatString (show conName) (show dataType)
+          formatString = "Failed to parse %s as a constructor of type %s."

File src/Data/Generics/K/ToK.hs

+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Generics.K.ToK
+-- Copyright   :  (c) David Lazar, 2011
+-- License     :  MIT
+--
+-- Maintainer  :  lazar6@illinois.edu
+-- Stability   :  experimental
+-- Portability :  unknown
+--
+-- Convert 'Data' values to K terms.
+-----------------------------------------------------------------------------
+
+module Data.Generics.K.ToK where
+
+import Data.Char (ord)
+import Data.Generics
+import Language.K.Core.Syntax
+import Language.Haskell.Exts.Syntax -- Issue 198 (see below)
+
+toK :: (Data a) => a -> K
+toK = defaultToK
+    `extQ` stringToK
+
+stringToK :: String -> K
+stringToK s = KApp (KString s) []
+
+defaultToK :: (Data a) => a -> K
+defaultToK a = KApp (toKLabel a) (gmapQ toK a)
+
+toKLabel :: (Data a) => a -> KLabel
+toKLabel = defaultToKLabel
+    `extQ` KInt         -- Integer
+    `extQ` KBool        -- Bool
+    `extQ` intToKLabel  -- Int
+    `extQ` charToKLabel -- Char
+    `extQ` literalToKLabel -- Issue 198 (see below)
+    `extQ` expToKLabel
+
+expToKLabel :: Exp -> KLabel
+expToKLabel (List es) = KLabel [Syntax "ListExp", Hole]
+expToKLabel e = defaultToKLabel e
+
+-- Workaround for Issue 198 in K.
+literalToKLabel :: Literal -> KLabel
+literalToKLabel (Int _) = KLabel [Syntax "IntLit", Hole]
+literalToKLabel (String _) = KLabel [Syntax "StringLit", Hole]
+literalToKLabel l = defaultToKLabel l
+
+intToKLabel :: Int -> KLabel
+intToKLabel = KInt . fromIntegral
+
+charToKLabel :: Char -> KLabel
+charToKLabel = KInt . fromIntegral . ord
+
+defaultToKLabel :: (Data a) => a -> KLabel
+defaultToKLabel a = KLabel $ Syntax ctor : replicate (glength a) Hole
+    where ctor = showConstr . toConstr $ a