packages feed

DTC (empty) → 1.0.0

raw patch · 7 files changed

+220/−0 lines, 7 filesdep +basedep +haskell-srcsetup-changed

Dependencies added: base, haskell-src

Files

+ DTC.cabal view
@@ -0,0 +1,22 @@+Name:           DTC
+Version:        1.0.0
+Author:         Daniel Diaz
+Homepage:       http://ddiaz.asofilak.es/packages/DTC
+License:        BSD3
+License-file:   license
+Maintainer:     Daniel Diaz <danieldiaz@asofilak.es>
+Category:       Language
+Synopsis:       Data To Class.
+Description:    Transform data declarations to class definitions.
+                .
+                The way is explained in /Data Declarations to Class Definitions/.
+                You can find these notes in the homepage of the package.
+Build-type:     Simple
+Build-depends:  base == 4.*
+              , haskell-src
+Cabal-version:  >= 1.6
+Exposed-modules: 
+           Language.Haskell.DTC
+         , Language.Haskell.DTC.Parser
+         , Language.Haskell.DTC.Mod
+         , Language.Haskell.DTC.Class
+ Language/Haskell/DTC.hs view
@@ -0,0 +1,16 @@+
+-- | Main module of @DTC@.
+module Language.Haskell.DTC
+   ( -- * Export of @DTC@ modules.
+     module Language.Haskell.DTC.Parser
+   , module Language.Haskell.DTC.Mod
+   , module Language.Haskell.DTC.Class
+     -- * Re-export "Language.Haskell.Pretty"
+   , module Language.Haskell.Pretty
+     ) where
+
+import Language.Haskell.DTC.Parser
+import Language.Haskell.DTC.Mod
+import Language.Haskell.DTC.Class
+
+import Language.Haskell.Pretty
+ Language/Haskell/DTC/Class.hs view
@@ -0,0 +1,95 @@+
+-- | Class definition from a data declaration.
+module Language.Haskell.DTC.Class
+   ( dataToClassWith
+   , dataToClass
+     ) where
+
+import Data.Char
+import Data.Maybe
+import Language.Haskell.Syntax
+
+import Language.Haskell.DTC.Mod
+
+-- | Transform a data declaration to a class definition.
+-- The 'String' argument will be the name of the type variable of the class definition.
+dataToClassWith :: String -> HsDecl -> HsDecl
+dataToClassWith str (HsDataDecl loc ctx x_T xs_v xs_C xs_Q)
+      = let methods = concatMap (method str xs_v x_T) xs_C
+        in  HsClassDecl loc ctx x_T [HsIdent str] methods
+
+-- | Transform a data declaration to a class definition.
+dataToClass :: HsDecl -> HsDecl
+dataToClass = dataToClassWith "t"
+
+(->>) :: HsType -> HsType -> HsType
+t1 ->> t2 = HsTyFun t1 t2
+
+(.>>) :: HsType -> HsType -> HsType
+t1 .>> t2 = HsTyApp t1 t2
+
+hsTyTuple :: [HsType] -> HsType
+hsTyTuple [t] = t
+hsTyTuple xs  = HsTyTuple xs
+
+replaceType :: HsName -> String -> HsType -> HsType
+replaceType name new (HsTyFun t1 t2) = HsTyFun (replaceType name new t1) (replaceType name new t2)
+replaceType name new (HsTyTuple xs)  = HsTyTuple $ map (replaceType name new) xs
+replaceType name new (HsTyApp t1 t2) = HsTyApp (replaceType name new t1) (replaceType name new t2)
+replaceType name new (HsTyVar name') = if name == name' then HsTyVar $ HsIdent new
+                                                        else HsTyVar name'
+replaceType name new (HsTyCon qname) =
+    HsTyCon $
+     case qname of
+      Qual m name' -> if name == name' then Qual m $ HsIdent new
+                                       else Qual m name'
+      UnQual name' -> if name == name' then UnQual $ HsIdent new
+                                       else UnQual name'
+      x -> x
+
+constructor :: String -> [HsName] -> HsName -> HsConDecl -> HsDecl
+constructor str xs_v x_T (HsConDecl loc name xs) =
+    constructor_ str loc name xs_v x_T xs
+constructor str xs_v x_T (HsRecDecl loc name xs) =
+    constructor_ str loc name xs_v x_T (map snd xs)
+
+constructor_ :: String -> SrcLoc -> HsName -> [HsName]
+                       -> HsName -> [HsBangType] -> HsDecl
+constructor_ str loc name xs_v x_T xs =
+     HsTypeSig loc [modifyHsName (\(n:ns) -> toLower n : ns) name]
+               (HsQualType [] $
+                 foldr (->>)
+                       (foldl (.>>)
+                              (HsTyVar $ HsIdent str)
+                              (map HsTyVar xs_v) )
+                       (map (replaceType x_T str . unBangType) xs)
+                )
+
+deconstructor :: String -> [HsName] -> HsName -> HsConDecl -> [HsDecl]
+deconstructor str xs_v x_T (HsConDecl loc name xs) =
+    if length xs > 0
+       then [ HsTypeSig loc [modifyHsName ("from"++) name]
+                        (HsQualType [] $
+                          foldl (.>>)
+                                (HsTyVar $ HsIdent str)
+                                (map HsTyVar xs_v)
+                          ->>
+                          (hsTyTuple $ map (replaceType x_T str . unBangType) xs)
+                         )
+             ]
+       else [ ]
+deconstructor str xs_v x_T (HsRecDecl loc name xs) =
+    map (\(ys,t) -> 
+     HsTypeSig loc [head ys]
+               (HsQualType [] $
+                 foldl (.>>)
+                       (HsTyVar $ HsIdent str)
+                       (map HsTyVar xs_v)
+                 ->>
+                 (replaceType x_T str $ unBangType t)
+                )
+         ) xs
+
+method :: String -> [HsName] -> HsName -> HsConDecl -> [HsDecl]
+method str xs x_T dec = constructor str xs x_T dec : deconstructor str xs x_T dec
+
+ Language/Haskell/DTC/Mod.hs view
@@ -0,0 +1,23 @@+
+-- | Some useful functions.
+module Language.Haskell.DTC.Mod
+    ( modifyHsDecls
+    , unBangType
+    , modifyHsName
+      ) where
+
+import Language.Haskell.Syntax
+
+-- | Lift a function over @[@'HsDecl'@]@ to a function over 'HsModule'.
+modifyHsDecls :: ([HsDecl] -> [HsDecl]) -> (HsModule -> HsModule)
+modifyHsDecls f (HsModule loc m es is decls) = HsModule loc m es is $ f decls
+
+-- | Skip a bang in a type.
+unBangType :: HsBangType -> HsType
+unBangType (HsBangedTy x)   = x
+unBangType (HsUnBangedTy x) = x
+
+-- | Lift a function over 'String' to a function over 'HsName'.
+modifyHsName :: (String -> String) -> (HsName -> HsName)
+modifyHsName f (HsIdent x) = HsIdent $ f x
+modifyHsName f (HsSymbol x) = HsSymbol $ f x
+ Language/Haskell/DTC/Parser.hs view
@@ -0,0 +1,32 @@+
+-- | All you need to parse a module.
+module Language.Haskell.DTC.Parser
+    ( -- * From "Language.Haskell.Parser"
+      ParseResult
+    , HsModule
+    , parseModule
+      -- * Extras
+    , parseModuleWithFN
+    , parseModuleWithSrc
+     ) where
+
+import Language.Haskell.Syntax
+import Language.Haskell.Parser
+
+-- | @parseModuleWithFN fileName module@ parse @module@ with a @fileName@ associated.
+parseModuleWithFN :: FilePath -> String -> ParseResult HsModule
+parseModuleWithFN = parseModuleWithMode . ParseMode
+
+-- | Parse a module from a source code file. It throws an error if parsing fails.
+parseModuleWithSrc :: FilePath -> IO HsModule
+parseModuleWithSrc fp =
+      do str <- readFile fp
+         let r = parseModuleWithFN fp str
+         case r of
+           ParseOk p -> return p
+           ParseFailed loc err -> do fail $ concat [ err
+                                                   , " at: " , srcFilename loc
+                                                   , ":" , show $ srcLine loc
+                                                   , ":" , show $ srcColumn loc
+                                                    ]
+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain
+ license view
@@ -0,0 +1,30 @@+Copyright (c)2010, Daniel Díaz
+
+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 Daniel Díaz 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.