Skip to content

Commit fc4a0e2

Browse files
paulyoungpaulyoung
committed
General cleanup, remove Generic
1 parent 4700cda commit fc4a0e2

File tree

7 files changed

+12
-277
lines changed

7 files changed

+12
-277
lines changed

‎bower.json

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,6 @@
1414
"purescript-newtype": "^2.0.0",
1515
"purescript-tuples": "^4.0.0",
1616
"purescript-foldable-traversable": "^3.0.0",
17-
"purescript-generics": "^4.0.0",
1817
"purescript-profunctor": "^3.2.0"
1918
},
2019
"devDependencies": {

‎src/CoreFn/Expr.purs

Lines changed: 0 additions & 51 deletions
Original file line numberDiff line numberDiff line change
@@ -7,12 +7,6 @@ module CoreFn.Expr
77
, CaseAlternative(..)
88
, Expr(..)
99
, Guard
10-
-- , readBind
11-
-- , readBindJSON
12-
-- , readExpr
13-
-- , readExprJSON
14-
-- , readLiteral
15-
-- , readLiteralJSON
1610
) where
1711

1812
import Prelude
@@ -109,32 +103,6 @@ instance showExpr :: Show a => Show (Expr a) where
109103
intercalate " " [ show a, show bs, show e ] <>
110104
")"
111105

112-
-- readExpr :: Foreign -> F (Expr Unit)
113-
-- readExpr x = do
114-
-- label <- index x 0 >>= readString
115-
-- readExpr' label x
116-
117-
-- where
118-
119-
-- readExpr' :: String -> Foreign -> F (Expr Unit)
120-
-- readExpr' "Literal" y = do
121-
-- value <- index y 1
122-
-- Literal unit <$> readLiteral value
123-
-- readExpr' "Abs" y = do
124-
-- ident <- index y 1
125-
-- expr <- index y 2
126-
-- Abs unit <$> readIdent ident <*> readExpr expr
127-
-- readExpr' "App" y = do
128-
-- expr1 <- index y 1
129-
-- expr2 <- index y 2
130-
-- App unit <$> readExpr expr1 <*> readExpr expr2
131-
-- readExpr' "Var" y = do
132-
-- value <- index y 1
133-
-- Var unit <$> readQualified Ident value
134-
-- readExpr' label _ = fail $ ForeignError $ "Unknown expression: " <> label
135-
136-
-- readExprJSON :: String -> F (Expr Unit)
137-
-- readExprJSON = parseJSON >=> readExpr
138106

139107
-- |
140108
-- A let or module binding.
@@ -153,25 +121,6 @@ instance showBind :: Show a => Show (Bind a) where
153121
show (NonRec b) = "(NonRec " <> show b <> ")"
154122
show (Rec b) = "(Rec " <> show b <> ")"
155123

156-
-- readBind :: Foreign -> F (Bind Unit)
157-
-- readBind x = do
158-
-- pairs <- objectProps x
159-
-- bindings <- traverse fromPair pairs
160-
-- pure $ Bind bindings
161-
162-
-- where
163-
164-
-- fromPair
165-
-- :: { key :: String, value :: Foreign }
166-
-- -> F (Tuple (Tuple Unit Ident) (Expr Unit))
167-
-- fromPair pair = do
168-
-- expr <- readExpr pair.value
169-
-- let ident = Ident pair.key
170-
-- pure $ Tuple (Tuple unit ident) expr
171-
172-
-- readBindJSON :: String -> F (Bind Unit)
173-
-- readBindJSON = parseJSON >=> readBind
174-
175124

176125
-- |
177126
-- A guard is just a boolean-valued expression that appears alongside a set of binders

‎src/CoreFn/Ident.purs

Lines changed: 7 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -3,15 +3,10 @@
33
--
44
module CoreFn.Ident
55
( Ident(..)
6-
, readIdent
7-
, readIdentJSON
86
) where
97

108
import Prelude
119

12-
import Data.Foreign (F, Foreign, readString)
13-
import Data.Foreign.JSON (parseJSON)
14-
import Data.Generic (gShow, class Generic)
1510
import Data.Maybe (Maybe)
1611

1712
data Ident
@@ -23,16 +18,15 @@ data Ident
2318
-- A generated name for an identifier
2419
--
2520
| GenIdent (Maybe String) Int
21+
-- |
22+
-- A generated name used only for type-checking
23+
--
24+
| UnusedIdent
2625

2726
derive instance eqIdent :: Eq Ident
28-
derive instance genericIdent :: Generic Ident
2927
derive instance ordIdent :: Ord Ident
3028

3129
instance showIdent :: Show Ident where
32-
show = gShow
33-
34-
readIdent :: Foreign -> F Ident
35-
readIdent x = Ident <$> readString x
36-
37-
readIdentJSON :: String -> F Ident
38-
readIdentJSON = parseJSON >=> readIdent
30+
show (Ident s) = "(Ident " <> show s <> ")"
31+
show (GenIdent s i) = "(GenIdent " <> show s <> " " <> show i <> ")"
32+
show UnusedIdent = "UnusedIdent"

‎src/CoreFn/Literal.purs

Lines changed: 0 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -46,47 +46,3 @@ instance showLiteral :: Show a => Show (Literal a) where
4646
show (BooleanLiteral b) = "(BooleanLiteral " <> show b <> ")"
4747
show (ArrayLiteral a) = "(ArrayLiteral " <> show a <> ")"
4848
show (ObjectLiteral o) = "(ObjectLiteral" <> show o <> ")"
49-
50-
-- readLiteral :: Foreign -> F (Literal (Expr Unit))
51-
-- readLiteral x = do
52-
-- label <- index x 0 >>= readString
53-
-- readLiteral' label x
54-
55-
-- where
56-
57-
-- readValues :: Array Foreign -> F (Array (Expr Unit))
58-
-- readValues = traverse readExpr
59-
60-
-- readPair :: Foreign -> String -> F (Tuple String (Expr Unit))
61-
-- readPair obj key = Tuple key <$> (readProp key obj >>= readExpr)
62-
63-
-- readPairs :: Foreign -> Array String -> F (Array (Tuple String (Expr Unit)))
64-
-- readPairs obj = sequence <<< (map <<< readPair) obj
65-
66-
-- readLiteral' :: String -> Foreign -> F (Literal (Expr Unit))
67-
-- readLiteral' "IntLiteral" v = do
68-
-- value <- index v 1
69-
-- NumericLiteral <$> Left <$> readInt value
70-
-- readLiteral' "NumberLiteral" v = do
71-
-- value <- index v 1
72-
-- NumericLiteral <$> Right <$> readNumber value
73-
-- readLiteral' "StringLiteral" v = do
74-
-- value <- index v 1
75-
-- StringLiteral <$> readString value
76-
-- readLiteral' "CharLiteral" v = do
77-
-- value <- index v 1
78-
-- CharLiteral <$> readChar value
79-
-- readLiteral' "BooleanLiteral" v = do
80-
-- value <- index v 1
81-
-- BooleanLiteral <$> readBoolean value
82-
-- readLiteral' "ArrayLiteral" v = do
83-
-- array <- index v 1 >>= readArray
84-
-- ArrayLiteral <$> readValues array
85-
-- readLiteral' "ObjectLiteral" v = do
86-
-- obj <- index v 1
87-
-- keys <- K.keys obj
88-
-- ObjectLiteral <$> readPairs obj keys
89-
-- readLiteral' label _ = fail $ ForeignError $ "Unknown literal: " <> label
90-
91-
-- readLiteralJSON :: String -> F (Literal (Expr Unit))
92-
-- readLiteralJSON = parseJSON >=> readLiteral

‎src/CoreFn/Module.purs

Lines changed: 2 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -3,23 +3,15 @@ module CoreFn.Module
33
, Module(..)
44
, ModuleImport(..)
55
, Version(..)
6-
-- , readModule
7-
-- , readModuleJSON
86
) where
97

108
import Prelude
119

1210
import CoreFn.Ann (Comment, Ann)
1311
import CoreFn.Expr (Bind)
1412
import CoreFn.Ident (Ident)
15-
import CoreFn.Names (ModuleName(..))
16-
import CoreFn.Util (objectProp)
17-
import Data.Array (intercalate)
18-
import Data.Foreign (F, Foreign, readArray, readString)
19-
import Data.Foreign.Index (class Index, index, readProp)
20-
import Data.Foreign.JSON (parseJSON)
13+
import CoreFn.Names (ModuleName)
2114
import Data.Newtype (class Newtype)
22-
import Data.Traversable (traverse)
2315

2416
-- |
2517
-- The CoreFn module representation
@@ -68,6 +60,7 @@ instance showModuleImport :: Show ModuleImport where
6860
"}" <>
6961
")"
7062

63+
7164
newtype Version = Version String
7265

7366
derive instance newtypeVersion :: Newtype Version _
@@ -86,39 +79,3 @@ derive newtype instance ordFilePath :: Ord FilePath
8679

8780
instance showFilePath :: Show FilePath where
8881
show (FilePath s) = "(FilePath " <> show s <> ")"
89-
90-
91-
-- readModule :: Foreign -> F (Module Unit)
92-
-- readModule x = do
93-
-- o <- objectProp "Module name not found" x
94-
95-
-- builtWith <- readProp "builtWith" o.value >>= readString
96-
-- moduleDecls <- traverseArrayProp "decls" o.value readBind
97-
-- moduleExports <- traverseArrayProp "exports" o.value readIdent
98-
-- moduleForeign <- traverseArrayProp "foreign" o.value readIdent
99-
-- moduleImports <- traverseArrayProp "imports" o.value readModuleName
100-
101-
-- let moduleName = ModuleName o.key
102-
103-
-- pure $ Module
104-
-- { builtWith: Version builtWith
105-
-- , moduleDecls
106-
-- , moduleExports
107-
-- , moduleForeign
108-
-- , moduleImports
109-
-- , moduleName
110-
-- }
111-
112-
-- where
113-
114-
-- traverseArrayProp
115-
-- :: forall a b
116-
-- . (Index a)
117-
-- => a
118-
-- -> Foreign
119-
-- -> (Foreign -> F b)
120-
-- -> F (Array b)
121-
-- traverseArrayProp i value f = index value i >>= readArray >>= traverse f
122-
123-
-- readModuleJSON :: String -> F (Module Unit)
124-
-- readModuleJSON = parseJSON >=> readModule

‎src/CoreFn/Names.purs

Lines changed: 3 additions & 75 deletions
Original file line numberDiff line numberDiff line change
@@ -3,62 +3,34 @@ module CoreFn.Names
33
, OpName(..)
44
, ProperName(..)
55
, Qualified(..)
6-
-- , readModuleName
7-
-- , readModuleNameJSON
8-
-- , readOpName
9-
-- , readOpNameJSON
10-
-- , readProperName
11-
-- , readProperNameJSON
12-
-- , readQualified
13-
-- , readQualifiedJSON
146
) where
157

168
import Prelude
179

18-
import Control.Error.Util (exceptNoteM)
19-
import Data.Array (init, last, null)
20-
import Data.Foreign (F, Foreign, ForeignError(..), readString)
21-
import Data.Foreign.JSON (parseJSON)
22-
import Data.Generic (class Generic, gShow)
23-
import Data.List.NonEmpty (singleton)
24-
import Data.List.Types (NonEmptyList)
25-
import Data.Maybe (Maybe(..))
10+
import Data.Maybe (Maybe)
2611
import Data.Newtype (class Newtype)
27-
import Data.String (Pattern(..), joinWith, split)
2812

2913
-- |
3014
-- Module names
3115
--
3216
newtype ModuleName = ModuleName (Array ProperName)
3317

3418
derive instance eqModuleName :: Eq ModuleName
35-
derive instance genericModuleName :: Generic ModuleName
3619
derive instance newtypeModuleName :: Newtype ModuleName _
3720
derive instance ordModuleName :: Ord ModuleName
3821
derive newtype instance showModuleName :: Show ModuleName
3922

40-
-- readModuleName :: Foreign -> F ModuleName
41-
-- readModuleName x = ModuleName <$> readString x
42-
43-
-- readModuleNameJSON :: String -> F ModuleName
44-
-- readModuleNameJSON = parseJSON >=> readModuleName
4523

4624
-- |
4725
-- Operator alias names.
4826
--
4927
newtype OpName = OpName String
5028

5129
derive instance eqOpName :: Eq OpName
52-
derive instance genericOpName :: Generic OpName
5330
derive instance newtypeOpName :: Newtype OpName _
5431
derive instance ordOpName :: Ord OpName
5532
derive newtype instance showOpName :: Show OpName
5633

57-
-- readOpName :: Foreign -> F OpName
58-
-- readOpName x = OpName <$> readString x
59-
60-
-- readOpNameJSON :: String -> F OpName
61-
-- readOpNameJSON = parseJSON >=> readOpName
6234

6335
-- |
6436
-- Proper name, i.e. capitalized names for e.g. module names, type/data
@@ -67,62 +39,18 @@ derive newtype instance showOpName :: Show OpName
6739
newtype ProperName = ProperName String
6840

6941
derive instance eqProperName :: Eq ProperName
70-
derive instance genericProperName :: Generic ProperName
7142
derive instance newtypeProperName :: Newtype ProperName _
7243
derive instance ordProperName :: Ord ProperName
7344
derive newtype instance showProperName :: Show ProperName
7445

75-
-- readProperName :: Foreign -> F ProperName
76-
-- readProperName x = ProperName <$> readString x
77-
78-
-- readProperNameJSON :: String -> F ProperName
79-
-- readProperNameJSON = parseJSON >=> readProperName
8046

8147
-- |
8248
-- A qualified name, i.e. a name with an optional module name
8349
--
8450
data Qualified a = Qualified (Maybe ModuleName) a
8551

86-
derive instance eqQualified :: (Generic a, Eq a) => Eq (Qualified a)
87-
-- derive instance genericQualified :: (Generic a) => Generic (Qualified a)
88-
derive instance ordQualified :: (Generic a, Ord a) => Ord (Qualified a)
89-
90-
-- instance showQualified :: (Generic a, Show a) => Show (Qualified a) where
91-
-- show = gShow
52+
derive instance eqQualified :: Eq a => Eq (Qualified a)
53+
derive instance ordQualified :: Ord a => Ord (Qualified a)
9254

9355
instance showQualified :: Show a => Show (Qualified a) where
9456
show (Qualified m a) = "(Qualified " <> show m <> show a <> ")"
95-
96-
97-
-- readQualified :: forall a. (String -> a) -> Foreign -> F (Qualified a)
98-
-- readQualified ctor = readString >=> toQualified ctor
99-
100-
-- where
101-
102-
-- arrayToMaybe :: forall b. Array b -> Maybe (Array b)
103-
-- arrayToMaybe xs | null xs = Nothing
104-
-- | otherwise = Just xs
105-
106-
-- init' :: forall b. Array b -> Maybe (Array b)
107-
-- init' = init >=> arrayToMaybe
108-
109-
-- delimiter = "."
110-
111-
-- toModuleName :: Array String -> ModuleName
112-
-- toModuleName = ModuleName <<< (joinWith delimiter)
113-
114-
-- toQualified' :: (String -> a) -> String -> Maybe (Qualified a)
115-
-- toQualified' c s = do
116-
-- let parts = split (Pattern delimiter) s
117-
-- lastPart <- last parts
118-
-- let moduleName = toModuleName <$> init' parts
119-
-- Just $ Qualified moduleName (c lastPart)
120-
121-
-- toQualified :: (String -> a) -> String -> F (Qualified a)
122-
-- toQualified c s = exceptNoteM (toQualified' c s) errors
123-
124-
-- errors :: NonEmptyList ForeignError
125-
-- errors = singleton (ForeignError "Error parsing qualified name")
126-
127-
-- readQualifiedJSON :: forall a. (String -> a) -> String -> F (Qualified a)
128-
-- readQualifiedJSON ctor = parseJSON >=> readQualified ctor

0 commit comments

Comments
 (0)