File traits atSlotNamed: #parent0 put: ExternalResource traits.
File addSlotsFrom: ExternalResource.
File traits addSlot: #ReadWrite valued: Oddball clone.
File traits addSlot: #Read valued: Oddball clone.
File traits addSlot: #Write valued: Oddball clone.
File traits addSlot: #CreateWrite valued: Oddball clone.
File addSlot: #mode valued: File ReadWrite.

f@(File traits) size
[
  f sizeOf: f handle
].

f@(File traits) position
[
  f positionOf: f handle
].

f@(File traits) position: index
[
  f reposition: f handle to: index
].

f@(File traits) isAtEnd
[
  f atEndOf: f handle
].

file@(File traits) close
"Call the close primitive and set the handle to its result, Nil."
[
  file handle: (file close: file handle)
].

f@(File traits) newNamed: filename &mode: mode
[| newF |
  newF: f clone.
  newF handle: Nil.
  newF locator: (filename as: f Locator).
  newF mode: (mode ifNil: [f mode]).
  newF
].

f@(File traits) enable
[| filename |
  filename: (f locator as: String).
  f handle:
    (f mode caseOf:
      {f Read -> [f openForInput: filename].
       f Write -> [f openForOutput: filename].
       f ReadWrite -> [f open: filename].
       f CreateWrite -> [f openNew: filename]}
	 otherwise: [error: 'No mode specified.']).
  f handle ifNil: [f connectionFailure].
  f
].

f@(File traits) withOpenNamed: filename do: block &mode: mode
"Calls sessionDo: on a File made for the given filename and mode."
[| newF |
  newF: (f newNamed: filename &mode: mode).
  newF sessionDo: block
].

File traits addPrototype: #NotFound derivedFrom: {Error}.
File NotFound addSlot: #filename valued: File Locator.

f@(File traits) noneExistsFor: filename
[| newE |
  newE: f NotFound clone.
  newE filename: filename.
  newE signal
].

e@(File NotFound traits) describe
[
  DebugConsole ; 'Error: A file does not exist for the pathname: '.
  e filename printOn: DebugConsole writer
].

File traits addPrototype: #Locator derivedFrom: {ExternalResource Locator}.
File Locator addSlot: #path valued: ExtensibleArray newEmpty.
"The Sequence of path accessors (directory names) to reach the file's area."
File Locator addSlot: #name valued: ''.
"The name of a file(-group)."
File Locator addSlot: #fileType.
"Corresponds to the filetype or suffix used in many filesystems."
File Locator addSlot: #version.
"Corresponds to the version of a file, with optional support."

f@(File Locator traits) newEmpty
[| newF |
  newF: f clone.
  newF path: f path newEmpty.
  newF name: Nil.
  newF fileType: Nil.
  newF version: Nil.
  newF
].

f@(File traits) locator
"Convert the file's fullName attribute into a Locator object and return that."
[
  f fullName as: f Locator
].

l@(File Locator traits) openFile &mode: mode
[
  (File newNamed: (l as: String) &mode: mode) open
].

l@(File Locator traits) withResourceDo: block
"Calls the block with the File object as input, opening and closing it
transparently in an error-tolerant way. The return value of the block is
answered if it completes without error."
[| file |
  [file: l openFile.
   block applyWith: file]
     ensure:
       [file ifNotNil: [file close]]
].

File Locator traits addSlot: #hostSeparator valued: $:.
File Locator traits addSlot: #pathSeparator valued: $\\.

File traits addPrototype: #AbsoluteLocator derivedFrom: {File Locator}.
File AbsoluteLocator addSlot: #host.
"The storage system or logical host of the file."
File AbsoluteLocator addSlot: #device.
"The logical or physical device hosting the file. (optional)"

s@(String traits) as: path@(File AbsoluteLocator traits)
"Parses the String representation of a path into an actual File Locator object;
this will assume the current platform's naming scheme."
[| newPath segments endHostPart |
  newPath: path newEmpty.
  endHostPart: (s indexOf: path hostSeparator ifAbsent: [-1]).
  newPath host: (s copyFrom: 0 to: endHostPart).
  newPath path: ((s sliceFrom: endHostPart + 1)
			splitWith: path pathSeparator) allButLast.
  newPath name: (s last = path pathSeparator
			ifTrue: ['']
			ifFalse: [s copyFrom:
			  (s lastIndexOf: path pathSeparator ifAbsent: [0])
			    to: s indexLast]).
  newPath
].

File traits addPrototype: #RelativeLocator derivedFrom: {File Locator}.
"A path taken relative to an existing one, which may be another RelativeLocator
but ultimately must be based on an AbsoluteLocator."
File RelativeLocator addSlot: #basePath valued: File AbsoluteLocator.
"The basis of the path. The other slots are treated as overrides of any
information in that path, except the #path which is appended to the path of
the basePath."

s@(String traits) as: path@(File RelativeLocator traits) relativeTo: base
[| newPath |
  newPath: path newEmpty.
  newPath
].

s@(String traits) as: path@(File Locator traits)
"TODO: improve this rudimentary support for RelativeLocator handling."
[
  (s beginsWith: '..')
    ifTrue: [^ (s as: File RelativeLocator
		  relativeTo: System CurrentDirectory parentDirectory)].
  (s beginsWith: '~')
    ifTrue: [^ (s as: File RelativeLocator
		  relativeTo: System HomeDirectory)].
  s as: File AbsoluteLocator
].

l@(File Locator traits) as: s@(String traits)
[| result |
  result: s newEmpty writer.
  l path do: [| :each | result ; each]
	 separatedBy: [result nextPut: l pathSeparator].
  result ; l name.
  l fileType 
    ifNotNil: [result ; '.' ; l fileType].
  result contents
].

File traits addPrototype: #Stream
	    derivedFrom: {ExternalResource ReadWriteStream. PositionableStream}.
File Stream removeSlot: #position.
File traits addPrototype: #ReadStream derivedFrom: {File Stream}.
File traits addPrototype: #WriteStream derivedFrom: {File Stream}.
File traits addPrototype: #ReadWriteStream derivedFrom: {File Stream}.

fs@(File Stream traits) on: target@(String traits)
"Open a File ReadWriteStream on the String path."
[
   fs on: (File newNamed: target &mode: File ReadWrite) open
].

fs@(File ReadStream traits) on: target@(String traits)
"Open a File ReadStream on the String path."
[
   fs on: (File newNamed: target &mode: File Read) open
].

fs@(File WriteStream traits) on: target@(String traits)
"Open a File WriteStream on the String path."
[
   fs on: (File newNamed: target &mode: File Write) open
].

fs@(File ReadWriteStream traits) on: target@(String traits)
"Open a File ReadWriteStream on the String path."
[
   fs on: (File newNamed: target &mode: File ReadWrite) open
].

fs@(File Stream traits) elementType
"FIXME: kluge."
[Character].

fs@(File Stream traits) arrayType
[
  (fs elementType isSameAs: Character)
    ifTrue: [String] ifFalse: [ByteArray]
].

fs@(File Stream traits) position
[fs resource position].

fs@(File Stream traits) position: index
[fs resource position: index].

fs@(File Stream traits) isAtEnd
[fs resource isAtEnd].

fs@(File Stream traits) peekForwardBy: offset
"Saves the original position and moves forward by the given offset and then
restores before answering the element found."
[| origPos elem |
  origPos: fs position.
  (origPos + offset between: 0 and: fs resource size)
    ifFalse: [error: 'Beyond the end of the file.'].
  fs position: origPos + offset - 1.
  elem: fs next.
  fs position: origPos.
  elem
].

fs@(File Stream traits) contents
"Get everything from the file at once, preserving the current position in the
file."
[| s pos |
  pos: fs position.
  fs position: 0.
  s: (fs next: fs resource size).
  fs position: pos.
  s
].

fs@(File Stream traits) file
[fs resource].