diff --git a/air.cabal b/air.cabal --- a/air.cabal +++ b/air.cabal @@ -1,5 +1,5 @@ Name: air -Version: 2013.7.18 +Version: 2014.5.19 Build-type: Simple Synopsis: air Description: An alternative Haskell Prelude library. @@ -15,15 +15,13 @@ library - build-depends: + build-depends: base >= 4 && < 5 , containers , array - , parallel , bytestring >= 0.9 , directory , filepath - , template-haskell , dlist , mtl , time @@ -31,19 +29,14 @@ hs-source-dirs: src/ - exposed-modules: + exposed-modules: Air , Air.Light , Air.Env - , Air.TH.Here - , Air.TH.Default - , Air.TH.Air - , Air.TH , Air.SimpleMath , Air.Control.Monad.ListBuilder , Air.Control.Monad.ObjectBuilder , Air.Data.Record.SimpleLabel - , Air.Data.Record.SimpleLabel.TH , Air.Data.Default , Air.Data.Monoid , Air.Data.Managed diff --git a/src/Air.hs b/src/Air.hs --- a/src/Air.hs +++ b/src/Air.hs @@ -1,7 +1,5 @@ module Air ( module Air.Env - , module Air.TH ) where import Air.Env hiding (mod) -import Air.TH diff --git a/src/Air/Data/Record/SimpleLabel.hs b/src/Air/Data/Record/SimpleLabel.hs --- a/src/Air/Data/Record/SimpleLabel.hs +++ b/src/Air/Data/Record/SimpleLabel.hs @@ -1,5 +1,5 @@ -- a fork of Sebastiaan Visser's BSD3 fclabels - + {-# LANGUAGE TypeOperators, TypeSynonymInstances, TemplateHaskell #-} module Air.Data.Record.SimpleLabel @@ -16,9 +16,6 @@ , get, set, mod , getM, setM, modM , (=:) - - -- * Derive labels using Template Haskell. - , module Air.Data.Record.SimpleLabel.TH ) where @@ -26,7 +23,6 @@ import Control.Applicative import Control.Category import Control.Monad.State hiding (get) -import Air.Data.Record.SimpleLabel.TH type Getter s x = s -> x diff --git a/src/Air/Data/Record/SimpleLabel/TH.hs b/src/Air/Data/Record/SimpleLabel/TH.hs deleted file mode 100644 --- a/src/Air/Data/Record/SimpleLabel/TH.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Air.Data.Record.SimpleLabel.TH (mkLabels, mkLabel) where - -import Control.Monad -import Data.Char -import Language.Haskell.TH.Syntax - --- | Derive labels for all the record selector in a datatype. -mkLabels :: [Name] -> Q [Dec] -mkLabels = liftM concat . mapM mkLabel - -mkLabel :: Name -> Q [Dec] -mkLabel n = do - i <- reify n - let -- only process data and newtype declarations - cs' = case i of - TyConI (DataD _ _ _ cs _) -> cs - TyConI (NewtypeD _ _ _ c _) -> [c] - _ -> [] - -- we're only interested in labels of record constructors - ls' = [ l | RecC _ ls <- cs', l <- ls ] - return (map mkLabel1 ls') - -mkLabel1 :: VarStrictType -> Dec -mkLabel1 (name, _, _) = - -- Generate a name for the label: - -- in this fork: label names are "__" + accesser name, e.g. if data Square = Square {length :: Double}, then label is __length - let n = mkName $ "__" ++ nameBase name - in FunD n [Clause [] (NormalB ( - AppE (AppE (VarE (mkName "label")) (VarE name)) -- getter - (LamE [VarP (mkName "b"), VarP (mkName "a")] -- setter - (RecUpdE (VarE (mkName "a")) [(name, VarE (mkName "b"))])) - )) []] - diff --git a/src/Air/TH.hs b/src/Air/TH.hs deleted file mode 100644 --- a/src/Air/TH.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Air.TH ( - module Air.Data.Record.SimpleLabel - , module Air.TH.Here - , module Air.TH.Default - , module Air.TH.Air -) where - -import Air.Data.Record.SimpleLabel -import Air.TH.Here -import Air.TH.Default -import Air.TH.Air - diff --git a/src/Air/TH/Air.hs b/src/Air/TH/Air.hs deleted file mode 100644 --- a/src/Air/TH/Air.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Air.TH.Air where - -import Language.Haskell.TH -import Control.Monad (replicateM) - - -{- -> $(tuple 3) [1,2,3,4,5] - (1,2,3) - > $(tuple 2) [1,2] - (1,2) --} -tuple :: Int -> ExpQ -tuple n = do - ns <- replicateM n (newName "x") - lamE [foldr (\x y -> conP '(:) [varP x,y]) wildP ns] (tupE $ map varE ns) diff --git a/src/Air/TH/Default.hs b/src/Air/TH/Default.hs deleted file mode 100644 --- a/src/Air/TH/Default.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Air.TH.Default where - -import Language.Haskell.TH -import Air.Data.Default - - --- $(reify ''Dummy >>= show > stringE) --- "TyConI (DataD [] Main.Dummy [] [RecC Main.Dummy [(Main.test_field_1,NotStrict,ConT GHC.Base.String),(Main.test_field_2,NotStrict,ConT GHC.Integer.Type.Integer)]] [])" - --- runQ [d| instance Default Dummy where def = Dummy def def |] --- [InstanceD [] (AppT (ConT Data.Default.Default) (ConT Main.Dummy)) [ValD (VarP def) (NormalB (AppE (AppE (ConE Main.Dummy) (VarE def)) (VarE def))) []]] - --- runQ [d| instance Default Dummy where def = Dummy {test_field_1 = def, test_field_2 = def} |] --- [InstanceD [] (AppT (ConT Data.Default.Default) (ConT Main.Dummy)) [ValD (VarP def) (NormalB (RecConE Main.Dummy [(Main.test_field_1,VarE def),(Main.test_field_2,VarE def)])) []]] - --- Example: - --- data Dummy = Dummy --- { --- test_field_1 :: String --- , test_field_2 :: Integer --- } --- deriving (Show) --- --- mkDefault ''Dummy --- --- gives: - --- instance Default Dummy where --- { def = Dummy {test_field_1 = def, test_field_2 = def} } - - -mkDefault :: Name -> Q [Dec] -mkDefault name = do - info <- reify name - case info of - TyConI x -> do - case x of - (DataD _ data_name _ recs _) -> do - case recs of - [] -> error $ "no phantom type" - (RecC record_name fields):_ -> do - let def_name = mkName "def" - let def_fields = map (\(field_name, _, _) -> (field_name, VarE def_name)) fields - return $ return $ - InstanceD [] - (AppT (ConT ''Default) (ConT data_name)) - [ValD (VarP def_name) (NormalB (RecConE record_name def_fields)) []] - NewtypeD _ _ _ _ _ -> error "Newtypes are not supported" - _ -> error $ "Unknown declaration type" - _ -> error "Only datatypes can be processed" diff --git a/src/Air/TH/Here.hs b/src/Air/TH/Here.hs deleted file mode 100644 --- a/src/Air/TH/Here.hs +++ /dev/null @@ -1,18 +0,0 @@ --- {-# LANGUAGE CPP #-} - -module Air.TH.Here where - -import Language.Haskell.TH.Quote -import Language.Haskell.TH.Syntax -import Language.Haskell.TH.Lib - - -here :: QuasiQuoter -here = - QuasiQuoter - { - quoteExp = litE . stringL - , quotePat = litP . stringL - } - -